-;;; mule-cmds.el --- commands for mulitilingual environment
-
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
-;; Copyright (C) 2001, 2002
+;;; 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
;;; Code:
-(eval-when-compile (defvar dos-codepage))
+(eval-when-compile
+ (defvar dos-codepage)
+ (require 'wid-edit))
;;; MULE related key bindings and menus.
(define-key ctl-x-map "\C-m" mule-keymap)
(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
:help "Display multilingual environment settings")
t)
-(define-key-after set-coding-system-map [set-buffer-file-coding-system]
- '(menu-item "For Saving this Buffer" set-buffer-file-coding-system
- :help "How to encode this buffer on disk")
- t)
(define-key-after set-coding-system-map [universal-coding-system-argument]
'(menu-item "For Next Command" universal-coding-system-argument
:help "Coding system to be used by next command")
t)
-(define-key-after set-coding-system-map [set-terminal-coding-system]
- '(menu-item "For Terminal" set-terminal-coding-system
- :enable (null (memq window-system '(x w32 mac)))
- :help "How to encode terminal output")
+(define-key-after set-coding-system-map [separator-1]
+ '("--")
+ t)
+(define-key-after set-coding-system-map [set-buffer-file-coding-system]
+ '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
+ :help "How to encode this buffer when saved")
+ t)
+(define-key-after set-coding-system-map [revert-buffer-with-coding-system]
+ '(menu-item "For Reverting This File Now" revert-buffer-with-coding-system
+ :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)
+
(define-key-after set-coding-system-map [set-keyboard-coding-system]
'(menu-item "For Keyboard" set-keyboard-coding-system
:help "How to decode keyboard input")
t)
-(define-key-after set-coding-system-map [set-buffer-process-coding-system]
- '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
- :visible (fboundp 'start-process)
- :enable (get-buffer-process (current-buffer))
- :help "How to en/decode I/O from/to subprocess connected to this buffer")
+(define-key-after set-coding-system-map [set-terminal-coding-system]
+ '(menu-item "For Terminal" set-terminal-coding-system
+ :enable (null (memq window-system '(x w32 mac)))
+ :help "How to encode terminal output")
+ t)
+(define-key-after set-coding-system-map [separator-3]
+ '("--")
t)
(define-key-after set-coding-system-map [set-selection-coding-system]
'(menu-item "For X Selections/Clipboard" set-selection-coding-system
:visible (display-selections-p)
:help "How to en/decode next selection/clipboard operation")
t)
+(define-key-after set-coding-system-map [set-buffer-process-coding-system]
+ '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
+ :visible (fboundp 'start-process)
+ :enable (get-buffer-process (current-buffer))
+ :help "How to en/decode I/O from/to subprocess connected to this buffer")
+ t)
+
+
(define-key setup-language-environment-map
[Default] '(menu-item "Default" setup-specified-language-environment))
but end-of-line as the same way as CODING-SYSTEM.
If CODING is nil, the returned coding system detects
how text is formatted automatically while decoding."
- (if (not coding)
- (coding-system-base coding-system)
- (let ((eol-type (coding-system-eol-type coding-system)))
- (coding-system-change-eol-conversion
- coding
- (if (numberp eol-type) (aref [unix dos mac] eol-type))))))
+ (let ((eol-type (coding-system-eol-type coding-system)))
+ (coding-system-change-eol-conversion
+ (if coding coding 'undecided)
+ (if (numberp eol-type) (aref [unix dos mac] eol-type)))))
(defun toggle-enable-multibyte-characters (&optional arg)
"Change whether this buffer uses multibyte characters.
;; 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 ()
+(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
- ;; Fixme: what is t here?
+ (interactive
+ (let ((default (and buffer-file-coding-system
(not (eq (coding-system-type buffer-file-coding-system)
- t))
- buffer-file-coding-system))
- (coding-system (read-coding-system
- (if default
- (format "Coding system for following command (default, %s): " default)
- "Coding system for following command: ")
- default))
- (keyseq (read-key-sequence
+ 'undecided))
+ buffer-file-coding-system)))
+ (list (read-coding-system
+ (if default
+ (format "Coding system for following command (default, %s): " default)
+ "Coding system for following command: ")
+ default))))
+ (let* ((keyseq (read-key-sequence
(format "Command to execute with %s:" coding-system)))
(cmd (key-binding keyseq))
prefix)
(when (eq cmd 'universal-argument)
(call-interactively cmd)
-
+
;; Process keys bound in `universal-argument-map'.
(while (progn
(setq keyseq (read-key-sequence nil t)
;; 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
(unless (and (eq window-system 'pc) coding-system)
(setq default-terminal-coding-system coding-system))
(setq default-keyboard-coding-system coding-system)
- (setq default-process-coding-system (cons coding-system coding-system)))
+ ;; 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
+ ;; users shell appropriately, so should not be altered by changing
+ ;; language environment.
+ (let ((output-coding
+ (coding-system-change-text-conversion
+ (car default-process-coding-system) coding-system))
+ (input-coding
+ (coding-system-change-text-conversion
+ (cdr default-process-coding-system) coding-system)))
+ (setq default-process-coding-system
+ (cons output-coding input-coding))))
(defalias 'update-iso-coding-systems 'update-coding-systems-internal)
(make-obsolete 'update-iso-coding-systems 'update-coding-systems-internal "20.3")
startup.
A coding system that requires automatic detection of text
-encoding (e.g. undecided, unix) can't be preferred.."
++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))
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 (coding-system-priority-list t))
+ (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)
-;; Fixme: sort out coding-system-spec
-;; (if (eq (coding-system-type base) 'iso-2022)
-;; ;; For ISO based coding systems, prefer
-;; ;; one that doesn't use escape sequences.
-;; (let* ((extra-spec (coding-system-spec base))
-;; (flags (aref extra-spec 3)))
-;; (if (/= (logand flags #x40) 0)
-;; (if (/= (logand flags #x30) 0)
-;; 0
-;; 1)
-;; 2))
-;; 1)
+ 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 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.
(t
(let (codings)
(dolist (cs (coding-system-list t))
- (let ((cs-charsets (coding-system-get cs :charset-list))
+ (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))
(push cs codings))))
(nreverse codings)))))
-;; Fixme: is this doing the right thing now, at least with eight-bit?
(defun find-multibyte-characters (from to &optional maxcount excludes)
"Find multibyte characters in the region specified by FROM and TO.
If FROM is a string, find multibyte characters in the string.
(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 (or (memq charset '(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 (or (memq charset '(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.
+If such a character is found, set point after that character.
+Otherwise, don't move point.
+
+When called from a program, the value is a position of the found character,
+or nil if all characters are encodable."
+ (interactive
+ (list (let ((default (or buffer-file-coding-system 'us-ascii)))
+ (read-coding-system
+ (format "Coding-system (default, %s): " default)
+ default))))
+ (let ((pos (unencodable-char-position (point) (point-max) coding-system)))
+ (if pos
+ (goto-char (1+ pos))
+ (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
overrides that argument.")
(defun select-safe-coding-system (from to &optional default-coding-system
- accept-default-p)
+ accept-default-p file)
"Ask a user to select a safe coding system from candidates.
The candidates of coding systems which can safely encode a text
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 silently selected and returned without
-any user interaction. See also the command `prefer-coding-system'.
+that safely encodes the text is normally selected silently and
+returned without any user interaction. See also the command
+`prefer-coding-system'.
+
+However, the user is queried if the chosen coding system is
+inconsistent with what would be selected by `set-auto-coding' from
+coding cookies &c. if the contents of the region were read from a
+file. (That could lead to data corruption in a file subsequently
+re-visited and edited.)
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.
It is called with that coding system, and should return nil if it
should not be silently selected and thus user interaction is required.
+Optional 5th arg FILE is the file name to use for this purpose.
+That is different from `buffer-file-name' when handling `write-region'
+\(for example).
+
The variable `select-safe-coding-system-accept-default-p', if
non-nil, overrides ACCEPT-DEFAULT-P.
(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 ((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 (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, change each coding system to the corresponding
+ (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
;; is more friendly to users.
(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))
+ (if (and mime-charset (coding-system-p mime-charset)
+ (coding-system-equal (car l) mime-charset))
(setcar l mime-charset))
(setq l (cdr l))))
- ;; Make sure the offending buffer is displayed.
- (or (stringp from)
- (pop-to-buffer bufname))
- ;; Then ask users to select one form CODINGS.
- (unwind-protect
- (save-window-excursion
- (with-output-to-temp-buffer "*Warning*"
- (save-excursion
- (set-buffer standard-output)
- (if (not default-coding-system)
- (insert "No default coding systems to try for "
- (if (stringp from)
- (format "string \"%s\"." from)
- (format "buffer `%s'." bufname)))
- (insert
- "These default coding systems were tried to encode"
- (if (stringp from)
- (concat " \"" (if (> (length from) 10)
- (concat (substring from 0 10) "...\"")
- (concat from "\"")))
- (format " text\nin the buffer `%s'" bufname))
- ":\n")
- (let ((pos (point))
- (fill-prefix " "))
- (mapcar (function (lambda (x)
- (princ " ") (princ (car x))))
- default-coding-system)
- (insert "\n")
- (fill-region-as-paragraph pos (point)))
- (insert
- (if (consp coding-system)
- (concat (format "%s safely encodes the target text,\n"
- (car coding-system))
- "but it is not recommended for encoding text in this context,\n"
- "e.g., for sending an email message.\n")
- "However, none of them safely encodes the target text.\n")))
- (insert (if (consp coding-system)
- "\nSelect the above, or "
- "\nSelect ")
- "one of the following safe coding systems:\n")
+ ;; Don't offer variations with locking shift, which you
+ ;; basically never want.
+ (let (l)
+ (dolist (elt codings (setq codings (nreverse l)))
+ (unless (or (eq 'coding-category-iso-7-else
+ (coding-system-category elt))
+ (eq 'coding-category-iso-8-else
+ (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
+ ;; 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)))
+ 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)
+ (if (not default-coding-system)
+ (insert "No default coding systems to try for "
+ (if (stringp from)
+ (format "string \"%s\"." from)
+ (format "buffer `%s'." bufname)))
+ (insert
+ "These default coding systems were tried to encode"
+ (if (stringp from)
+ (concat " \"" (if (> (length from) 10)
+ (concat (substring from 0 10) "...\"")
+ (concat from "\"")))
+ (format " text\nin the buffer `%s'" bufname))
+ ":\n")
(let ((pos (point))
(fill-prefix " "))
- (mapcar (function (lambda (x) (princ " ") (princ x)))
- codings)
+ (mapc #'(lambda (x) (princ " ") (princ (car x)))
+ default-coding-system)
(insert "\n")
- (fill-region-as-paragraph pos (point)))))
-
- ;; 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)))
- (kill-buffer "*Warning*")))
-
- (if (vectorp (coding-system-eol-type coding-system))
+ (fill-region-as-paragraph pos (point)))
+ (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 ")
+ (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)))
+ (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)
+ (if (< (point) pos)
+ (goto-char pos)
+ (forward-char 1)
+ (search-unencodable-char 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"))
+ 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 rejected
+ "\nSelect the above, or "
+ "\nSelect ")
+ "\
+one of the following safe coding systems, or edit the buffer:\n")
+ (let ((pos (point))
+ (fill-prefix " "))
+ (mapcar (function (lambda (x) (princ " ") (princ x)))
+ codings)
+ (insert "\n")
+ (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.
+ (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 (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
+ ;; by using `find-file-literally'.
+ (unless (or (stringp from) find-file-literally)
+ (let ((auto-cs (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ (set-auto-coding (or file buffer-file-name "")
+ (buffer-size))))))
+ ;; 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 auto-cs)))
+ (unless (yes-or-no-p
+ (format "Selected encoding %s disagrees with \
+%s specified by file contents. Really save (else edit coding cookies \
+and try again)? " coding-system auto-cs))
+ (error "Save aborted")))))
coding-system))
(setq select-safe-coding-system-function 'select-safe-coding-system)
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,
but as non-ASCII characters in this language
environment.")
-(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.
-
-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)
- ;; 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"
- :complete-function
- (lambda ()
- (interactive)
- (let* ((prefix (buffer-substring-no-properties
- (widget-field-start widget) (point)))
- (completion-ignore-case t)
- (completion (try-completion prefix
- language-info-alist)))
- (cond ((eq completion t)
- (delete-region (widget-field-start widget)
- (widget-field-end widget))
- (insert-and-inherit
- (car (assoc-ignore-case prefix
- language-info-alist)))
- (message "Only match"))
- ((null completion)
- (error "No match"))
- ((not (eq t (compare-strings prefix nil nil
- completion nil nil
- t)))
- (delete-region (widget-field-start widget)
- (widget-field-end widget))
- (insert-and-inherit completion))
- (t
- (message "Making completion list...")
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list
- (all-completions prefix language-info-alist
- nil)))
- (message "Making completion list...done"))))))
- :value-type
- (alist :key-type symbol
- :options ((documentation string)
- (charset (repeat symbol))
- (sample-text string)
- (setup-function function)
- (exit-function function)
- (coding-system (repeat coding-system))
- (coding-priority (repeat coding-system))
- (nonascii-translation symbol)
- (input-method string)
- (features (repeat symbol))
- (unibyte-display coding-system)
- (unibyte-syntax string)))))
-
(defun get-language-info (lang-env key)
"Return information listed under KEY for language environment LANG-ENV.
KEY is a symbol denoting the kind of information.
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.
(name (completing-read prompt
language-info-alist
(and key
- (function (lambda (elm) (assq key elm))))
+ (function (lambda (elm) (and (listp elm) (assq key elm)))))
t nil nil default)))
(if (and (> (length name) 0)
(or (not key)
`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)
:group 'mule)
(defcustom input-method-after-insert-chunk-hook nil
- "Normal hook run just after an input method inserts some chunk of text."
+ "Normal hook run just after an input method insert some chunk of text."
:type 'hook
:group 'mule)
: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.
'iso-2022-8bit-ss2
'emacs-mule
'raw-text)
-
+
(set-default-coding-systems nil)
(setq default-sendmail-coding-system 'iso-latin-1)
- (setq default-process-coding-system '(undecided . 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
+ ;; users shell appropriately, so should not be altered by changing
+ ;; language environment.
+ (let ((output-coding
+ ;; When bootstrapping, coding-systems are not defined yet, so
+ ;; we need to catch the error from check-coding-system.
+ (condition-case nil
+ (coding-system-change-text-conversion
+ (car default-process-coding-system) 'undecided)
+ (coding-system-error 'undecided)))
+ (input-coding
+ (condition-case nil
+ (coding-system-change-text-conversion
+ (cdr default-process-coding-system) 'iso-latin-1)
+ (coding-system-error 'iso-latin-1))))
+ (setq default-process-coding-system
+ (cons output-coding input-coding)))
;; Don't alter the terminal and keyboard coding systems here.
;; The terminal still supports the same coding system
;; that it supported a minute ago.
-;;; (set-terminal-coding-system-internal nil)
-;;; (set-keyboard-coding-system-internal nil)
+ ;; (set-terminal-coding-system-internal nil)
+ ;; (set-keyboard-coding-system-internal nil)
(set-unibyte-charset 'iso-8859-1))
(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)))
(cons input-method
(delete input-method input-method-history))))))
- ;; Fixme: default from the environment coding system where that's
- ;; charset-based.
- (apply 'set-charset-priority (get-language-info language-name 'charset))
+ ;; 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.
(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)
(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)))
;; 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
; 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_HK/BIG5-HKSCS \
("zh.*[._]big5" . "Chinese-BIG5")
+ ("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")
+ ("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")
- (".*@euro\\>" . "Latin-9"))) ; utf-8@euro exists, so put this last
+ (".*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.")
("ja.*[._]jis7" . iso-2022-jp)
("ja.*[._]pck" . japanese-shift-jis)
("ja.*[._]sjis" . japanese-shift-jis)
+ ("jpn" . japanese-shift-jis) ; MS-Windows uses this.
(".*[._]utf" . utf-8)))
"List of pairs of locale regexps and preferred coding systems.
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))
- "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))
-;;; encoded-kbd-mode doesn't work properly at present, and i don't
-;;; think this is the right thing to do anyhow. -- fx
-;;; ;; 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
;;; Character code property
(put 'char-code-property-table 'char-table-extra-slots 0)
(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 " "))
(defvar nonascii-translation-table nil "This variable is obsolete.")
+;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
;;; mule-cmds.el ends here