-;;; mule-cmds.el --- commands for mulitilingual environment
+;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*-
+;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
-
-;; Keywords: mule, multilingual
+;; Keywords: mule, i18n
;; This file is part of GNU Emacs.
;;; Code:
-(eval-when-compile (defvar dos-codepage))
+(eval-when-compile
+ (defvar dos-codepage)
+ (require 'wid-edit))
;;; MULE related key bindings and menus.
(define-key mule-keymap "f" 'set-buffer-file-coding-system)
(define-key mule-keymap "r" 'revert-buffer-with-coding-system)
+(define-key mule-keymap "F" 'set-file-name-coding-system)
(define-key mule-keymap "t" 'set-terminal-coding-system)
(define-key mule-keymap "k" 'set-keyboard-coding-system)
(define-key mule-keymap "p" 'set-buffer-process-coding-system)
(define-key-after mule-menu-keymap [set-language-environment]
(list 'menu-item "Set Language Environment" setup-language-environment-map
:help "Multilingual environment suitable for a specific language"))
-(define-key-after mule-menu-keymap [mouse-set-font]
- '(menu-item "Set Font/Fontset" mouse-set-font
- :visible (fboundp 'generate-fontset-menu)
- :help "Select a font from list of known fonts/fontsets"))
(define-key-after mule-menu-keymap [separator-mule]
'("--")
t)
t)
(define-key-after mule-menu-keymap [set-various-coding-system]
(list 'menu-item "Set Coding Systems" set-coding-system-map
- :enable 'enable-multibyte-characters))
+ :enable 'default-enable-multibyte-characters))
(define-key-after mule-menu-keymap [view-hello-file]
'(menu-item "Show Multi-lingual Text" view-hello-file
:enable (file-readable-p
:enable buffer-file-name
:help "Revisit this file immediately using specified coding system")
t)
+(define-key-after set-coding-system-map [set-file-name-coding-system]
+ '(menu-item "For File Name" set-file-name-coding-system
+ :help "How to decode/encode file names")
+ t)
(define-key-after set-coding-system-map [separator-2]
'("--")
t)
;; We have to decode the file in any environment.
(let ((default-enable-multibyte-characters t)
(coding-system-for-read 'iso-2022-7bit))
- (find-file-read-only (expand-file-name "HELLO" data-directory))))
+ (view-file (expand-file-name "HELLO" data-directory))))
(defun universal-coding-system-argument (coding-system)
"Execute an I/O command using the specified coding system."
(interactive
(let ((default (and buffer-file-coding-system
(not (eq (coding-system-type buffer-file-coding-system)
- t))
+ 'undecided))
buffer-file-coding-system)))
(list (read-coding-system
(if default
(when (eq cmd 'universal-argument)
(call-interactively cmd)
-
+
;; Process keys bound in `universal-argument-map'.
(while (progn
(setq keyseq (read-key-sequence nil t)
(not (eq cmd 'universal-argument-other-key)))
(let ((current-prefix-arg prefix-arg)
;; Have to bind `last-command-char' here so that
- ;; `digit-argument', for isntance, can compute the
+ ;; `digit-argument', for instance, can compute the
;; prefix arg.
(last-command-char (aref keyseq 0)))
(call-interactively cmd)))
- ;; This is the final call to `univeral-argument-other-key', which
+ ;; This is the final call to `universal-argument-other-key', which
;; set's the final `prefix-arg.
(let ((current-prefix-arg prefix-arg))
(call-interactively cmd))
-
+
;; Read the command to execute with the given prefix arg.
(setq prefix prefix-arg
keyseq (read-key-sequence nil t)
(let ((coding-system-for-read coding-system)
(coding-system-for-write coding-system)
+ (coding-system-require-warning t)
(current-prefix-arg prefix))
(message "")
(call-interactively cmd))))
o default value for the command `set-keyboard-coding-system'."
(check-coding-system coding-system)
(setq-default buffer-file-coding-system coding-system)
+ (if (fboundp 'ucs-set-table-for-input)
+ (dolist (buffer (buffer-list))
+ (or (local-variable-p 'buffer-file-coding-system buffer)
+ (ucs-set-table-for-input buffer))))
+
(if default-enable-multibyte-characters
(setq default-file-name-coding-system coding-system))
;; If coding-system is nil, honor that on MS-DOS as well, so
startup.
A coding system that requires automatic detection of text
-encoding (e.g. undecided, unix) can't be preferred.
-
-See also `coding-category-list' and `coding-system-category'."
++encoding (e.g. undecided, unix) can't be preferred.."
(interactive "zPrefer coding system: ")
(if (not (and coding-system (coding-system-p coding-system)))
(error "Invalid coding system `%s'" coding-system))
- (let ((coding-category (coding-system-category coding-system))
- (base (coding-system-base coding-system))
+ (if (memq (coding-system-type coding-system) '(raw-text undecided))
+ (error "Can't prefer the coding system `%s'" coding-system))
+ (let ((base (coding-system-base coding-system))
(eol-type (coding-system-eol-type coding-system)))
- (if (not coding-category)
- ;; CODING-SYSTEM is no-conversion or undecided.
- (error "Can't prefer the coding system `%s'" coding-system))
- (set coding-category (or base coding-system))
- (update-coding-systems-internal)
- (or (eq coding-category (car coding-category-list))
- ;; We must change the order.
- (set-coding-priority (list coding-category)))
- (if (and base (interactive-p))
- (message "Highest priority is set to %s (base of %s)"
- base coding-system))
+ (set-coding-system-priority base)
+ (and (interactive-p)
+ (or (eq base coding-system)
+ (message "Highest priority is set to %s (base of %s)"
+ base coding-system)))
;; If they asked for specific EOL conversion, honor that.
(if (memq eol-type '(0 1 2))
- (setq coding-system
- (coding-system-change-eol-conversion base eol-type))
- (setq coding-system base))
- (set-default-coding-systems coding-system)))
+ (setq base
+ (coding-system-change-eol-conversion base eol-type)))
+ (set-default-coding-systems base)))
(defvar sort-coding-systems-predicate nil
"If non-nil, a predicate function to sort coding systems.
non-nil, it is used to sort CODINGS in the different way than above."
(if sort-coding-systems-predicate
(sort codings sort-coding-systems-predicate)
- (let* ((most-preferred (symbol-value (car coding-category-list)))
+ (let* ((from-priority (coding-system-priority-list))
+ (most-preferred (car from-priority))
(lang-preferred (get-language-info current-language-environment
'coding-system))
(func (function
(lambda (x)
(let ((base (coding-system-base x)))
- (+ (if (eq base most-preferred) 64 0)
- (let ((mime (coding-system-get base 'mime-charset)))
+ ;; We calculate the priority number 0..255 by
+ ;; using the 8 bits PMMLCEII as this:
+ ;; P: 1 iff most preferred.
+ ;; MM: greater than 0 iff mime-charset.
+ ;; L: 1 iff one of the current lang. env.'s codings.
+ ;; C: 1 iff one of codings listed in the category list.
+ ;; E: 1 iff not XXX-with-esc
+ ;; II: if iso-2022 based, 0..3, else 1.
+ (logior
+ (lsh (if (eq base most-preferred) 1 0) 7)
+ (lsh
+ (let ((mime (coding-system-get base :mime-charset)))
+ ;; Prefer coding systems corresponding to a
+ ;; MIME charset.
(if mime
- (if (string-match "^x-" (symbol-name mime))
- 16 32)
+ ;; Lower utf-16 priority so that we
+ ;; normally prefer utf-8 to it, and put
+ ;; x-ctext below that.
+ (cond ((string-match "utf-16"
+ (symbol-name mime))
+ 2)
+ ((string-match "^x-" (symbol-name mime))
+ 1)
+ (t 3))
0))
- (if (memq base lang-preferred) 8 0)
- (if (string-match "-with-esc$" (symbol-name base))
- 0 4)
- (if (eq (coding-system-type base) 2)
+ 5)
+ (lsh (if (memq base lang-preferred) 1 0) 4)
+ (lsh (if (memq base from-priority) 1 0) 3)
+ (lsh (if (string-match "-with-esc\\'"
+ (symbol-name base))
+ 0 1) 2)
+ (if (eq (coding-system-type base) 'iso-2022)
+ (let ((category (coding-system-category base)))
;; For ISO based coding systems, prefer
- ;; one that doesn't use escape sequences.
- (let ((flags (coding-system-flags base)))
- (if (or (consp (aref flags 0))
- (consp (aref flags 1))
- (consp (aref flags 2))
- (consp (aref flags 3)))
- (if (or (aref flags 8) (aref flags 9))
- 0
- 1)
- 2))
- 1)))))))
+ ;; one that doesn't use designation nor
+ ;; locking/single shifting.
+ (cond
+ ((or (eq category 'coding-category-iso-8-1)
+ (eq category 'coding-category-iso-8-2))
+ 2)
+ ((or (eq category 'coding-category-iso-7-tight)
+ (eq category 'coding-category-iso-7))
+ 1)
+ (t
+ 0)))
+ 1)
+ ))))))
(sort codings (function (lambda (x y)
(> (funcall func x) (funcall func y))))))))
(defun find-coding-systems-region (from to)
"Return a list of proper coding systems to encode a text between FROM and TO.
+
If FROM is a string, find coding systems in that instead of the buffer.
All coding systems in the list can safely encode any multibyte characters
in the text.
(defun find-coding-systems-for-charsets (charsets)
"Return a list of proper coding systems to encode characters of CHARSETS.
-CHARSETS is a list of character sets."
+CHARSETS is a list of character sets.
+
+This only finds coding systems of type `charset', whose
+`:charset-list' property includes all of CHARSETS (plus `ascii' for
+ascii-compatible coding systems). It was used in older versions of
+Emacs, but is unlikely to be what you really want now."
+ ;; Deal with aliases.
+ (setq charsets (mapcar (lambda (c)
+ (get-charset-property c :name))
+ charsets))
(cond ((or (null charsets)
(and (= (length charsets) 1)
(eq 'ascii (car charsets))))
'(undecided))
((or (memq 'eight-bit-control charsets)
(memq 'eight-bit-graphic charsets))
- '(raw-text emacs-mule))
+ '(raw-text utf-8-emacs))
(t
- (let ((codings t)
- charset l ll)
- (while (and codings charsets)
- (setq charset (car charsets) charsets (cdr charsets))
- (unless (eq charset 'ascii)
- (setq l (aref char-coding-system-table (make-char charset)))
- (if (eq codings t)
- (setq codings l)
- (let ((ll nil))
- (while codings
- (if (memq (car codings) l)
- (setq ll (cons (car codings) ll)))
- (setq codings (cdr codings)))
- (setq codings ll)))))
- (append codings
- (char-table-extra-slot char-coding-system-table 0))))))
+ (let (codings)
+ (dolist (cs (coding-system-list t))
+ (let ((cs-charsets (and (eq (coding-system-type cs) 'charset)
+ (coding-system-charset-list cs)))
+ (charsets charsets))
+ (if (coding-system-get cs :ascii-compatible-p)
+ (add-to-list 'cs-charsets 'ascii))
+ (if (catch 'ok
+ (when cs-charsets
+ (while charsets
+ (unless (memq (pop charsets) cs-charsets)
+ (throw 'ok nil)))
+ t))
+ (push cs codings))))
+ (nreverse codings)))))
(defun find-multibyte-characters (from to &optional maxcount excludes)
"Find multibyte characters in the region specified by FROM and TO.
where
CHARSET is a character set,
COUNT is a number of characters,
- CHARs are found characters of the character set.
+ CHARs are the characters found from the character set.
Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
-Optional 4th arg EXCLUDE is a list of character sets to be ignored.
-
-For invalid characters, CHARs are actually strings."
+Optional 4th arg EXCLUDE is a list of character sets to be ignored."
(let ((chars nil)
charset char)
(if (stringp from)
- (let ((idx 0))
- (while (setq idx (string-match "[^\000-\177]" from idx))
- (setq char (aref from idx)
- charset (char-charset char))
- (if (eq charset 'unknown)
- (setq char (match-string 0)))
- (if (or (memq charset '(unknown
- eight-bit-control eight-bit-graphic))
- (not (or (eq excludes t) (memq charset excludes))))
+ (if (multibyte-string-p from)
+ (let ((idx 0))
+ (while (setq idx (string-match "[^\000-\177]" from idx))
+ (setq char (aref from idx)
+ charset (char-charset char))
+ (unless (memq charset excludes)
+ (let ((slot (assq charset chars)))
+ (if slot
+ (if (not (memq char (nthcdr 2 slot)))
+ (let ((count (nth 1 slot)))
+ (setcar (cdr slot) (1+ count))
+ (if (or (not maxcount) (< count maxcount))
+ (nconc slot (list char)))))
+ (setq chars (cons (list charset 1 char) chars)))))
+ (setq idx (1+ idx)))))
+ (if enable-multibyte-characters
+ (save-excursion
+ (goto-char from)
+ (while (re-search-forward "[^\000-\177]" to t)
+ (setq char (preceding-char)
+ charset (char-charset char))
+ (unless (memq charset excludes)
(let ((slot (assq charset chars)))
(if slot
- (if (not (memq char (nthcdr 2 slot)))
+ (if (not (member char (nthcdr 2 slot)))
(let ((count (nth 1 slot)))
(setcar (cdr slot) (1+ count))
(if (or (not maxcount) (< count maxcount))
(nconc slot (list char)))))
- (setq chars (cons (list charset 1 char) chars)))))
- (setq idx (1+ idx))))
- (save-excursion
- (goto-char from)
- (while (re-search-forward "[^\000-\177]" to t)
- (setq char (preceding-char)
- charset (char-charset char))
- (if (eq charset 'unknown)
- (setq char (match-string 0)))
- (if (or (memq charset '(unknown eight-bit-control eight-bit-graphic))
- (not (or (eq excludes t) (memq charset excludes))))
- (let ((slot (assq charset chars)))
- (if slot
- (if (not (member char (nthcdr 2 slot)))
- (let ((count (nth 1 slot)))
- (setcar (cdr slot) (1+ count))
- (if (or (not maxcount) (< count maxcount))
- (nconc slot (list char)))))
- (setq chars (cons (list charset 1 char) chars))))))))
+ (setq chars (cons (list charset 1 char) chars)))))))))
(nreverse chars)))
-
(defun search-unencodable-char (coding-system)
"Search forward from point for a character that is not encodable.
It asks which coding system to check.
(message "All following characters are encodable by %s" coding-system))
pos))
-
(defvar last-coding-system-specified nil
"Most recent coding system explicitly specified by the user when asked.
This variable is set whenever Emacs asks the user which coding system
between FROM and TO are shown in a popup window. Among them, the most
proper one is suggested as the default.
-The list of `buffer-file-coding-system' of the current buffer and the
+The list of `buffer-file-coding-system' of the current buffer,
+the `default-buffer-file-coding-system', and the
most preferred coding system (if it corresponds to a MIME charset) is
treated as the default coding system list. Among them, the first one
that safely encodes the text is normally selected silently and
Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
list of coding systems to be prepended to the default coding system
-list.
+list. However, if DEFAULT-CODING-SYSTEM is a list and the first
+element is t, the cdr part is used as the defualt coding system list,
+i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
+and the most preferred coding system are not used.
Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to
determine the acceptability of the silently selected coding system.
(not (listp default-coding-system)))
(setq default-coding-system (list default-coding-system)))
- ;; Change elements of the list to (coding . base-coding).
- (setq default-coding-system
- (mapcar (function (lambda (x) (cons x (coding-system-base x))))
- default-coding-system))
-
- ;; If buffer-file-coding-system is not nil nor undecided, append it
- ;; to the defaults.
- (if buffer-file-coding-system
- (let ((base (coding-system-base buffer-file-coding-system)))
- (or (eq base 'undecided)
- (assq buffer-file-coding-system default-coding-system)
- (rassq base default-coding-system)
- (setq default-coding-system
- (append default-coding-system
- (list (cons buffer-file-coding-system base)))))))
-
- ;; If the most preferred coding system has the property mime-charset,
- ;; append it to the defaults.
- (let ((tail coding-category-list)
- preferred base)
- (while (and tail
- (not (setq preferred (symbol-value (car tail)))))
- (setq tail (cdr tail)))
- (and (coding-system-p preferred)
- (setq base (coding-system-base preferred))
- (coding-system-get preferred 'mime-charset)
- (not (assq preferred default-coding-system))
- (not (rassq base default-coding-system))
- (setq default-coding-system
- (append default-coding-system (list (cons preferred base))))))
+ (let ((no-other-defaults nil))
+ (if (eq (car default-coding-system) t)
+ (setq no-other-defaults t
+ default-coding-system (cdr default-coding-system)))
+
+ ;; Change elements of the list to (coding . base-coding).
+ (setq default-coding-system
+ (mapcar (function (lambda (x) (cons x (coding-system-base x))))
+ default-coding-system))
+
+ ;; From now on, the list of defaults is reversed.
+ (setq default-coding-system (nreverse default-coding-system))
+
+ (unless no-other-defaults
+ ;; If buffer-file-coding-system is not nil nor undecided, append it
+ ;; to the defaults.
+ (if buffer-file-coding-system
+ (let ((base (coding-system-base buffer-file-coding-system)))
+ (or (eq base 'undecided)
+ (rassq base default-coding-system)
+ (push (cons buffer-file-coding-system base)
+ default-coding-system))))
+
+ ;; If default-buffer-file-coding-system is not nil nor undecided,
+ ;; append it to the defaults.
+ (if default-buffer-file-coding-system
+ (let ((base (coding-system-base default-buffer-file-coding-system)))
+ (or (eq base 'undecided)
+ (rassq base default-coding-system)
+ (push (cons default-buffer-file-coding-system base)
+ default-coding-system))))
+
+ ;; If the most preferred coding system has the property mime-charset,
+ ;; append it to the defaults.
+ (let ((preferred (coding-system-priority-list t))
+ base)
+ (and (coding-system-p preferred)
+ (setq base (coding-system-base preferred))
+ (coding-system-get preferred :mime-charset)
+ (not (rassq base default-coding-system))
+ (push (cons preferred base)
+ default-coding-system)))))
(if select-safe-coding-system-accept-default-p
(setq accept-default-p select-safe-coding-system-accept-default-p))
(let ((codings (find-coding-systems-region from to))
(coding-system nil)
(bufname (buffer-name))
- (l default-coding-system))
- (if (eq (car codings) 'undecided)
- ;; Any coding system is ok.
- (setq coding-system t)
- ;; Try the defaults.
- (while (and l (not coding-system))
- (if (memq (cdr (car l)) codings)
- (setq coding-system (car (car l)))
- (setq l (cdr l))))
- (if (and coding-system accept-default-p)
- (or (funcall accept-default-p coding-system)
- (setq coding-system (list coding-system)))))
+ safe rejected unsafe)
+ ;; Classify the defaults into safe, rejected, and unsafe.
+ (dolist (elt default-coding-system)
+ (if (or (eq (car codings) 'undecided)
+ (memq (cdr elt) codings))
+ (if (and (functionp accept-default-p)
+ (not (funcall accept-default-p (cdr elt))))
+ (push (car elt) rejected)
+ (push (car elt) safe))
+ (push (car elt) unsafe)))
+ (if safe
+ (setq coding-system (car safe)))
;; If all the defaults failed, ask a user.
- (when (or (not coding-system) (consp coding-system))
- ;; At first, record at most 11 problematic characters and their
- ;; positions for each default.
- (if (stringp from)
- (mapc #'(lambda (coding)
- (setcdr coding
- (mapcar #'(lambda (pos)
- (cons pos (aref from pos)))
- (unencodable-char-position
- 0 (length from) (car coding) 11 from))))
- default-coding-system)
- (mapc #'(lambda (coding)
- (setcdr coding
- (mapcar #'(lambda (pos)
- (cons pos (char-after pos)))
- (unencodable-char-position
- from to (car coding) 11))))
- default-coding-system))
- ;; If 11 unencodable characters were found, mark the last one as nil.
- (mapc #'(lambda (coding)
- (if (> (length coding) 11)
- (setcdr (car (last coding)) nil)))
- default-coding-system)
+ (unless coding-system
+ ;; At first, if some defaults are unsafe, record at most 11
+ ;; problematic characters and their positions for them by turning
+ ;; (CODING ...)
+ ;; into
+ ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
+ (if unsafe
+ (if (stringp from)
+ (setq unsafe
+ (mapcar #'(lambda (coding)
+ (cons coding
+ (mapcar #'(lambda (pos)
+ (cons pos (aref from pos)))
+ (unencodable-char-position
+ 0 (length from) coding
+ 11 from))))
+ unsafe))
+ (setq unsafe
+ (mapcar #'(lambda (coding)
+ (cons coding
+ (mapcar #'(lambda (pos)
+ (cons pos (char-after pos)))
+ (unencodable-char-position
+ from to coding 11))))
+ unsafe))))
;; Change each safe coding system to the corresponding
;; mime-charset name if it is also a coding system. Such a name
(let ((l codings)
mime-charset)
(while l
- (setq mime-charset (coding-system-get (car l) 'mime-charset))
- (if (and mime-charset (coding-system-p mime-charset))
+ (setq mime-charset (coding-system-get (car l) :mime-charset))
+ (if (and mime-charset (coding-system-p mime-charset)
+ (coding-system-equal (car l) mime-charset))
(setcar l mime-charset))
(setq l (cdr l))))
(coding-system-category elt)))
(push elt l))))
+ ;; Remove raw-text, emacs-mule and no-conversion unless nothing
+ ;; else is available.
+ (setq codings
+ (or (delq 'raw-text
+ (delq 'emacs-mule
+ (delq 'no-conversion codings)))
+ '(raw-text emacs-mule no-conversion)))
+
(let ((window-configuration (current-window-configuration)))
(save-excursion
- ;; Make sure the offending buffer is displayed.
- (when (and default-coding-system (not (stringp from)))
+ ;; If some defaults are unsafe, make sure the offending
+ ;; buffer is displayed.
+ (when (and unsafe (not (stringp from)))
(pop-to-buffer bufname)
(goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
- default-coding-system))))
- ;; Then ask users to select one from CODINGS.
+ unsafe))))
+ ;; Then ask users to select one from CODINGS while showing
+ ;; the reason why none of the defaults are not used.
(with-output-to-temp-buffer "*Warning*"
(save-excursion
(set-buffer standard-output)
":\n")
(let ((pos (point))
(fill-prefix " "))
- (mapcar (function (lambda (x)
- (princ " ") (princ (car x))))
- default-coding-system)
+ (mapc #'(lambda (x) (princ " ") (princ (car x)))
+ default-coding-system)
(insert "\n")
(fill-region-as-paragraph pos (point)))
- (if (consp coding-system)
- (insert (format "%s safely encodes the target text,\n"
- (car coding-system))
- "\
+ (when rejected
+ (insert "These safely encodes the target text,
but it is not recommended for encoding text in this context,
-e.g., for sending an email message.\n")
- (insert "\
-However, each of them encountered these problematic characters:\n")
+e.g., for sending an email message.\n ")
+ (mapc #'(lambda (x) (princ " ") (princ x)) rejected)
+ (insert "\n"))
+ (when unsafe
+ (insert (if rejected "And the others"
+ "However, each of them")
+ " encountered these problematic characters:\n")
(mapc
#'(lambda (coding)
(insert (format " %s:" (car coding)))
- (dolist (elt (cdr coding))
- (insert " ")
- (if (stringp from)
- (insert (or (cdr elt) "..."))
- (if (cdr elt)
- (insert-text-button
- (cdr elt)
- :type 'help-xref
- 'help-echo
- "mouse-2, RET: jump to this character"
- 'help-function
- #'(lambda (bufname pos)
- (when (buffer-live-p (get-buffer bufname))
- (pop-to-buffer bufname)
- (goto-char pos)))
- 'help-args (list bufname (car elt)))
- (insert-text-button
- "..."
- :type 'help-xref
- 'help-echo
- "mouse-2, RET: next unencodable character"
- 'help-function
+ (let ((i 0)
+ (func1
+ #'(lambda (bufname pos)
+ (when (buffer-live-p (get-buffer bufname))
+ (pop-to-buffer bufname)
+ (goto-char pos))))
+ (func2
#'(lambda (bufname pos coding)
(when (buffer-live-p (get-buffer bufname))
(pop-to-buffer bufname)
(goto-char pos)
(forward-char 1)
(search-unencodable-char coding)
- (forward-char -1))))
- 'help-args (list bufname (car elt)
- (car coding))))))
+ (forward-char -1))))))
+ (dolist (elt (cdr coding))
+ (insert " ")
+ (if (stringp from)
+ (insert (if (< i 10) (cdr elt) "..."))
+ (if (< i 10)
+ (insert-text-button
+ (cdr elt)
+ :type 'help-xref
+ 'help-echo
+ "mouse-2, RET: jump to this character"
+ 'help-function func1
+ 'help-args (list bufname (car elt)))
+ (insert-text-button
+ "..."
+ :type 'help-xref
+ 'help-echo
+ "mouse-2, RET: next unencodable character"
+ 'help-function func2
+ 'help-args (list bufname (car elt)
+ (car coding)))))
+ (setq i (1+ i))))
(insert "\n"))
- default-coding-system)
+ unsafe)
(insert "\
The first problematic character is at point in the displayed buffer,\n"
(substitute-command-keys "\
and \\[universal-argument] \\[what-cursor-position] will give information about it.\n"))))
- (insert (if (consp coding-system)
+ (insert (if rejected
"\nSelect the above, or "
"\nSelect ")
"\
(mapcar (function (lambda (x) (princ " ") (princ x)))
codings)
(insert "\n")
- (fill-region-as-paragraph pos (point)))))
+ (fill-region-as-paragraph pos (point)))
+ (insert "Or specify any other coding system
+at the risk of losing the problematic characters.\n")))
;; Read a coding system.
- (if (consp coding-system)
- (setq codings (cons (car coding-system) codings)))
- (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x)))
- codings))
- (name (completing-read
- (format "Select coding system (default %s): "
- (car codings))
- safe-names nil t nil nil
- (car (car safe-names)))))
- (setq last-coding-system-specified (intern name)
- coding-system last-coding-system-specified)))
+ (setq default-coding-system (or (car safe) (car codings)))
+ (setq coding-system
+ (read-coding-system
+ (format "Select coding system (default %s): "
+ default-coding-system)
+ default-coding-system))
+ (setq last-coding-system-specified coding-system))
+
(kill-buffer "*Warning*")
(set-window-configuration window-configuration)))
- (if (vectorp (coding-system-eol-type coding-system))
+ (if (and coding-system (vectorp (coding-system-eol-type coding-system)))
(let ((eol (coding-system-eol-type buffer-file-coding-system)))
(if (numberp eol)
(setq coding-system
(coding-system-change-eol-conversion coding-system eol)))))
- (if (eq coding-system t)
- (setq coding-system buffer-file-coding-system))
;; Check we're not inconsistent with what `coding:' spec &c would
;; give when file is re-read.
;; But don't do this if we explicitly ignored the cookie
(goto-char (point-min))
(set-auto-coding (or file buffer-file-name "")
(buffer-size))))))
- (if (and auto-cs coding-system
+ ;; Merge coding-system and auto-cs as far as possible.
+ (if (not coding-system)
+ (setq coding-system auto-cs)
+ (if (not auto-cs)
+ (setq auto-cs coding-system)
+ (let ((eol-type-1 (coding-system-eol-type coding-system))
+ (eol-type-2 (coding-system-eol-type auto-cs)))
+ (if (eq (coding-system-base coding-system) 'undecided)
+ (setq coding-system (coding-system-change-text-conversion
+ coding-system auto-cs))
+ (if (eq (coding-system-base auto-cs) 'undecided)
+ (setq auto-cs (coding-system-change-text-conversion
+ auto-cs coding-system))))
+ (if (vectorp eol-type-1)
+ (or (vectorp eol-type-2)
+ (setq coding-system (coding-system-change-eol-conversion
+ coding-system eol-type-2)))
+ (if (vectorp eol-type-2)
+ (setq auto-cs (coding-system-change-eol-conversion
+ auto-cs eol-type-1)))))))
+
+ (if (and auto-cs
;; Don't barf if writing a compressed file, say.
;; This check perhaps isn't ideal, but is probably
;; the best thing to do.
(not (auto-coding-alist-lookup (or file buffer-file-name "")))
- (not (coding-system-equal (coding-system-base coding-system)
- (coding-system-base auto-cs))))
+ (not (coding-system-equal coding-system auto-cs)))
(unless (yes-or-no-p
(format "Selected encoding %s disagrees with \
%s specified by file contents. Really save (else edit coding cookies \
(if (fboundp select-safe-coding-system-function)
(funcall select-safe-coding-system-function
(point-min) (point-max) coding
- (function (lambda (x) (coding-system-get x 'mime-charset))))
+ (function (lambda (x) (coding-system-get x :mime-charset))))
coding)))
\f
;;; Language support stuff.
documentation value is documentation of what this language environment
is meant for, and how to use it.
- charset value is a list of the character sets used by this
- language environment.
+ charset value is a list of the character sets mainly used
+ by this language environment.
sample-text value is an expression which is evalled to generate
a line of text written using characters appropriate
for this language environment.
This is used to set up the coding system priority
list when you switch to this language environment.
nonascii-translation
- value is a translation table to be set in the
- variable `nonascii-translation-table' in this
- language environment, or a character set from
- which `nonascii-insert-offset' is calculated.
+ value is a charset of dimension one to use for
+ converting a unibyte character to multibyte
+ and vice versa.
input-method value is a default input method for this language
environment.
features value is a list of features requested in this
language environment.
+ ctext-non-standard-encodings
+ value is a list of non-standard encoding
+ names used in extended segments of CTEXT.
+ See the variable
+ `ctext-non-standard-encodings' for more
+ detail.
The following keys take effect only when multibyte characters are
globally disabled, i.e. the value of `default-enable-multibyte-characters'
is nil.
- unibyte-syntax value is a library name to load to set
- unibyte 8-bit character syntaxes for this
- language environment.
-
unibyte-display value is a coding system to encode characters
for the terminal. Characters in the range
of 160 to 255 display not as octal escapes,
see `language-info-alist'."
(if (symbolp lang-env)
(setq lang-env (symbol-name lang-env)))
- (let ((lang-slot (assoc-ignore-case lang-env language-info-alist)))
+ (let ((lang-slot (assoc-string lang-env language-info-alist t)))
(if lang-slot
(cdr (assq key (cdr lang-slot))))))
(progn
(setq key-slot (list key))
(setcdr lang-slot (cons key-slot (cdr lang-slot)))))
- (setcdr key-slot (purecopy info))))
+ (setcdr key-slot (purecopy info))
+ ;; Update the custom-type of `current-language-environment'.
+ (put 'current-language-environment 'custom-type
+ (cons 'choice (mapcar
+ (lambda (lang)
+ (list 'const lang))
+ (sort (mapcar 'car language-info-alist) 'string<))))))
(defun set-language-info-alist (lang-env alist &optional parents)
"Store ALIST as the definition of language environment LANG-ENV.
"*Default input method for multilingual text (a string).
This is the input method activated automatically by the command
`toggle-input-method' (\\[toggle-input-method])."
+ :link '(custom-manual "(emacs)Input Methods")
:group 'mule
- :type '(choice (const nil) string)
+ :type '(choice (const nil) (string
+ :completion-ignore-case t
+ :complete-function widget-string-complete
+ :completion-alist input-method-alist
+ :prompt-history input-method-history))
:set-after '(current-language-environment))
(put 'input-method-function 'permanent-local t)
(when (interactive-p)
(customize-mark-as-set 'default-input-method)))))))
+(eval-when-compile (autoload 'help-buffer "help-mode"))
+
(defun describe-input-method (input-method)
"Describe input method INPUT-METHOD."
(interactive
:type 'boolean
:group 'mule)
-(defvar input-method-activate-hook nil
+(defcustom input-method-activate-hook nil
"Normal hook run just after an input method is activated.
The variable `current-input-method' keeps the input method name
-just activated.")
+just activated."
+ :type 'hook
+ :group 'mule)
-(defvar input-method-inactivate-hook nil
+(defcustom input-method-inactivate-hook nil
"Normal hook run just after an input method is inactivated.
The variable `current-input-method' still keeps the input method name
-just inactivated.")
+just inactivated."
+ :type 'hook
+ :group 'mule)
-(defvar input-method-after-insert-chunk-hook nil
- "Normal hook run just after an input method insert some chunk of text.")
+(defcustom input-method-after-insert-chunk-hook nil
+ "Normal hook run just after an input method insert some chunk of text."
+ :type 'hook
+ :group 'mule)
(defvar input-method-exit-on-first-char nil
"This flag controls when an input method returns.
But, it this flag is non-nil, the input method returns as soon as
the current key sequence gets long enough to have some valid translation.")
-(defvar input-method-use-echo-area nil
+(defcustom input-method-use-echo-area nil
"This flag controls how an input method shows an intermediate key sequence.
Usually, the input method inserts the intermediate key sequence,
or candidate translations corresponding to the sequence,
at point in the current buffer.
-But, if this flag is non-nil, it displays them in echo area instead.")
+But, if this flag is non-nil, it displays them in echo area instead."
+ :type 'hook
+ :group 'mule)
(defvar input-method-exit-on-invalid-key nil
"This flag controls the behaviour of an input method on invalid key input.
But, if this flag is non-nil, the input method is never back on.")
\f
-(defvar set-language-environment-hook nil
+(defcustom set-language-environment-hook nil
"Normal hook run after some language environment is set.
When you set some hook function here, that effect usually should not
be inherited to another language environment. So, you had better set
another function in `exit-language-environment-hook' (which see) to
-cancel the effect.")
+cancel the effect."
+ :type 'hook
+ :group 'mule)
-(defvar exit-language-environment-hook nil
+(defcustom exit-language-environment-hook nil
"Normal hook run after exiting from some language environment.
When this hook is run, the variable `current-language-environment'
is still bound to the language environment being exited.
This hook is mainly used for canceling the effect of
-`set-language-environment-hook' (which-see).")
+`set-language-environment-hook' (which-see)."
+ :type 'hook
+ :group 'mule)
(put 'setup-specified-language-environment 'apropos-inhibit t)
:link '(custom-manual "(emacs)Language Environments")
:set (lambda (symbol value) (set-language-environment value))
:get (lambda (x)
- (or (car-safe (assoc-ignore-case
+ (or (car-safe (assoc-string
(if (symbolp current-language-environment)
(symbol-name current-language-environment)
current-language-environment)
- language-info-alist))
+ language-info-alist t))
"English"))
- :type (cons 'choice (mapcar (lambda (lang)
- (list 'const (car lang)))
- language-info-alist))
+ ;; custom type will be updated with `set-language-info'.
+ :type (if language-info-alist
+ (cons 'choice (mapcar
+ (lambda (lang)
+ (list 'const lang))
+ (sort (mapcar 'car language-info-alist) 'string<)))
+ 'string)
:initialize 'custom-initialize-default
- :group 'mule
- :type 'string)
+ :group 'mule)
(defun reset-language-environment ()
"Reset multilingual environment of Emacs to the default status.
The default value for the command `set-terminal-coding-system' is nil.
The default value for the command `set-keyboard-coding-system' is nil.
- The order of priorities of coding categories and the coding system
- bound to each category are as follows
- coding category coding system
- --------------------------------------------------
- coding-category-iso-8-2 iso-latin-1
- coding-category-iso-8-1 iso-latin-1
- coding-category-iso-7-tight iso-2022-jp
- coding-category-iso-7 iso-2022-7bit
- coding-category-iso-7-else iso-2022-7bit-lock
- coding-category-iso-8-else iso-2022-8bit-ss2
- coding-category-emacs-mule emacs-mule
- coding-category-raw-text raw-text
- coding-category-sjis japanese-shift-jis
- coding-category-big5 chinese-big5
- coding-category-ccl nil
- coding-category-binary no-conversion
- coding-category-utf-16-be nil
- coding-category-utf-16-le nil
- coding-category-utf-8 mule-utf-8"
+ The order of priorities of coding systems are as follows:
+ utf-8
+ iso-2022-7bit
+ iso-latin-1
+ iso-2022-7bit-lock
+ iso-2022-8bit-ss2
+ emacs-mule
+ raw-text"
(interactive)
;; This function formerly set default-enable-multibyte-characters to t,
;; but that is incorrect. It should not alter the unibyte/multibyte choice.
- (setq coding-category-iso-7-tight 'iso-2022-jp
- coding-category-iso-7 'iso-2022-7bit
- coding-category-iso-8-1 'iso-latin-1
- coding-category-iso-8-2 'iso-latin-1
- coding-category-iso-7-else 'iso-2022-7bit-lock
- coding-category-iso-8-else 'iso-2022-8bit-ss2
- coding-category-emacs-mule 'emacs-mule
- coding-category-raw-text 'raw-text
- coding-category-sjis 'japanese-shift-jis
- coding-category-big5 'chinese-big5
- coding-category-utf-16-be nil
- coding-category-utf-16-le nil
- coding-category-utf-8 'mule-utf-8
- coding-category-ccl nil
- coding-category-binary 'no-conversion)
-
- (set-coding-priority
- '(coding-category-iso-8-1
- coding-category-iso-8-2
- coding-category-iso-7-tight
- coding-category-iso-7
- coding-category-iso-7-else
- coding-category-iso-8-else
- coding-category-emacs-mule
- coding-category-raw-text
- coding-category-sjis
- coding-category-big5
- coding-category-ccl
- coding-category-binary
- coding-category-utf-16-be
- coding-category-utf-16-le
- coding-category-utf-8))
-
- (update-coding-systems-internal)
+ (set-coding-system-priority
+ 'utf-8
+ 'iso-2022-7bit
+ 'iso-latin-1
+ 'iso-2022-7bit-lock
+ 'iso-2022-8bit-ss2
+ 'emacs-mule
+ 'raw-text)
(set-default-coding-systems nil)
(setq default-sendmail-coding-system 'iso-latin-1)
+ (setq default-file-name-coding-system 'iso-latin-1)
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
;; carefully by the user, or by the startup code, to deal with the
;; (set-terminal-coding-system-internal nil)
;; (set-keyboard-coding-system-internal nil)
- (setq nonascii-translation-table nil
- nonascii-insert-offset 0))
+ (set-unibyte-charset 'iso-8859-1))
(reset-language-environment)
(let ((coding (get-language-info language-name 'unibyte-display)))
(if coding
(standard-display-european-internal)
- (standard-display-default (if (eq window-system 'pc) 128 160) 255)
- (aset standard-display-table 146 nil))
+ ;; The following 2 lines undo the 8-bit display that we set up
+ ;; in standard-display-european-internal, which see. This is in
+ ;; case the user has used standard-display-european earlier in
+ ;; this session. (The MS-DOS port doesn't use that setup, so it
+ ;; doesn't need to undo it.)
+ (when standard-display-table
+ (dotimes (i 128)
+ (aset standard-display-table (+ i 128) nil))))
(or (eq window-system 'pc)
- (set-terminal-coding-system coding))))
+ (set-terminal-coding-system coding))))
(defun set-language-environment (language-name)
"Set up multi-lingual environment for using LANGUAGE-NAME.
(if (symbolp language-name)
(setq language-name (symbol-name language-name)))
(setq language-name "English"))
- (or (assoc-ignore-case language-name language-info-alist)
+ (let ((slot (assoc-string language-name language-info-alist t)))
+ (unless slot
(error "Language environment not defined: %S" language-name))
+ (setq language-name (car slot)))
(if current-language-environment
(let ((func (get-language-info current-language-environment
'exit-function)))
(setq input-method-history
(cons input-method
(delete input-method input-method-history))))))
- (let ((nonascii (get-language-info language-name 'nonascii-translation))
- (dos-table
- (if (eq window-system 'pc)
- (intern
- (format "cp%d-nonascii-translation-table" dos-codepage)))))
- (cond
- ((char-table-p nonascii)
- (setq nonascii-translation-table nonascii))
- ((and (eq window-system 'pc) (boundp dos-table))
- ;; DOS terminals' default is to use a special non-ASCII translation
- ;; table as appropriate for the installed codepage.
- (setq nonascii-translation-table (symbol-value dos-table)))
- ((charsetp nonascii)
- (setq nonascii-insert-offset (- (make-char nonascii) 128)))))
+
+ ;; Put higher priorities to such charsets that are supported by the
+ ;; coding systems of higher priorities in this environment.
+ (let ((charsets (get-language-info language-name 'charset)))
+ (dolist (coding (get-language-info language-name 'coding-priority))
+ (setq charsets (append charsets (coding-system-charset-list coding))))
+ (if charsets
+ (apply 'set-charset-priority charsets)))
+
+ ;; Note: For DOS, we assumed that the charset cpXXX is already
+ ;; defined.
+ (let ((nonascii (get-language-info language-name 'nonascii-translation)))
+ (if (eq window-system 'pc)
+ (setq nonascii (intern "cp%d" dos-codepage)))
+ (or (and (charsetp nonascii)
+ (= (charset-dimension nonascii) 1))
+ (setq nonascii 'iso-8859-1))
+ (set-unibyte-charset nonascii))
;; Unibyte setups if necessary.
- (unless default-enable-multibyte-characters
- ;; Syntax and case table.
- (let ((syntax (get-language-info language-name 'unibyte-syntax)))
- (if syntax
- (let ((set-case-syntax-set-multibyte nil))
- (load syntax nil t))
- ;; No information for syntax and case. Reset to the defaults.
- (let ((syntax-table (standard-syntax-table))
- (case-table (standard-case-table))
- (ch (if (eq window-system 'pc) 128 160)))
- (while (< ch 256)
- (modify-syntax-entry ch " " syntax-table)
- (aset case-table ch ch)
- (setq ch (1+ ch)))
- (set-char-table-extra-slot case-table 0 nil)
- (set-char-table-extra-slot case-table 1 nil)
- (set-char-table-extra-slot case-table 2 nil))
- (set-standard-case-table (standard-case-table))
- (let ((list (buffer-list)))
- (while list
- (with-current-buffer (car list)
- (set-case-table (standard-case-table)))
- (setq list (cdr list))))))
- (set-display-table-and-terminal-coding-system language-name))
+ (or default-enable-multibyte-characters
+ (set-display-table-and-terminal-coding-system language-name))
(let ((required-features (get-language-info language-name 'features)))
(while required-features
(require (car required-features))
(setq required-features (cdr required-features))))
+
+ ;; Don't invoke fontset-related functions if fontsets aren't
+ ;; supported in this build of Emacs.
+ (when (fboundp 'fontset-list)
+ (let ((overriding-fontspec (get-language-info language-name
+ 'overriding-fontspec)))
+ (if overriding-fontspec
+ (set-overriding-fontspec-internal overriding-fontspec))))
+
(let ((func (get-language-info language-name 'setup-function)))
(if (functionp func)
(funcall func)))
(run-hooks 'set-language-environment-hook)
(force-mode-line-update t))
+(define-widget 'charset 'symbol
+ "An Emacs charset."
+ :tag "Charset"
+ :complete-function (lambda ()
+ (interactive)
+ (lisp-complete-symbol 'charsetp))
+ :completion-ignore-case t
+ :value 'ascii
+ :validate (lambda (widget)
+ (unless (charsetp (widget-value widget))
+ (widget-put widget :error (format "Invalid charset: %S"
+ (widget-value widget)))
+ widget))
+ :prompt-history 'charset-history)
+
+(defcustom language-info-custom-alist nil
+ "Customizations of language environment parameters.
+Value is an alist with elements like those of `language-info-alist'.
+These are used to set values in `language-info-alist' which replace
+the defaults. A typical use is replacing the default input method for
+the environment. Use \\[describe-language-environment] to find the environment's settings.
+
+This option is intended for use at startup. Removing items doesn't
+remove them from the language info until you next restart Emacs.
+
+Setting this variable directly does not take effect. See
+`set-language-info-alist' for use in programs."
+ :group 'mule
+ :version "22.1"
+ :set (lambda (s v)
+ (custom-set-default s v)
+ ;; Can't do this before language environments are set up.
+ (when v
+ ;; modify language-info-alist
+ (dolist (elt v)
+ (set-language-info-alist (car elt) (cdr elt)))
+ ;; re-set the environment in case its parameters changed
+ (set-language-environment current-language-environment)))
+ :type `(alist
+ :key-type (string :tag "Language environment"
+ :completion-ignore-case t
+ :complete-function widget-string-complete
+ :completion-alist language-info-alist)
+ :value-type
+ (alist :key-type symbol
+ :options ((documentation string)
+ (charset (repeat charset))
+ (sample-text string)
+ (setup-function function)
+ (exit-function function)
+ (coding-system (repeat coding-system))
+ (coding-priority (repeat coding-system))
+ (nonascii-translation charset)
+ (input-method
+ (string
+ :completion-ignore-case t
+ :complete-function widget-string-complete
+ :completion-alist input-method-alist
+ :prompt-history input-method-history))
+ (features (repeat symbol))
+ (unibyte-display coding-system)))))
+
(defun standard-display-european-internal ()
;; Actually set up direct output of non-ASCII characters.
(standard-display-8bit (if (eq window-system 'pc) 128 160) 255)
(aset standard-display-table 160 [32])
;; With luck, non-Latin-1 fonts are more recent and so don't
;; have this bug.
- (aset standard-display-table 2208 [32]) ; Latin-1 NBSP
+ (aset standard-display-table (make-char 'latin-iso8859-1 160) [32])
;; Most Windows programs send out apostrophes as \222. Most X fonts
;; don't contain a character at that position. Map it to the ASCII
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
;; fonts probably have the appropriate glyph at this position,
;; so they could use standard-display-8bit. It's better to use a
;; proper windows-1252 coding system. --fx]
- (aset standard-display-table 146 [39]))))
+ (aset standard-display-table 146 [39])
+ ;; XFree86 4 has changed most of the fonts from their designed
+ ;; versions such that `' no longer appears as balanced quotes.
+ ;; Assume it has iso10646 fonts installed, so we can display
+ ;; balanced quotes.
+ (when (and (eq window-system 'x)
+ (string= "The XFree86 Project, Inc" (x-server-vendor))
+ (> (aref (number-to-string (nth 2 (x-server-version))) 0)
+ ?3))
+ ;; We suppress these setting for the moment because the
+ ;; above assumption is wrong.
+ ;; (aset standard-display-table ?' [?\e$B!G\e(B])
+ ;; (aset standard-display-table ?` [?\e$B!F\e(B])
+ ;; The fonts don't have the relevant bug.
+ (aset standard-display-table 160 nil)
+ (aset standard-display-table (make-char 'latin-iso8859-1 160)
+ nil)))))
(defun set-language-environment-coding-systems (language-name
&optional eol-type)
of `buffer-file-coding-system' set by this function."
(let* ((priority (get-language-info language-name 'coding-priority))
(default-coding (car priority)))
- (if priority
- (let ((categories (mapcar 'coding-system-category priority)))
- (set-default-coding-systems
- (if (memq eol-type '(0 1 2 unix dos mac))
- (coding-system-change-eol-conversion default-coding eol-type)
- default-coding))
- (setq default-sendmail-coding-system default-coding)
- (set-coding-priority categories)
- (while priority
- (set (car categories) (car priority))
- (setq priority (cdr priority) categories (cdr categories)))
- (update-coding-systems-internal)))))
+ (when priority
+ (set-default-coding-systems
+ (if (memq eol-type '(0 1 2 unix dos mac))
+ (coding-system-change-eol-conversion default-coding eol-type)
+ default-coding))
+ (setq default-sendmail-coding-system default-coding)
+ (apply 'set-coding-system-priority priority))))
(defsubst princ-list (&rest args)
"Print all arguments with `princ', then print \"\n\"."
(put 'describe-specified-language-support 'apropos-inhibit t)
-;; Print a language specific information such as input methods,
+;; Print language-specific information such as input methods,
;; charsets, and coding systems. This function is intended to be
;; called from the menu:
;; [menu-bar mule describe-language-environment LANGUAGE]
(error "No documentation for the specified language"))
(if (symbolp language-name)
(setq language-name (symbol-name language-name)))
+ (dolist (feature (get-language-info language-name 'features))
+ (require feature))
(let ((doc (get-language-info language-name 'documentation))
pos)
(help-setup-xref (list #'describe-language-environment language-name)
(setq l (cons input-method (delete input-method l))))
(insert ":\n")
(while l
- (when (string= language-name (nth 1 (car l)))
+ (when (eq t (compare-strings language-name nil nil
+ (nth 1 (car l)) nil nil t))
(insert " " (car (car l)))
(search-backward (car (car l)))
(help-xref-button 0 'help-input-method (car (car l)))
"' in mode line):\n\t"
(coding-system-doc-string (car l))
"\n")
- (let ((aliases (coding-system-get (car l)
- 'alias-coding-systems)))
+ (let ((aliases (coding-system-aliases (car l))))
(when aliases
(insert "\t(alias:")
(while aliases
;; http://www.din.de/gremien/nas/nabd/iso3166ma/codlstp1/en_listp1.html.
;; CODESET and MODIFIER are implementation-dependent.
+ ;; jasonr comments: MS Windows uses three letter codes for
+ ;; languages instead of the two letter ISO codes that POSIX
+ ;; uses. In most cases the first two letters are the same, so
+ ;; most of the regexps in locale-language-names work. Japanese
+ ;; and Chinese are exceptions, which are listed in the
+ ;; non-standard section at the bottom of locale-language-names.
+
; aa Afar
; ab Abkhazian
("af" . "Latin-1") ; Afrikaans
("ca" . "Latin-1") ; Catalan
; co Corsican
("cs" . "Czech")
- ("cy" . "Welsh") ; Welsh
+ ("cy" . "Welsh") ; Welsh [glibc uses Latin-8. Did this change?]
("da" . "Latin-1") ; Danish
("de" . "German")
; dz Bhutani
("el" . "Greek")
;; Users who specify "en" explicitly typically want Latin-1, not ASCII.
+ ;; That's actually what the GNU locales define, modulo things like
+ ;; en_IN -- fx.
("en" . "Latin-1") ; English
("eo" . "Latin-3") ; Esperanto
("es" . "Spanish")
; ha Hausa
("he" . "Hebrew")
("hi" . "Devanagari") ; Hindi glibc uses utf-8
- ("hr" . "Latin-2") ; Croatian
+ ("hr" . "Croatian") ; Croatian
("hu" . "Latin-2") ; Hungarian
; hy Armenian
; ia Interlingua
; ie Interlingue
; ik Inupiak
("is" . "Latin-1") ; Icelandic
- ("it" . "Latin-1") ; Italian
+ ("it" . "Italian") ; Italian
; iu Inuktitut
("ja" . "Japanese")
; jw Javanese
("rm" . "Latin-1") ; Rhaeto-Romanic
; rn Kirundi
("ro" . "Romanian")
- ("ru.*[_.]koi8" . "Cyrillic-KOI8") ; Russian
+ ("ru.*[_.]koi8\\(?:-r\\)?\\'" . "Cyrillic-KOI8") ; Russian
("ru" . "Cyrillic-ISO") ; Russian
; rw Kinyarwanda
("sa" . "Devanagari") ; Sanskrit
; so Somali
("sq" . "Latin-1") ; Albanian
("sr" . "Latin-2") ; Serbian (Latin alphabet)
- ("sr_YU@cyrillic" . "Cyrillic-ISO") ; per glibc
+ ("sr.*@cyrillic" . "Cyrillic-ISO") ; per glibc
; ss Siswati
; st Sesotho
; su Sundanese
- ("sv" . "Latin-1") ; Swedish
+ ("sv" . "Swedish") ; Swedish
("sw" . "Latin-1") ; Swahili
; ta Tamil glibc uses utf-8
; te Telugu glibc uses utf-8
("tl" . "Latin-1") ; Tagalog
; tn Setswana
; to Tonga
- ("tr" . "Latin-5") ; Turkish
+ ("tr" . "Turkish")
; ts Tsonga
; tt Tatar
; tw Twi
; za Zhuang
; glibc:
- ; zh_CN.GB18030/GB18030 \
- ; zh_CN.GBK/GBK \
; zh_HK/BIG5-HKSCS \
- ; zh_TW/BIG5 \
- ; zh_TW.EUC-TW/EUC-TW \
("zh.*[._]big5" . "Chinese-BIG5")
- ("zh.*[._]gbk" . nil) ; Solaris 2.7; has gbk-0 as well as GB 2312.1980-0
- ("zh_tw" . "Chinese-CNS")
+ ("zh.*[._].gb18030" . "Chinese-GB18030") ; zh_CN.GB18030/GB18030 in glibc
+ ("zh.*[._].gbk" . "Chinese-GBK")
+ ;; glibc has zh_TW.EUC-TW, with zh_TW defaulting to Big5
+ ("zh_tw" . "Chinese-CNS") ; glibc uses big5
+ ("zh_tw[._]euc-tw" . "Chinese-EUC-TW")
("zh" . "Chinese-GB")
; zu Zulu
(".*8859[-_]?9\\>" . "Latin-5")
(".*8859[-_]?14\\>" . "Latin-8")
(".*8859[-_]?15\\>" . "Latin-9")
- (".*utf\\(-?8\\)\\>" . "UTF-8")
+ (".*utf\\(?:-?8\\)?\\>" . "UTF-8")
;; utf-8@euro exists, so put this last. (@euro really specifies
;; the currency, rather than the charset.)
(".*@euro\\>" . "Latin-9")))
"List of pairs of locale regexps and charset language names.
The first element whose locale regexp matches the start of a downcased locale
-specifies the language name whose charsets corresponds to that locale.
+specifies the language name whose charset corresponds to that locale.
This language name is used if its charsets disagree with the charsets of
the language name that would otherwise be used for this locale.")
The first element whose locale regexp matches the start of a downcased locale
specifies the coding system to prefer when using that locale.")
-(defconst standard-keyboard-coding-systems
- (purecopy
- '(iso-latin-1 iso-latin-2 iso-latin-3 iso-latin-4 iso-latin-5
- iso-latin-6 iso-latin-7 iso-latin-8 iso-latin-9 koi8-u koi8-r))
- "Coding systems that are commonly used for keyboards.
-`set-locale-environment' will set the `keyboard-coding-system' if the
-coding-system specified by the locale setting is a member of this list.")
-
(defun locale-name-match (key alist)
"Search for KEY in ALIST, which should be a list of regexp-value pairs.
Return the value corresponding to the first regexp that matches the
(setq alist (cdr alist)))
(cdr element)))
+(defun locale-charset-match-p (charset1 charset2)
+ "Whether charset names (strings) CHARSET1 and CHARSET2 are equivalent.
+Matching is done ignoring case and any hyphens and underscores in the
+names. E.g. `ISO_8859-1' and `iso88591' both match `iso-8859-1'."
+ (setq charset1 (replace-regexp-in-string "[-_]" "" charset1))
+ (setq charset2 (replace-regexp-in-string "[-_]" "" charset2))
+ (eq t (compare-strings charset1 nil nil charset2 nil nil t)))
+
+(defvar locale-charset-alist nil
+ "Coding system alist keyed on locale-style charset name.
+Used by `locale-charset-to-coding-system'.")
+
+(defun locale-charset-to-coding-system (charset)
+ "Find coding system corresponding to CHARSET.
+CHARSET is any sort of non-Emacs charset name, such as might be used
+in a locale codeset, or elsewhere. It is matched to a coding system
+first by case-insensitive lookup in `locale-charset-alist'. Then
+matches are looked for in the coding system list, treating case and
+the characters `-' and `_' as insignificant. The coding system base
+is returned. Thus, for instance, if charset \"ISO8859-2\",
+`iso-latin-2' is returned."
+ (or (car (assoc-string charset locale-charset-alist t))
+ (let ((cs coding-system-alist)
+ c)
+ (while (and (not c) cs)
+ (if (locale-charset-match-p charset (caar cs))
+ (setq c (intern (caar cs)))
+ (pop cs)))
+ (if c (coding-system-base c)))))
+
+;; Fixme: This ought to deal with the territory part of the locale
+;; too, for setting things such as calendar holidays, ps-print paper
+;; size, spelling dictionary.
+
(defun set-locale-environment (&optional locale-name)
"Set up multi-lingual environment for using LOCALE-NAME.
This sets the language environment, the coding system priority,
the default input method and sometimes other things.
-LOCALE-NAME should be a string
-which is the name of a locale supported by the system;
-often it is of the form xx_XX.CODE, where xx is a language,
-XX is a country, and CODE specifies a character set and coding system.
-For example, the locale name \"ja_JP.EUC\" might name a locale
-for Japanese in Japan using the `japanese-iso-8bit' coding-system.
+LOCALE-NAME should be a string which is the name of a locale supported
+by the system. Often it is of the form xx_XX.CODE, where xx is a
+language, XX is a country, and CODE specifies a character set and
+coding system. For example, the locale name \"ja_JP.EUC\" might name
+a locale for Japanese in Japan using the `japanese-iso-8bit'
+coding-system. The name may also have a modifier suffix, e.g. `@euro'
+or `@cyrillic'.
If LOCALE-NAME is nil, its value is taken from the environment
variables LC_ALL, LC_CTYPE and LANG (the first one that is set).
See also `locale-charset-language-names', `locale-language-names',
`locale-preferred-coding-systems' and `locale-coding-system'."
(interactive "sSet environment for locale: ")
-
+
;; Do this at runtime for the sake of binaries possibly transported
;; to a system without X.
(setq locale-translation-file-name
(let ((files
'("/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
- "/usr/X11R6/lib/X11/locale/locale.alias" ; e.g. RedHat 4.2
+ "/usr/X11R6/lib/X11/locale/locale.alias" ; XFree86, e.g. RedHat 4.2
"/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6
;;
;; The following name appears after the X-related names above,
;; Use the first of these three environment variables
;; that has a nonempty value.
(let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
- (while (and vars (not (setq locale (getenv (car vars)))))
- (setq vars (cdr vars)))))
+ (while (and vars
+ (= 0 (length locale))) ; nil or empty string
+ (setq locale (getenv (pop vars))))))
(when locale
;; using the translation file that many systems have.
(when locale-translation-file-name
(with-temp-buffer
+ (set-buffer-multibyte nil)
(insert-file-contents locale-translation-file-name)
(when (re-search-forward
(concat "^" (regexp-quote locale) ":?[ \t]+") nil t)
(charset-language-name
(locale-name-match locale locale-charset-language-names))
(coding-system
- (locale-name-match locale locale-preferred-coding-systems)))
+ (or (locale-name-match locale locale-preferred-coding-systems)
+ (when locale
+ (if (string-match "\\.\\([^@]+\\)" locale)
+ (locale-charset-to-coding-system
+ (match-string 1 locale)))))))
;; Give preference to charset-language-name over language-name.
(if (and charset-language-name
(when default-enable-multibyte-characters
(set-display-table-and-terminal-coding-system language-name))
- ;; Set the `keyboard-coding-system' if appropriate.
- (let ((kcs (or coding-system
- (car (get-language-info language-name
- 'coding-system)))))
- (if (memq kcs standard-keyboard-coding-systems)
- (set-keyboard-coding-system kcs)))
+ ;; Set the `keyboard-coding-system' if appropriate (tty
+ ;; only). At least X and MS Windows can generate
+ ;; multilingual input.
+ (unless window-system
+ (let ((kcs (or coding-system
+ (car (get-language-info language-name
+ 'coding-system)))))
+ (if kcs (set-keyboard-coding-system kcs))))
(setq locale-coding-system
(car (get-language-info language-name 'coding-priority))))
(when coding-system
(prefer-coding-system coding-system)
- (setq locale-coding-system coding-system))))))
+ (setq locale-coding-system coding-system))
+ (when (get-language-info current-language-environment 'coding-priority)
+ (let ((codeset (locale-info 'codeset))
+ (coding-system (car (coding-system-priority-list))))
+ (when codeset
+ (let ((cs (coding-system-aliases coding-system))
+ result)
+ (while (and cs (not result))
+ (setq result
+ (locale-charset-match-p (symbol-name (pop cs))
+ (locale-info 'codeset))))
+ (unless result
+ (message "Warning: Default coding system `%s' disagrees with
+system codeset `%s' for this locale." coding-system codeset))))))))
+
+ ;; On Windows, override locale-coding-system, keyboard-coding-system,
+ ;; selection-coding-system with system codepage.
+ (when (boundp 'w32-ansi-code-page)
+ (let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
+ (when (coding-system-p code-page-coding)
+ (setq locale-coding-system code-page-coding)
+ (set-selection-coding-system code-page-coding)
+ (set-keyboard-coding-system code-page-coding)
+ (set-terminal-coding-system code-page-coding))))
+
+ ;; Default to A4 paper if we're not in a C, POSIX or US locale.
+ ;; (See comments in Flocale_info.)
+ (let ((locale locale)
+ (paper (locale-info 'paper)))
+ (if paper
+ ;; This will always be null at the time of writing.
+ (cond
+ ((equal paper '(216 279))
+ (setq ps-paper-type 'letter))
+ ((equal paper '(210 297))
+ (setq ps-paper-type 'a4)))
+ (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
+ (while (and vars (= 0 (length locale)))
+ (setq locale (getenv (pop vars)))))
+ (when locale
+ ;; As of glibc 2.2.5, these are the only US Letter locales,
+ ;; and the rest are A4.
+ (setq ps-paper-type
+ (or (locale-name-match locale '(("c$" . letter)
+ ("posix$" . letter)
+ (".._us" . letter)
+ (".._pr" . letter)
+ (".._ca" . letter)
+ ("enu$" . letter) ; Windows
+ ("esu$" . letter)
+ ("enc$" . letter)
+ ("frc$" . letter)))
+ 'a4))))))
+ nil)
\f
-;;; Charset property
-
-(defun get-charset-property (charset propname)
- "Return the value of CHARSET's PROPNAME property.
-This is the last value stored with
- (put-charset-property CHARSET PROPNAME VALUE)."
- (and (not (eq charset 'composition))
- (plist-get (charset-plist charset) propname)))
-
-(defun put-charset-property (charset propname value)
- "Store CHARSETS's PROPNAME property with value VALUE.
-It can be retrieved with `(get-charset-property CHARSET PROPNAME)'."
- (or (eq charset 'composition)
- (set-charset-plist charset
- (plist-put (charset-plist charset) propname value))))
-
;;; Character code property
(put 'char-code-property-table 'char-table-extra-slots 0)
"Return a pretty description of STR that is encoded by CODING-SYSTEM."
(setq str (string-as-unibyte str))
(mapconcat
- (if (and coding-system (eq (coding-system-type coding-system) 2))
+ (if (and coding-system (eq (coding-system-type coding-system) 'iso-2022))
;; Try to get a pretty description for ISO 2022 escape sequences.
(function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
- (format "%02X" x))))
+ (format "0x%02X" x))))
(function (lambda (x) (format "0x%02X" x))))
str " "))
(defun encode-coding-char (char coding-system)
"Encode CHAR by CODING-SYSTEM and return the resulting string.
If CODING-SYSTEM can't safely encode CHAR, return nil."
- (let ((str1 (string-as-multibyte (char-to-string char)))
- (str2 (string-as-multibyte (make-string 2 char)))
- (safe-chars (and coding-system
- (coding-system-get coding-system 'safe-chars)))
- (charset (char-charset char))
+ (let ((str1 (string-as-multibyte (string char)))
+ (str2 (string-as-multibyte (string char char)))
enc1 enc2 i1 i2)
- (when (or (eq safe-chars t)
- (eq charset 'ascii)
- (and safe-chars (aref safe-chars char)))
+ (when (memq (coding-system-base coding-system)
+ (find-coding-systems-string str1))
;; We must find the encoded string of CHAR. But, just encoding
;; CHAR will put extra control sequences (usually to designate
- ;; ASCII charaset) at the tail if type of CODING is ISO 2022.
+ ;; ASCII charset) at the tail if type of CODING is ISO 2022.
;; To exclude such tailing bytes, we at first encode one-char
;; string and two-char string, then check how many bytes at the
;; tail of both encoded strings are the same.
;; exclude.
(substring enc2 0 i2))))
+;; Backwards compatibility. These might be better with :init-value t,
+;; but that breaks loadup.
+(define-minor-mode unify-8859-on-encoding-mode
+ "Obsolete."
+ :group 'mule
+ :global t)
+(define-minor-mode unify-8859-on-decoding-mode
+ "Obsolete."
+ :group 'mule
+ :global t)
+
+(defvar nonascii-insert-offset 0 "This variable is obsolete.")
+(defvar nonascii-translation-table nil "This variable is obsolete.")
+
+;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
;;; mule-cmds.el ends here
HCoop / bpt / emacs.git / blobdiff