;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
-;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
;; Keywords: mule, multilingual
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
-(eval-when-compile (defvar dos-codepage))
+(eval-when-compile
+ (defvar dos-codepage)
+ (autoload 'widget-value "wid-edit"))
+
+(defvar mac-system-coding-system)
+(defvar mac-system-locale)
;;; MULE related key bindings and menus.
(make-sparse-keymap "Set 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"))
+ (list 'menu-item "Set Language Environment" setup-language-environment-map))
(define-key-after mule-menu-keymap [separator-mule]
'("--")
t)
((eq eol-type 'dos) 1)
((eq eol-type 'mac) 2)
(t eol-type))))
- (let ((orig-eol-type (coding-system-eol-type coding-system)))
- (if (vectorp orig-eol-type)
- (if (not eol-type)
- coding-system
- (aref orig-eol-type eol-type))
- (let ((base (coding-system-base coding-system)))
- (if (not eol-type)
- base
- (if (= eol-type orig-eol-type)
- coding-system
- (setq orig-eol-type (coding-system-eol-type base))
- (if (vectorp orig-eol-type)
- (aref orig-eol-type eol-type))))))))
+ ;; We call `coding-system-base' before `coding-system-eol-type',
+ ;; because the coding-system may not be initialized until then.
+ (let* ((base (coding-system-base coding-system))
+ (orig-eol-type (coding-system-eol-type coding-system)))
+ (cond ((vectorp orig-eol-type)
+ (if (not eol-type)
+ coding-system
+ (aref orig-eol-type eol-type)))
+ ((not eol-type)
+ base)
+ ((= eol-type orig-eol-type)
+ coding-system)
+ ((progn (setq orig-eol-type (coding-system-eol-type base))
+ (vectorp orig-eol-type))
+ (aref orig-eol-type eol-type)))))
(defun coding-system-change-text-conversion (coding-system coding)
"Return a coding system which differs from CODING-SYSTEM in text conversion.
buffer-file-coding-system)))
(list (read-coding-system
(if default
- (format "Coding system for following command (default, %s): " default)
+ (format "Coding system for following command (default %s): " default)
"Coding system for following command: ")
default))))
(let* ((keyseq (read-key-sequence
o coding system of a newly created buffer
o default coding system for subprocess I/O
This also sets the following values:
- o default value used as `file-name-coding-system' for converting file names.
+ o default value used as `file-name-coding-system' for converting file names
+ if CODING-SYSTEM is ASCII-compatible.
o default value for the command `set-terminal-coding-system' (not on MSDOS)
- o default value for the command `set-keyboard-coding-system'."
+ o default value for the command `set-keyboard-coding-system'
+ if CODING-SYSTEM is ASCII-compatible.."
(check-coding-system coding-system)
(setq-default buffer-file-coding-system coding-system)
(if (fboundp 'ucs-set-table-for-input)
(or (local-variable-p 'buffer-file-coding-system buffer)
(ucs-set-table-for-input buffer))))
- (if (and default-enable-multibyte-characters (not (eq system-type 'darwin)))
+ (if (eq system-type 'darwin)
;; The file-name coding system on Darwin systems is always utf-8.
- (setq default-file-name-coding-system coding-system))
+ (setq default-file-name-coding-system 'utf-8)
+ (if (and default-enable-multibyte-characters
+ (or (not coding-system)
+ (not (coding-system-get coding-system 'ascii-incompatible))))
+ (setq default-file-name-coding-system coding-system)))
;; If coding-system is nil, honor that on MS-DOS as well, so
;; that they could reset the terminal coding system.
(unless (and (eq window-system 'pc) coding-system)
(setq default-terminal-coding-system coding-system))
- (setq default-keyboard-coding-system coding-system)
+ (if (or (not coding-system)
+ (not (coding-system-get coding-system 'ascii-incompatible)))
+ (setq default-keyboard-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
(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")
-
(defun prefer-coding-system (coding-system)
"Add CODING-SYSTEM at the front of the priority list for automatic detection.
This also sets the following coding systems:
(defun sort-coding-systems (codings)
"Sort coding system list CODINGS by a priority of each coding system.
+Returns the sorted list. CODINGS is modified by side effects.
If a coding system is most preferred, it has the highest priority.
Otherwise, a coding system corresponds to some MIME charset has higher
(interactive
(list (let ((default (or buffer-file-coding-system 'us-ascii)))
(read-coding-system
- (format "Coding-system (default, %s): " default)
+ (format "Coding-system (default %s): " default)
default))))
(let ((pos (unencodable-char-position (point) (point-max) coding-system)))
(if pos
only if the user was explicitly asked and specified a coding system.")
(defvar select-safe-coding-system-accept-default-p nil
- "If non-nil, a function to control the behaviour of coding system selection.
+ "If non-nil, a function to control the behavior of coding system selection.
The meaning is the same as the argument ACCEPT-DEFAULT-P of the
function `select-safe-coding-system' (which see). This variable
overrides that argument.")
(insert "\n")
(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,
+ (insert "These safely encode the text in the buffer,
+but are not recommended for encoding text in this context,
e.g., for sending an email message.\n ")
(dolist (x rejected)
(princ " ") (princ x))
(insert "\n"))
(when unsafe
- (insert (if rejected "And the others"
+ (insert (if rejected "The other coding systems"
"However, each of them")
- " encountered these problematic characters:\n")
+ " encountered characters it couldn't encode:\n")
(dolist (coding unsafe)
- (insert (format " %s:" (car coding)))
+ (insert (format " %s cannot encode these:" (car coding)))
(let ((i 0)
(func1
#'(lambda (bufname pos)
(insert-text-button
(cdr elt)
:type 'help-xref
+ 'face 'link
'help-echo
"mouse-2, RET: jump to this character"
'help-function func1
(insert-text-button
"..."
:type 'help-xref
+ 'face 'link
'help-echo
"mouse-2, RET: next unencodable character"
'help-function func2
(car coding)))))
(setq i (1+ i))))
(insert "\n"))
- (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 "\nSelect \
-one of the following safe coding systems, or edit the buffer:\n")
+ (insert (substitute-command-keys "\
+
+Click on a character (or switch to this window by `\\[other-window]'\n\
+and select the characters by RET) to jump to the place it appears,\n\
+where `\\[universal-argument] \\[what-cursor-position]' will give information about it.\n"))))
+ (insert (substitute-command-keys "\nSelect \
+one of the safe coding systems listed below,\n\
+or cancel the writing with \\[keyboard-quit] and edit the buffer\n\
+ to remove or modify the problematic characters,\n\
+or specify any other coding system (and risk losing\n\
+ the problematic characters).\n\n"))
(let ((pos (point))
(fill-prefix " "))
(dolist (x codings)
(princ " ") (princ x))
(insert "\n")
- (fill-region-as-paragraph pos (point)))
- (insert "Or specify any other coding system
-at the risk of losing the problematic characters.\n")))
+ (fill-region-as-paragraph pos (point)))))
;; Read a coding system.
(setq coding-system
`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
+inconsistent with what would be selected by `find-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. 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,
+element is t, the cdr part is used as the default coding system list,
i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
and the most preferred coding system are not used.
(not (listp default-coding-system)))
(setq default-coding-system (list default-coding-system)))
- (let ((no-other-defaults nil))
+ (let ((no-other-defaults nil)
+ auto-cs)
+ (unless (or (stringp from) find-file-literally)
+ ;; Find an auto-coding that is specified for the the current
+ ;; buffer and file from the region FROM and TO.
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char from)
+ (setq auto-cs (find-auto-coding (or file buffer-file-name "")
+ (- to from)))
+ (if auto-cs
+ (if (coding-system-p (car auto-cs))
+ (setq auto-cs (car auto-cs))
+ (display-warning
+ :warning
+ (format "\
+Invalid coding system `%s' is specified
+for the current buffer/file by the %s.
+It is highly recommended to fix it before writing to a file."
+ (car auto-cs)
+ (if (eq (cdr auto-cs) :coding) ":coding tag"
+ (format "variable `%s'" (cdr auto-cs)))))
+ (or (yes-or-no-p "Really proceed with writing? ")
+ (error "Save aborted"))
+ (setq auto-cs nil))))))
+
(if (eq (car default-coding-system) t)
(setq no-other-defaults t
default-coding-system (cdr 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))
+ (if (and auto-cs (not no-other-defaults))
+ ;; If the file has a coding cookie, try to use it before anything
+ ;; else (i.e. before default-coding-system which will typically come
+ ;; from file-coding-system-alist).
+ (let ((base (coding-system-base auto-cs)))
+ (or (memq base '(nil undecided))
+ (rassq base default-coding-system)
+ (push (cons auto-cs base) default-coding-system))))
(unless no-other-defaults
;; If buffer-file-coding-system is not nil nor undecided, append it
(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))))
+ (setq default-coding-system
+ (append default-coding-system
+ (list (cons buffer-file-coding-system base)))))))
;; If default-buffer-file-coding-system is not nil nor undecided,
;; append it to the defaults.
(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))))
+ (setq default-coding-system
+ (append default-coding-system
+ (list (cons default-buffer-file-coding-system
+ base)))))))
;; If the most preferred coding system has the property mime-charset,
;; append it to the defaults.
(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)
- safe rejected unsafe)
- (if (eq (car codings) 'undecided)
- ;; Any coding system is ok.
- (setq coding-system t)
- ;; Classify the defaults into safe, rejected, and unsafe.
- (dolist (elt default-coding-system)
- (if (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 (not coding-system)
- (setq coding-system (select-safe-coding-system-interactively
- from to codings unsafe rejected (car codings))))
-
- (if (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))))))
+ (setq default-coding-system
+ (append default-coding-system
+ (list (cons preferred base)))))))
+
+ (if select-safe-coding-system-accept-default-p
+ (setq accept-default-p select-safe-coding-system-accept-default-p))
+
+ ;; Decide the eol-type from the top of the default codings,
+ ;; buffer-file-coding-system, or
+ ;; default-buffer-file-coding-system.
+ (if default-coding-system
+ (let ((default-eol-type (coding-system-eol-type
+ (caar default-coding-system))))
+ (if (and (vectorp default-eol-type) buffer-file-coding-system)
+ (setq default-eol-type (coding-system-eol-type
+ buffer-file-coding-system)))
+ (if (and (vectorp default-eol-type) default-buffer-file-coding-system)
+ (setq default-eol-type (coding-system-eol-type
+ default-buffer-file-coding-system)))
+ (if (and default-eol-type (not (vectorp default-eol-type)))
+ (dolist (elt default-coding-system)
+ (setcar elt (coding-system-change-eol-conversion
+ (car elt) default-eol-type))))))
+
+ (let ((codings (find-coding-systems-region from to))
+ (coding-system nil)
+ safe rejected unsafe)
+ (if (eq (car codings) 'undecided)
+ ;; Any coding system is ok.
+ (setq coding-system (caar default-coding-system))
+ ;; Reverse the list so that elements are accumulated in safe,
+ ;; rejected, and unsafe in the correct order.
+ (setq default-coding-system (nreverse default-coding-system))
+
+ ;; Classify the defaults into safe, rejected, and unsafe.
+ (dolist (elt default-coding-system)
+ (if (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 (not coding-system)
+ (setq coding-system (select-safe-coding-system-interactively
+ from to codings unsafe rejected (car codings))))
+
+ ;; 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'.
+ (when (and auto-cs
+ (not (and
+ coding-system
+ (memq (coding-system-type coding-system) '(0 5)))))
;; Merge coding-system and auto-cs as far as possible.
(if (not coding-system)
(setq coding-system auto-cs)
(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))
+ (error "Save aborted"))))
+ coding-system)))
(setq select-safe-coding-system-function 'select-safe-coding-system)
;; We should never use no-conversion for outgoing mail.
(setq coding nil))
(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))))
- coding)))
+ (setq coding
+ (funcall select-safe-coding-system-function
+ (point-min) (point-max) coding
+ (function (lambda (x)
+ (coding-system-get x 'mime-charset))))))
+ (if coding
+ ;; Be sure to use LF for end-of-line.
+ (setq coding (coding-system-change-eol-conversion coding 'unix))
+ ;; No coding system is decided. Usually this is the case that
+ ;; the current buffer contains only ASCII. So, we hope
+ ;; iso-8859-1 works.
+ (setq coding 'iso-8859-1-unix))
+ coding))
\f
;;; Language support stuff.
see `language-info-alist'."
(if (symbolp lang-env)
(setq lang-env (symbol-name lang-env)))
+ (set-language-info-internal lang-env key info)
+ (if (equal lang-env current-language-environment)
+ (cond ((eq key 'coding-priority)
+ (set-language-environment-coding-systems lang-env))
+ ((eq key 'input-method)
+ (set-language-environment-input-method lang-env))
+ ((eq key 'nonascii-translation)
+ (set-language-environment-nonascii-translation lang-env))
+ ((eq key 'charset)
+ (set-language-environment-charset lang-env))
+ ((eq key 'overriding-fontspec)
+ (set-language-environment-fontset lang-env))
+ ((and (not default-enable-multibyte-characters)
+ (or (eq key 'unibyte-syntax) (eq key 'unibyte-display)))
+ (set-language-environment-unibyte lang-env)))))
+
+(defun set-language-info-internal (lang-env key info)
+ "Internal use only.
+Arguments are the same as `set-language-info'."
(let (lang-slot key-slot)
(setq lang-slot (assoc lang-env language-info-alist))
(if (null lang-slot) ; If no slot for the language, add it.
(define-key-after setup-map (vector (intern lang-env))
(cons lang-env 'setup-specified-language-environment) t)
- (while alist
- (set-language-info lang-env (car (car alist)) (cdr (car alist)))
- (setq alist (cdr alist)))))
+ (dolist (elt alist)
+ (set-language-info-internal lang-env (car elt) (cdr elt)))
+
+ (if (equal lang-env current-language-environment)
+ (set-language-environment lang-env))))
(defun read-language-name (key prompt &optional default)
"Read a language environment name which has information for KEY.
(defun register-input-method (input-method lang-env &rest args)
"Register INPUT-METHOD as an input method for language environment LANG-ENV.
-INPUT-METHOD and LANG-ENV are symbols or strings.
-The remaining arguments are:
- ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARGS...
+INPUT-METHOD and LANG-ENV are symbols or strings.
ACTIVATE-FUNC is a function to call to activate this method.
TITLE is a string to show in the mode line when this method is active.
DESCRIPTION is a string describing this method and what it is good for.
The commands `describe-input-method' and `list-input-methods' need
these duplicated values to show some information about input methods
-without loading the relevant Quail packages."
+without loading the relevant Quail packages.
+\n(fn INPUT-METHOD LANG-ENV ACTIVATE-FUNC TITLE DESCRIPTION &rest ARGS)"
(if (symbolp lang-env)
(setq lang-env (symbol-name lang-env)))
(if (symbolp input-method)
"Describe input method INPUT-METHOD."
(interactive
(list (read-input-method-name
- "Describe input method (default, current choice): ")))
+ "Describe input method (default current choice): ")))
(if (and input-method (symbolp input-method))
(setq input-method (symbol-name input-method)))
(help-setup-xref (list #'describe-input-method
But, if this flag is non-nil, it displays them in echo area instead.")
(defvar input-method-exit-on-invalid-key nil
- "This flag controls the behaviour of an input method on invalid key input.
+ "This flag controls the behavior of an input method on invalid key input.
Usually, when a user types a key which doesn't start any character
handled by the input method, the key is handled by turning off the
input method temporarily. After that key, the input method is re-enabled.
(defun set-display-table-and-terminal-coding-system (language-name &optional coding-system)
"Set up the display table and terminal coding system for LANGUAGE-NAME."
(let ((coding (get-language-info language-name 'unibyte-display)))
- (if coding
+ (if (and coding
+ (or (not coding-system)
+ (coding-system-equal coding coding-system)))
(standard-display-european-internal)
;; The following 2 lines undo the 8-bit display that we set up
;; in standard-display-european-internal, which see. This is in
specifies the character set for the major languages of Western Europe."
(interactive (list (read-language-name
nil
- "Set language environment (default, English): ")))
+ "Set language environment (default English): ")))
(if language-name
(if (symbolp language-name)
(setq language-name (symbol-name language-name)))
'exit-function)))
(run-hooks 'exit-language-environment-hook)
(if (functionp func) (funcall func))))
- (let ((default-eol-type (coding-system-eol-type
- default-buffer-file-coding-system)))
- (reset-language-environment)
-
- ;; The features might set up coding systems.
- (let ((required-features (get-language-info language-name 'features)))
- (while required-features
- (require (car required-features))
- (setq required-features (cdr required-features))))
-
- (setq current-language-environment language-name)
- (set-language-environment-coding-systems language-name default-eol-type))
- (let ((input-method (get-language-info language-name 'input-method)))
- (when input-method
- (setq default-input-method input-method)
- (if input-method-history
- (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)))))
-
- ;; 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))
+ (reset-language-environment)
+ ;; The features might set up coding systems.
(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))))
+ (setq current-language-environment language-name)
+
+ (set-language-environment-coding-systems language-name)
+ (set-language-environment-input-method language-name)
+ (set-language-environment-nonascii-translation language-name)
+ (set-language-environment-charset language-name)
+ (set-language-environment-fontset language-name)
+ ;; Unibyte setups if necessary.
+ (unless default-enable-multibyte-characters
+ (set-language-environment-unibyte language-name))
(let ((func (get-language-info language-name 'setup-function)))
(if (functionp func)
(funcall func)))
- (if (and utf-translate-cjk-mode
- utf-translate-cjk-lang-env
- (not (eq utf-translate-cjk-lang-env language-name))
- (catch 'tag
- (dolist (charset (get-language-info language-name 'charset))
- (if (memq charset utf-translate-cjk-charsets)
- (throw 'tag t)))
- nil))
- (utf-translate-cjk-load-tables))
+
(run-hooks 'set-language-environment-hook)
(force-mode-line-update t))
;; proper windows-1252 coding system. --fx]
(aset standard-display-table 146 [39]))))
-(defun set-language-environment-coding-systems (language-name
- &optional eol-type)
- "Do various coding system setups for language environment LANGUAGE-NAME.
-
-The optional arg EOL-TYPE specifies the eol-type of the default value
-of `buffer-file-coding-system' set by this function."
+(defun set-language-environment-coding-systems (language-name)
+ "Do various coding system setups for language environment LANGUAGE-NAME."
(let* ((priority (get-language-info language-name 'coding-priority))
- (default-coding (car priority)))
+ (default-coding (car priority))
+ (eol-type (coding-system-eol-type default-buffer-file-coding-system)))
(if priority
(let ((categories (mapcar 'coding-system-category priority)))
(set-default-coding-systems
;; Changing the binding of a coding category requires this call.
(update-coding-systems-internal)))))
+(defun set-language-environment-input-method (language-name)
+ "Do various input method setups for language environment LANGUAGE-NAME."
+ (let ((input-method (get-language-info language-name 'input-method)))
+ (when input-method
+ (setq default-input-method input-method)
+ (if input-method-history
+ (setq input-method-history
+ (cons input-method
+ (delete input-method input-method-history)))))))
+
+(defun set-language-environment-nonascii-translation (language-name)
+ "Do unibyte/multibyte translation setup for language environment LANGUAGE-NAME."
+ (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))))))
+
+(defun set-language-environment-charset (language-name)
+ "Do various charset setups for language environment LANGUAGE-NAME."
+ (if (and utf-translate-cjk-mode
+ (not (eq utf-translate-cjk-lang-env language-name))
+ (catch 'tag
+ (dolist (charset (get-language-info language-name 'charset))
+ (if (memq charset utf-translate-cjk-charsets)
+ (throw 'tag t)))
+ nil))
+ (utf-translate-cjk-load-tables)))
+
+(defun set-language-environment-fontset (language-name)
+ "Do various fontset setups for language environment LANGUAGE-NAME."
+ ;; Don't invoke fontset-related functions if fontsets aren't
+ ;; supported in this build of Emacs.
+ (if (fboundp 'fontset-list)
+ (set-overriding-fontspec-internal
+ (get-language-info language-name 'overriding-fontspec))))
+
+(defun set-language-environment-unibyte (language-name)
+ "Do various unibyte-mode setups for language environment LANGUAGE-NAME."
+ ;; 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))
+ (standard-table (standard-case-table))
+ (case-table (make-char-table 'case-table))
+ (ch (if (eq window-system 'pc) 128 160)))
+ (while (< ch 256)
+ (modify-syntax-entry ch " " syntax-table)
+ (setq ch (1+ ch)))
+ (dotimes (i 128)
+ (aset case-table i (aref standard-table i)))
+ (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 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))
+
(defsubst princ-list (&rest args)
"Print all arguments with `princ', then print \"\n\"."
(while args (princ (car args)) (setq args (cdr args)))
(interactive
(list (read-language-name
'documentation
- "Describe language environment (default, current choice): ")))
+ "Describe language environment (default current choice): ")))
(if (null language-name)
(setq language-name current-language-environment))
(if (or (null language-name)
(l (copy-sequence input-method-alist)))
(insert "Input methods")
(when input-method
- (insert " (default, " input-method ")")
+ (insert " (default " input-method ")")
(setq input-method (assoc input-method input-method-alist))
(setq l (cons input-method (delete input-method l))))
(insert ":\n")
("cy" "Welsh" iso-8859-14)
("da" . "Latin-1") ; Danish
("de" "German" iso-8859-1)
+ ; dv Divehi
; dz Bhutani
("el" "Greek" iso-8859-7)
;; 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_IN" "English" utf-8) ; glibc uses utf-8 for English in India
- ("en" . "Latin-1") ; English
- ("eo" . "Latin-3") ; Esperanto
+ ("en" "English" iso-8859-1) ; English
+ ("eo" . "Esperanto") ; Esperanto
("es" "Spanish" iso-8859-1)
("et" . "Latin-1") ; Estonian
("eu" . "Latin-1") ; Basque
("jp" . "Japanese") ; e.g. MS Windows
("chs" . "Chinese-GB") ; MS Windows Chinese Simplified
("cht" . "Chinese-BIG5") ; MS Windows Chinese Traditional
+ ("gbz" . "UTF-8") ; MS Windows Dari Persian
+ ("div" . "UTF-8") ; MS Windows Divehi (Maldives)
+ ("wee" . "Latin-2") ; MS Windows Lower Sorbian
+ ("wen" . "Latin-2") ; MS Windows Upper Sorbian
))
"Alist of locale regexps vs the corresponding languages and coding systems.
Each element has these form:
;; to a system without X.
(setq locale-translation-file-name
(let ((files
- '("/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
+ '("/usr/share/X11/locale/locale.alias" ; e.g. X11R7
+ "/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
"/usr/X11R6/lib/X11/locale/locale.alias" ; XFree86, e.g. RedHat 4.2
"/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6
;;
(= 0 (length locale))) ; nil or empty string
(setq locale (getenv (pop vars))))))
+ (unless locale
+ ;; The two tests are kept separate so the byte-compiler sees
+ ;; that mac-get-preference is only called after checking its existence.
+ (when (fboundp 'mac-get-preference)
+ (setq locale (mac-get-preference "AppleLocale"))
+ (unless locale
+ (let ((languages (mac-get-preference "AppleLanguages")))
+ (unless (= (length languages) 0) ; nil or empty vector
+ (setq locale (aref languages 0)))))))
+ (unless (or locale (not (boundp 'mac-system-locale)))
+ (setq locale mac-system-locale))
+
(when locale
;; Translate "swedish" into "sv_SE.ISO8859-1", and so on,
(locale-name-match locale locale-language-names))
(charset-language-name
(locale-name-match locale locale-charset-language-names))
+ (default-eol-type (coding-system-eol-type
+ default-buffer-file-coding-system))
(coding-system
(or (locale-name-match locale locale-preferred-coding-systems)
(when locale
(if (string-match "\\.\\([^@]+\\)" locale)
(locale-charset-to-coding-system
- (match-string 1 locale)))))))
+ (match-string 1 locale))))
+ (and (eq system-type 'macos) mac-system-coding-system))))
(if (consp language-name)
;; locale-language-names specify both lang-env and coding.
(if (not language-name)
(setq language-name charset-language-name)))
+ ;; If a specific EOL conversion was specified in the default
+ ;; buffer-file-coding-system, preserve it in the coding system
+ ;; we will be using from now on.
+ (if (and (memq default-eol-type '(0 1 2 unix dos mac))
+ coding-system
+ (coding-system-p coding-system))
+ (setq coding-system (coding-system-change-eol-conversion
+ coding-system default-eol-type)))
+
(when language-name
;; Set up for this character set. This is now the right way
(not (coding-system-equal coding-system
locale-coding-system)))
(prefer-coding-system coding-system)
+ ;; Fixme: perhaps prefer-coding-system should set this too.
+ ;; But it's not the time to do such a fundamental change.
+ (setq default-sendmail-coding-system coding-system)
(setq locale-coding-system coding-system))))
;; On Windows, override locale-coding-system,
(if (and coding-system (eq (coding-system-type coding-system) 2))
;; Try to get a pretty description for ISO 2022 escape sequences.
(function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
- (format "0x%02X" x))))
- (function (lambda (x) (format "0x%02X" x))))
+ (format "#x%02X" x))))
+ (function (lambda (x) (format "#x%02X" x))))
str " "))
(defun encode-coding-char (char coding-system)