-;;; mule-cmds.el --- Commands for mulitilingual environment
+;;; mule-cmds.el --- commands for mulitilingual environment
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
;; Keywords: mule, multilingual
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(eval-when-compile (defvar dos-codepage))
(define-key mule-keymap "c" 'universal-coding-system-argument)
(define-key mule-keymap "l" 'set-language-environment)
-(define-key help-map "\C-L" 'describe-language-environment)
-(define-key help-map "L" 'describe-language-environment)
-(define-key help-map "\C-\\" 'describe-input-method)
-(define-key help-map "I" 'describe-input-method)
-(define-key help-map "C" 'describe-coding-system)
-(define-key help-map "h" 'view-hello-file)
-
(defvar mule-menu-keymap
(make-sparse-keymap "Mule (Multilingual Environment)")
"Keymap for Mule (Multilingual environment) menu specific commands.")
;; but it won't be used that frequently.
(define-key global-map "\C-\\" 'toggle-input-method)
-;;; This is no good because people often type Shift-SPC
-;;; meaning to type SPC. -- rms.
-;;; ;; Here's an alternative key binding for X users (Shift-SPACE).
-;;; (define-key global-map [?\S- ] 'toggle-input-method)
+;; This is no good because people often type Shift-SPC
+;; meaning to type SPC. -- rms.
+;; ;; Here's an alternative key binding for X users (Shift-SPACE).
+;; (define-key global-map [?\S- ] 'toggle-input-method)
+
+;;; Mule related hyperlinks.
+(defconst help-xref-mule-regexp-template
+ (purecopy (concat "\\(\\<\\("
+ "\\(coding system\\)\\|"
+ "\\(input method\\)\\|"
+ "\\(character set\\)\\|"
+ "\\(charset\\)"
+ "\\)\\s-+\\)?"
+ ;; Note starting with word-syntax character:
+ "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")))
(defun coding-system-change-eol-conversion (coding-system eol-type)
"Return a coding system which differs from CODING-SYSTEM in eol conversion.
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.
default))
(keyseq (read-key-sequence
(format "Command to execute with %s:" coding-system)))
- (cmd (key-binding keyseq)))
+ (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)
+ cmd (key-binding keyseq t))
+ (not (eq cmd 'universal-argument-other-key)))
+ (let ((current-prefix-arg prefix-arg)
+ ;; Have to bind `last-command-char' here so that
+ ;; `digit-argument', for isntance, can compute the
+ ;; prefix arg.
+ (last-command-char (aref keyseq 0)))
+ (call-interactively cmd)))
+
+ ;; This is the final call to `univeral-argument-other-key', which
+ ;; set's the final `prefix-arg.
+ (let ((current-prefix-arg prefix-arg))
+ (call-interactively cmd))
+
+ ;; Read the command to execute with the given prefix arg.
+ (setq prefix prefix-arg
+ keyseq (read-key-sequence nil t)
+ cmd (key-binding keyseq)))
+
(let ((coding-system-for-read coding-system)
- (coding-system-for-write coding-system))
+ (coding-system-for-write coding-system)
+ (current-prefix-arg prefix))
(message "")
(call-interactively cmd))))
(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")
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.
o default value for the command `set-terminal-coding-system' (not on MSDOS)
o default value for the command `set-keyboard-coding-system'
This command does not change the default value of terminal coding system
for MS-DOS terminal, because DOS terminals only support a single coding
system, and Emacs automatically sets the default to that coding system at
-startup."
+startup.
+
+A coding system that requires automatic detection of text
+encoding (e.g. undecided, unix) can't be preferred.
+
+See also `coding-category-list' and `coding-system-category'."
(interactive "zPrefer coding system: ")
(if (not (and coding-system (coding-system-p coding-system)))
(error "Invalid coding system `%s'" 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
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.
;; If the most preferred coding system has the property mime-charset,
;; append it to the defaults.
- (let* ((preferred (symbol-value (car coding-category-list)))
- (base (coding-system-base preferred)))
- (and (coding-system-get preferred 'mime-charset)
+ (let ((tail coding-category-list)
+ preferred base)
+ (while (and tail
+ (not (setq preferred (symbol-value (car tail)))))
+ (setq tail (cdr tail)))
+ (and (coding-system-p preferred)
+ (setq base (coding-system-base preferred))
+ (coding-system-get preferred 'mime-charset)
(not (assq preferred default-coding-system))
(not (rassq base default-coding-system))
(setq default-coding-system
(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.
(setcar l mime-charset))
(setq l (cdr l))))
+ ;; 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))))
+
+ ;; 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)
- (insert "The following default coding systems were tried:\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"))
+ (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 ")
(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.
+ (unless (stringp from)
+ (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))))))
+ (if (and auto-cs
+ (not (coding-system-equal (coding-system-base coding-system)
+ (coding-system-base 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)
(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)
name)))
\f
;;; Multilingual input methods.
+(defgroup leim nil
+ "LEIM: Libraries of Emacs Input Methods."
+ :group 'mule)
(defconst leim-list-file-name "leim-list.el"
"Name of LEIM list file.
";;; %s -- list of LEIM (Library of Emacs Input Method)
;;
;; This file contains a list of LEIM (Library of Emacs Input Method)
-;; in the same directory as this file. Loading this file registers
-;; the whole input methods in Emacs.
+;; methods in the same directory as this file. Loading this file
+;; registers all the input methods in Emacs.
;;
;; Each entry has the form:
;; (register-input-method
;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC
;; TITLE DESCRIPTION
;; ARG ...)
-;; See the function `register-input-method' for the meanings of arguments.
+;; See the function `register-input-method' for the meanings of the arguments.
;;
;; If this directory is included in load-path, Emacs automatically
;; loads this file at startup time.
See the function `register-input-method' for the meanings of the elements.")
(defun register-input-method (input-method lang-env &rest args)
- "Register INPUT-METHOD as an input method for language environment ENV.
+ "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:
All told, the arguments to ACTIVATE-FUNC are INPUT-METHOD and the ARGS.
This function is mainly used in the file \"leim-list.el\" which is
-created at building time of emacs, registering all quail input methods
-contained in the emacs distribution.
+created at Emacs build time, registering all Quail input methods
+contained in the Emacs distribution.
-In case you want to register a new quail input method by yourself, be
+In case you want to register a new Quail input method by yourself, be
careful to use the same input method title as given in the third
-parameter of `quail-define-package' (if the values are different, the
-string specified in this function takes precedence).
+parameter of `quail-define-package'. (If the values are different, the
+string specified in this function takes precedence.)
The commands `describe-input-method' and `list-input-methods' need
-this duplicated values to show some information about input methods
-without loading the affected quail packages."
+these duplicated values to show some information about input methods
+without loading the relevant Quail packages."
(if (symbolp lang-env)
(setq lang-env (symbol-name lang-env)))
(if (symbolp input-method)
(defun read-input-method-name (prompt &optional default inhibit-null)
"Read a name of input method from a minibuffer prompting with PROMPT.
If DEFAULT is non-nil, use that as the default,
- and substitute it into PROMPT at the first `%s'.
+and substitute it into PROMPT at the first `%s'.
If INHIBIT-NULL is non-nil, null input signals an error.
The return value is a string."
(if default
(setq prompt (format prompt default)))
(let* ((completion-ignore-case t)
+ ;; As it is quite normal to change input method in the
+ ;; minibuffer, we must enable it even if
+ ;; enable-recursive-minibuffers is currently nil.
+ (enable-recursive-minibuffers t)
;; This binding is necessary because input-method-history is
;; buffer local.
(input-method (completing-read prompt input-method-alist
(let ((slot (assoc input-method input-method-alist)))
(if (null slot)
(error "Can't activate input method `%s'" input-method))
+ (setq current-input-method-title nil)
(let ((func (nth 2 slot)))
(if (functionp func)
(apply (nth 2 slot) input-method (nthcdr 5 slot))
(apply (car func) input-method (nthcdr 5 slot)))
(error "Can't activate input method `%s'" input-method))))
(setq current-input-method input-method)
- (setq current-input-method-title (nth 3 slot))
+ (or (stringp current-input-method-title)
+ (setq current-input-method-title (nth 3 slot)))
(unwind-protect
(run-hooks 'input-method-activate-hook)
(force-mode-line-update)))))
(unwind-protect
(run-hooks 'input-method-inactivate-hook)
(setq current-input-method nil
+ input-method-function nil
current-input-method-title nil)
(force-mode-line-update)))))
(defun set-input-method (input-method)
"Select and activate input method INPUT-METHOD for the current buffer.
-This also sets the default input method to the one you specify."
+This also sets the default input method to the one you specify.
+If INPUT-METHOD is nil, this function turns off the input method, and
+also causes you to be prompted for a name of an input method the next
+time you invoke \\[toggle-input-method].
+
+To deactivate the input method interactively, use \\[toggle-input-method].
+To deactivate it programmatically, use \\[inactivate-input-method]."
(interactive
(let* ((default (or (car input-method-history) default-input-method)))
(list (read-input-method-name
(if default "Select input method (default %s): " "Select input method: ")
default t))))
(activate-input-method input-method)
- (setq default-input-method input-method))
+ (setq default-input-method input-method)
+ (when (interactive-p)
+ (customize-mark-as-set 'default-input-method))
+ default-input-method)
(defun toggle-input-method (&optional arg)
- "Turn on or off a multilingual text input method for the current buffer.
-
-With no prefix argument, if an input method is currently activated,
-turn it off. Otherwise, activate an input method -- the one most
-recently used, or the one specified in `default-input-method', or
-the one read from the minibuffer.
-
-With a prefix argument, read an input method from the minibuffer and
-turn it on.
-
-The default is to use the most recent input method specified
+ "Enable or disable multilingual text input method for the current buffer.
+Only one input method can be enabled at any time in a given buffer.
+
+The normal action is to enable an input method if none was
+enabled, and disable the current one otherwise. Which input method
+to enable can be determined in various ways--either the one most
+recently used, or the one specified by `default-input-method', or
+as a last resort by reading the name of an input method in the
+minibuffer.
+
+With a prefix argument, read an input method name with the minibuffer
+and enable that one. The default is the most recent input method specified
\(not including the currently active input method, if any)."
+
(interactive "P")
(if (and current-input-method (not arg))
(inactivate-input-method)
(if default "Input method (default %s): " "Input method: " )
default t))
default))
- (or default-input-method
- (setq default-input-method current-input-method)))))
+ (unless default-input-method
+ (prog1
+ (setq default-input-method current-input-method)
+ (when (interactive-p)
+ (customize-mark-as-set 'default-input-method)))))))
(defun describe-input-method (input-method)
"Describe input method INPUT-METHOD."
"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
+ (or input-method current-input-method))
+ (interactive-p))
+
(if (null input-method)
(describe-current-input-method)
- (with-output-to-temp-buffer "*Help*"
- (let ((elt (assoc input-method input-method-alist)))
- (princ (format "Input method: %s (`%s' in mode line) for %s\n %s\n"
- input-method (nth 3 elt) (nth 1 elt) (nth 4 elt)))))))
+ (let ((current current-input-method))
+ (condition-case nil
+ (progn
+ (save-excursion
+ (activate-input-method input-method)
+ (describe-current-input-method))
+ (activate-input-method current))
+ (error
+ (activate-input-method current)
+ (help-setup-xref (list #'describe-input-method input-method)
+ (interactive-p))
+ (with-output-to-temp-buffer (help-buffer)
+ (let ((elt (assoc input-method input-method-alist)))
+ (princ (format
+ "Input method: %s (`%s' in mode line) for %s\n %s\n"
+ input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
(defun describe-current-input-method ()
- "Describe the input method currently in use."
+ "Describe the input method currently in use.
+This is a subroutine for `describe-input-method'."
(if current-input-method
(if (and (symbolp describe-current-input-method-function)
(fboundp describe-current-input-method-function))
"Normal hook run just after an input method insert some chunk of text.")
(defvar input-method-exit-on-first-char nil
- "This flag controls a timing when an input method returns.
+ "This flag controls when an input method returns.
Usually, the input method does not return while there's a possibility
that it may find a different translation if a user types another key.
But, it this flag is non-nil, the input method returns as soon as
(or (not (eq last-command-event 'Default))
(setq last-command-event 'English))
(setq language-name (symbol-name last-command-event)))
- (set-language-environment language-name)
+ (prog1
+ (set-language-environment language-name)
+ (customize-mark-as-set 'current-language-environment))
(error "Bogus calling sequence"))))
(defcustom current-language-environment "English"
coding-category-big5 chinese-big5
coding-category-ccl nil
coding-category-binary no-conversion
-"
+ coding-category-utf-16-be nil
+ coding-category-utf-16-le nil
+ coding-category-utf-8 mule-utf-8"
(interactive)
;; This function formerly set default-enable-multibyte-characters to t,
;; but that is incorrect. It should not alter the unibyte/multibyte choice.
coding-category-raw-text 'raw-text
coding-category-sjis 'japanese-shift-jis
coding-category-big5 'chinese-big5
- coding-category-utf-8 nil
coding-category-utf-16-be nil
coding-category-utf-16-le nil
+ coding-category-utf-8 'mule-utf-8
coding-category-ccl nil
coding-category-binary 'no-conversion)
(set-default-coding-systems nil)
(setq default-sendmail-coding-system 'iso-latin-1)
- (setq default-process-coding-system '(undecided . 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)
(setq nonascii-translation-table nil
nonascii-insert-offset 0))
(let ((func (get-language-info current-language-environment
'exit-function)))
(run-hooks 'exit-language-environment-hook)
- (if (fboundp func) (funcall func))))
+ (if (functionp func) (funcall func))))
(let ((default-eol-type (coding-system-eol-type
default-buffer-file-coding-system)))
(reset-language-environment)
+ ;; The fetaures 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)))
(require (car required-features))
(setq required-features (cdr required-features))))
(let ((func (get-language-info language-name 'setup-function)))
- (if (fboundp func)
+ (if (functionp func)
(funcall func)))
(run-hooks 'set-language-environment-hook)
(force-mode-line-update t))
;; Make non-line-break space display as a plain space.
;; Most X fonts do the wrong thing for code 160.
(aset standard-display-table 160 [32])
- ;; Most Windows programs send out apostrophe's as \222. Most X fonts
+ ;; 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
+ ;; 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.
+ ;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
+ ;; U+2019, normally from the windows-1252 character set. XFree 4
+ ;; 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]))))
(defun set-language-environment-coding-systems (language-name
(error "No documentation for the specified language"))
(if (symbolp language-name)
(setq language-name (symbol-name language-name)))
- (let ((doc (get-language-info language-name 'documentation)))
- (with-output-to-temp-buffer "*Help*"
- (princ-list language-name " language environment" "\n")
- (if (stringp doc)
- (progn
- (princ-list doc)
- (terpri)))
- (let ((str (get-language-info language-name 'sample-text)))
- (if (stringp str)
- (progn
- (princ "Sample text:\n")
- (princ-list " " str)
- (terpri))))
- (let ((input-method (get-language-info language-name 'input-method))
- (l (copy-sequence input-method-alist)))
- (princ "Input methods")
- (when input-method
- (princ (format " (default, %s)" input-method))
- (setq input-method (assoc input-method input-method-alist))
- (setq l (cons input-method (delete input-method l))))
- (princ ":\n")
- (while l
- (if (string= language-name (nth 1 (car l)))
- (princ-list " " (car (car l))
- (format " (`%s' in mode line)" (nth 3 (car l)))))
- (setq l (cdr l))))
- (terpri)
- (princ "Character sets:\n")
- (let ((l (get-language-info language-name 'charset)))
- (if (null l)
- (princ-list " nothing specific to " language-name)
- (while l
- (princ-list " " (car l) ": "
- (charset-description (car l)))
- (setq l (cdr l)))))
- (terpri)
- (princ "Coding systems:\n")
- (let ((l (get-language-info language-name 'coding-system)))
- (if (null l)
- (princ-list " nothing specific to " language-name)
+ (let ((doc (get-language-info language-name 'documentation))
+ pos)
+ (help-setup-xref (list #'describe-language-environment language-name)
+ (interactive-p))
+ (with-output-to-temp-buffer (help-buffer)
+ (save-excursion
+ (set-buffer standard-output)
+ (insert language-name " language environment\n\n")
+ (if (stringp doc)
+ (insert doc "\n\n"))
+ (condition-case nil
+ (let ((str (eval (get-language-info language-name 'sample-text))))
+ (if (stringp str)
+ (insert "Sample text:\n " str "\n\n")))
+ (error nil))
+ (let ((input-method (get-language-info language-name 'input-method))
+ (l (copy-sequence input-method-alist)))
+ (insert "Input methods")
+ (when 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")
(while l
- (princ (format " %s (`%c' in mode line):\n\t%s\n"
- (car l)
- (coding-system-mnemonic (car l))
- (coding-system-doc-string (car l))))
- (let ((aliases (coding-system-get (car l) 'alias-coding-systems)))
- (when aliases
- (princ "\t")
- (princ (cons 'alias: (cdr aliases)))
- (terpri)))
- (setq l (cdr l))))))))
+ (when (string= language-name (nth 1 (car l)))
+ (insert " " (car (car l)))
+ (search-backward (car (car l)))
+ (help-xref-button 0 'help-input-method (car (car l)))
+ (goto-char (point-max))
+ (insert " (\""
+ (if (stringp (nth 3 (car l)))
+ (nth 3 (car l))
+ (car (nth 3 (car l))))
+ "\" in mode line)\n"))
+ (setq l (cdr l)))
+ (insert "\n"))
+ (insert "Character sets:\n")
+ (let ((l (get-language-info language-name 'charset)))
+ (if (null l)
+ (insert " nothing specific to " language-name "\n")
+ (while l
+ (insert " " (symbol-name (car l)))
+ (search-backward (symbol-name (car l)))
+ (help-xref-button 0 'help-character-set (car l))
+ (goto-char (point-max))
+ (insert ": " (charset-description (car l)) "\n")
+ (setq l (cdr l)))))
+ (insert "\n")
+ (insert "Coding systems:\n")
+ (let ((l (get-language-info language-name 'coding-system)))
+ (if (null l)
+ (insert " nothing specific to " language-name "\n")
+ (while l
+ (insert " " (symbol-name (car l)))
+ (search-backward (symbol-name (car l)))
+ (help-xref-button 0 'help-coding-system (car l))
+ (goto-char (point-max))
+ (insert " (`"
+ (coding-system-mnemonic (car l))
+ "' in mode line):\n\t"
+ (coding-system-doc-string (car l))
+ "\n")
+ (let ((aliases (coding-system-get (car l)
+ 'alias-coding-systems)))
+ (when aliases
+ (insert "\t(alias:")
+ (while aliases
+ (insert " " (symbol-name (car aliases)))
+ (setq aliases (cdr aliases)))
+ (insert ")\n")))
+ (setq l (cdr l)))))))))
\f
;;; Locales.
(defvar locale-translation-file-name nil
"File name for the system's file of locale-name aliases, or nil if none.")
-(defvar locale-language-names
- '(
- ;; UTF-8 is not yet implemented.
- ;; Put this first, so that e.g. "ko.UTF-8" does not match "ko" below.
- (".*[._]utf" . nil)
-
+;; The following definitions might as well be marked as constants and
+;; purecopied, since they're normally used on startup, and probably
+;; should reflect the facilities of the base Emacs.
+(defconst locale-language-names
+ (purecopy
+ '(
;; Locale names of the form LANGUAGE[_TERRITORY][.CODESET][@MODIFIER]
;; as specified in the Single Unix Spec, Version 2.
;; LANGUAGE is a language code taken from ISO 639:1988 (E/F)
;; with additions from ISO 639/RA Newsletter No.1/1989;
- ;; see Internet RFC 2165 (1997-06).
- ;; TERRITORY is a country code taken from ISO 3166.
+ ;; see Internet RFC 2165 (1997-06) and
+ ;; http://www.evertype.com/standards/iso639/iso639-en.html
+ ;; TERRITORY is a country code taken from ISO 3166
+ ;; http://www.din.de/gremien/nas/nabd/iso3166ma/codlstp1/en_listp1.html.
;; CODESET and MODIFIER are implementation-dependent.
- ;;
+
; aa Afar
; ab Abkhazian
("af" . "Latin-1") ; Afrikaans
("am" . "Ethiopic") ; Amharic
- ; ar Arabic
+ ; ar Arabic glibc uses 8859-6
; as Assamese
; ay Aymara
; az Azerbaijani
; ba Bashkir
- ("be" . "Latin-5") ; Byelorussian
- ("bg" . "Latin-5") ; Bulgarian
+ ("be" . "Belarussian") ; Belarussian [Byelorussian]
+ ("bg" . "Bulgarian") ; Bulgarian
; bh Bihari
; bi Bislama
; bn Bengali, Bangla
;; Users who specify "en" explicitly typically want Latin-1, not ASCII.
("en" . "Latin-1") ; English
("eo" . "Latin-3") ; Esperanto
- ("es" . "Latin-1") ; Spanish
+ ("es" . "Spanish")
("et" . "Latin-4") ; Estonian
("eu" . "Latin-1") ; Basque
; fa Persian
("fi" . "Latin-1") ; Finnish
; fj Fiji
("fo" . "Latin-1") ; Faroese
- ("fr" . "Latin-1") ; French
+ ("fr" . "French") ; French
("fy" . "Latin-1") ; Frisian
("ga" . "Latin-1") ; Irish Gaelic (new orthography)
("gd" . "Latin-1") ; Scots Gaelic
("gl" . "Latin-1") ; Galician
; gn Guarani
; gu Gujarati
+ ("gv" . "Latin-8") ; Manx Gaelic
; ha Hausa
("he" . "Hebrew")
- ("hi" . "Devanagari") ; Hindi
+ ("hi" . "Devanagari") ; Hindi glibc uses utf-8
("hr" . "Latin-2") ; Croatian
("hu" . "Latin-2") ; Hungarian
; hy Armenian
; iu Inuktitut
("ja" . "Japanese")
; jw Javanese
- ; ka Georgian
+ ("ka" . "Georgian") ; Georgian
; kk Kazakh
("kl" . "Latin-1") ; Greenlandic
; km Cambodian
("ko" . "Korean")
; ks Kashmiri
; ku Kurdish
+ ("kw" . "Latin-1") ; Cornish
; ky Kirghiz
("la" . "Latin-1") ; Latin
+ ("lb" . "Latin-1") ; Luxemburgish
; ln Lingala
("lo" . "Lao") ; Laothian
- ("lt" . "Latin-4") ; Lithuanian
- ("lv" . "Latin-4") ; Latvian, Lettish
+ ("lt" . "Lithuanian")
+ ("lv" . "Latvian") ; Latvian, Lettish
; mg Malagasy
- ; mi Maori
- ("mk" . "Latin-5") ; Macedonian
+ ("mi" . "Latin-7") ; Maori
+ ("mk" . "Cyrillic-ISO") ; Macedonian
; ml Malayalam
; mn Mongolian
; mo Moldavian
- ("mr" . "Devanagari") ; Marathi
- ; ms Malay
+ ("mr" . "Devanagari") ; Marathi glibc uses utf-8
+ ("ms" . "Latin-1") ; Malay
("mt" . "Latin-3") ; Maltese
; my Burmese
; na Nauru
("ne" . "Devanagari") ; Nepali
- ("nl" . "Latin-1") ; Dutch
+ ("nl" . "Dutch")
("no" . "Latin-1") ; Norwegian
- ; oc Occitan
+ ("oc" . "Latin-1") ; Occitan
; om (Afan) Oromo
; or Oriya
; pa Punjabi
; rn Kirundi
("ro" . "Romanian")
("ru.*[_.]koi8" . "Cyrillic-KOI8") ; Russian
- ("ru" . "Latin-5") ; Russian
+ ("ru" . "Cyrillic-ISO") ; Russian
; rw Kinyarwanda
("sa" . "Devanagari") ; Sanskrit
; sd Sindhi
+ ; se Northern Sami
; sg Sangho
("sh" . "Latin-2") ; Serbo-Croatian
; si Sinhalese
; su Sundanese
("sv" . "Latin-1") ; Swedish
("sw" . "Latin-1") ; Swahili
- ; ta Tamil
- ; te Telugu
- ; tg Tajik
+ ; ta Tamil glibc uses utf-8
+ ; te Telugu glibc uses utf-8
+ ("tg" . "Cyrillic-KOI8-T") ; Tajik
("th" . "Thai")
; ti Tigrinya
; tk Turkmen
; tt Tatar
; tw Twi
; ug Uighur
- ("uk" . "Latin-5") ; Ukrainian
- ; ur Urdu
- ; uz Uzbek
- ("vi" . "Vietnamese")
+ ("uk" . "Ukrainian") ; Ukrainian
+ ; ur Urdu glibc uses utf-8
+ ("uz" . "Latin-1") ; Uzbek
+ ("vi" . "Vietnamese") ; glibc uses utf-8
; vo Volapuk
; wo Wolof
; xh Xhosa
- ; yi Yiddish
+ ("yi" . "Windows-1255") ; Yiddish
; yo Yoruba
; za Zhuang
+
+ ; glibc:
+ ; zh_CN.GB18030/GB18030 \
+ ; zh_CN.GBK/GBK \
+ ; zh_HK/BIG5-HKSCS \
+ ; zh_TW/BIG5 \
+ ; zh_TW.EUC-TW/EUC-TW \
+
("zh.*[._]big5" . "Chinese-BIG5")
("zh.*[._]gbk" . nil) ; Solaris 2.7; has gbk-0 as well as GB 2312.1980-0
("zh_tw" . "Chinese-CNS")
("cz" . "Czech") ; e.g. Solaris 2.6
("ee" . "Latin-4") ; Estonian, e.g. X11R6.4
("iw" . "Hebrew") ; e.g. X11R6.4
- ("sp" . "Latin-5") ; Serbian (Cyrillic alphabet), e.g. X11R6.4
+ ("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4
("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6
- )
+ ("jp" . "Japanese") ; e.g. MS Windows
+ ("chs" . "Chinese-GB") ; MS Windows Chinese Simplified
+ ("cht" . "Chinese-BIG5") ; MS Windows Chinese Traditional
+ ))
"List of pairs of locale regexps and language names.
The first element whose locale regexp matches the start of a downcased locale
specifies the language name corresponding to that locale.
If the language name is nil, there is no corresponding language environment.")
-(defvar locale-charset-language-names
- '((".*8859[-_]?1\\>" . "Latin-1")
- (".*8859[-_]?2\\>" . "Latin-2")
- (".*8859[-_]?3\\>" . "Latin-3")
- (".*8859[-_]?4\\>" . "Latin-4")
- (".*8859[-_]?9\\>" . "Latin-5")
- (".*8859[-_]?14\\>" . "Latin-8")
- (".*8859[-_]?15\\>" . "Latin-9")
- )
+(defconst locale-charset-language-names
+ (purecopy
+ '((".*8859[-_]?1\\>" . "Latin-1")
+ (".*8859[-_]?2\\>" . "Latin-2")
+ (".*8859[-_]?3\\>" . "Latin-3")
+ (".*8859[-_]?4\\>" . "Latin-4")
+ (".*8859[-_]?9\\>" . "Latin-5")
+ (".*8859[-_]?14\\>" . "Latin-8")
+ (".*8859[-_]?15\\>" . "Latin-9")
+ (".*@euro\\>" . "Latin-9")
+ (".*utf\\(-?8\\)\\>" . "UTF-8")))
"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.
This language name is used if its charsets disagree with the charsets of
the language name that would otherwise be used for this locale.")
-(defvar locale-preferred-coding-systems
- '(("ja.*[._]euc" . japanese-iso-8bit)
- ("ja.*[._]jis7" . iso-2022-jp)
- ("ja.*[._]pck" . japanese-shift-jis)
- ("ja.*[._]sjis" . japanese-shift-jis)
- )
+(defconst locale-preferred-coding-systems
+ (purecopy
+ '(("ja.*[._]euc" . japanese-iso-8bit)
+ ("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 koi8-u koi8-r))
+ "Coding systems that are commonly used for keyboards.
+`set-locale-environment' will set the `keyboard-coding-system' if the
+coding-system specified by the locale setting is a member of this list.")
+
(defun locale-name-match (key alist)
"Search for KEY in ALIST, which should be a list of regexp-value pairs.
Return the value corresponding to the first regexp that matches the
start of KEY, or nil if there is no match."
(let (element)
(while (and alist (not element))
- (if (string-match (concat "^\\(" (car (car alist)) "\\)") key)
+ (if (string-match (concat "\\`\\(?:" (car (car alist)) "\\)") key)
(setq element (car alist)))
(setq alist (cdr alist)))
(cdr element)))
-(defun set-locale-environment (locale-name)
+(defun set-locale-environment (&optional locale-name)
"Set up multi-lingual environment for using LOCALE-NAME.
-This sets the coding system priority and the default input method
-and sometimes other things. LOCALE-NAME should be a string
+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.
-If LOCALE-NAME is nil, its value is taken from the environment.
+If LOCALE-NAME is nil, its value is taken from the environment
+variables LC_ALL, LC_CTYLE and LANG (the first one that is set).
The locale names supported by your system can typically be found in a
-directory named `/usr/share/locale' or `/usr/lib/locale'."
-
+directory named `/usr/share/locale' or `/usr/lib/locale'. LOCALE-NAME
+will be translated according to the table specified by
+`locale-translation-file-name'.
+
+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
(setq files (cdr files)))
(car files)))
- (unless locale-name
- ;; 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-name (getenv (car vars)))))
- (setq vars (cdr vars)))))
-
- (when locale-name
-
- ;; Translate "swedish" into "sv_SE.ISO8859-1", and so on,
- ;; using the translation file that many systems have.
- (when locale-translation-file-name
- (with-temp-buffer
- (insert-file-contents locale-translation-file-name)
- (when (re-search-forward
- (concat "^" (regexp-quote locale-name) ":?[ \t]+") nil t)
- (setq locale-name (buffer-substring (point) (line-end-position))))))
-
- (setq locale-name (downcase locale-name))
-
- (let ((language-name
- (locale-name-match locale-name locale-language-names))
- (charset-language-name
- (locale-name-match locale-name locale-charset-language-names))
- (coding-system
- (locale-name-match locale-name locale-preferred-coding-systems)))
-
- (if (and charset-language-name
- (not
- (equal (get-language-info language-name 'charset)
- (get-language-info charset-language-name 'charset))))
- (setq language-name charset-language-name))
-
- (when language-name
-
- ;; Set up for this character set. This is now the right way
- ;; to do it for both unibyte and multibyte modes.
- (set-language-environment language-name)
-
- ;; If default-enable-multibyte-characters is nil,
- ;; we are using single-byte characters,
- ;; so the display table and terminal coding system are irrelevant.
- (when default-enable-multibyte-characters
- (set-display-table-and-terminal-coding-system language-name))
-
- (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)))))
+ (let ((locale locale-name))
+
+ (unless locale
+ ;; 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)))))
+
+ (when locale
+
+ ;; Translate "swedish" into "sv_SE.ISO8859-1", and so on,
+ ;; using the translation file that many systems have.
+ (when locale-translation-file-name
+ (with-temp-buffer
+ (insert-file-contents locale-translation-file-name)
+ (when (re-search-forward
+ (concat "^" (regexp-quote locale) ":?[ \t]+") nil t)
+ (setq locale (buffer-substring (point) (line-end-position))))))
+
+ ;; Leave the system locales alone if the caller did not specify
+ ;; an explicit locale name, as their defaults are set from
+ ;; LC_MESSAGES and LC_TIME, not LC_CTYPE, and the user might not
+ ;; want to set them to the same value as LC_CTYPE.
+ (when locale-name
+ (setq system-messages-locale locale)
+ (setq system-time-locale locale))
+
+ (setq locale (downcase locale))
+
+ (let ((language-name
+ (locale-name-match locale locale-language-names))
+ (charset-language-name
+ (locale-name-match locale locale-charset-language-names))
+ (coding-system
+ (locale-name-match locale locale-preferred-coding-systems)))
+
+ ;; Give preference to charset-language-name over language-name.
+ (if (and charset-language-name
+ (not
+ (equal (get-language-info language-name 'charset)
+ (get-language-info charset-language-name 'charset))))
+ (setq language-name charset-language-name))
+
+ (when language-name
+
+ ;; Set up for this character set. This is now the right way
+ ;; to do it for both unibyte and multibyte modes.
+ (set-language-environment language-name)
+
+ ;; If default-enable-multibyte-characters is nil,
+ ;; we are using single-byte characters,
+ ;; so the display table and terminal coding system are irrelevant.
+ (when default-enable-multibyte-characters
+ (set-display-table-and-terminal-coding-system language-name))
+
+ ;; Set the `keyboard-coding-system' if appropriate.
+ (let ((kcs (or coding-system
+ (car (get-language-info language-name
+ 'coding-system)))))
+ (if (memq kcs standard-keyboard-coding-systems)
+ (set-keyboard-coding-system kcs)))
+
+ (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))))))
\f
;;; Charset property
If CODING-SYSTEM can't safely encode CHAR, return nil."
(let ((str1 (string-as-multibyte (char-to-string char)))
(str2 (string-as-multibyte (make-string 2 char)))
- (safe-charsets (and coding-system
- (coding-system-get coding-system 'safe-charsets)))
+ (safe-chars (and coding-system
+ (coding-system-get coding-system 'safe-chars)))
(charset (char-charset char))
enc1 enc2 i1 i2)
- (when (or (eq safe-charsets t)
+ (when (or (eq safe-chars t)
(eq charset 'ascii)
- (memq charset safe-charsets))
+ (and safe-chars (aref safe-chars char)))
;; We must find the encoded string of CHAR. But, just encoding
;; CHAR will put extra control sequences (usually to designate
;; ASCII charaset) at the tail if type of CODING is ISO 2022.
HCoop / bpt / emacs.git / blobdiff