]> code.delx.au - gnu-emacs/blobdiff - lisp/international/mule-cmds.el
Merged from miles@gnu.org--gnu-2005 (patch 269)
[gnu-emacs] / lisp / international / mule-cmds.el
index 95177fdb9549689a16e59bb7b0c072a60547354e..cc39f39638d130ceff05dcd39b743a7de5676c19 100644 (file)
@@ -1,7 +1,8 @@
 ;;; 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) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
 
 ;; Keywords: mule, multilingual
 
   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)))
+             :enable (null (memq initial-window-system '(x w32 mac)))
              :help "How to encode terminal output")
   t)
 (define-key-after set-coding-system-map [separator-3]
@@ -326,7 +327,8 @@ This also sets the following values:
        (or (local-variable-p 'buffer-file-coding-system buffer)
            (ucs-set-table-for-input buffer))))
 
-  (if default-enable-multibyte-characters
+  (if (and default-enable-multibyte-characters (not (eq system-type 'darwin)))
+      ;; The file-name coding system on Darwin systems is always utf-8.
       (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.
@@ -382,6 +384,7 @@ See also `coding-category-list' and `coding-system-category'."
        ;; CODING-SYSTEM is no-conversion or undecided.
        (error "Can't prefer the coding system `%s'" coding-system))
     (set coding-category (or base coding-system))
+    ;; Changing the binding of a coding category requires this call.
     (update-coding-systems-internal)
     (or (eq coding-category (car coding-category-list))
        ;; We must change the order.
@@ -625,6 +628,175 @@ 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.")
 
+(defun select-safe-coding-system-interactively (from to codings unsafe
+                                               &optional rejected default)
+  "Select interactively a coding system for the region FROM ... TO.
+FROM can be a string, as in `write-region'.
+CODINGS is the list of base coding systems known to be safe for this region,
+  typically obtained with `find-coding-systems-region'.
+UNSAFE is a list of coding systems known to be unsafe for this region.
+REJECTED is a list of coding systems which were safe but for some reason
+  were not recommended in the particular context.
+DEFAULT is the coding system to use by default in the query."
+  ;; 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
+      (setq unsafe
+           (mapcar #'(lambda (coding)
+                       (cons coding
+                             (if (stringp from)
+                                 (mapcar #'(lambda (pos)
+                                             (cons pos (aref from pos)))
+                                         (unencodable-char-position
+                                          0 (length from) coding
+                                          11 from))
+                               (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))
+         (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))))
+
+  ;; 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))
+       (bufname (buffer-name))
+       coding-system)
+    (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*"
+       (with-current-buffer standard-output
+         (if (and (null rejected) (null unsafe))
+             (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 "  "))
+             (dolist (x (append rejected unsafe))
+               (princ "  ") (princ (car x)))
+             (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,
+e.g., for sending an email message.\n ")
+             (dolist (x rejected)
+               (princ " ") (princ x))
+             (insert "\n"))
+           (when unsafe
+             (insert (if rejected "And the others"
+                       "However, each of them")
+                     " encountered these problematic characters:\n")
+             (dolist (coding unsafe)
+               (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"))
+             (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")
+         (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")))
+
+      ;; Read a coding system.
+      (setq coding-system
+           (read-coding-system
+            (format "Select coding system (default %s): " default)
+            default))
+      (setq last-coding-system-specified coding-system))
+
+    (kill-buffer "*Warning*")
+    (set-window-configuration window-configuration)
+    coding-system))
+
 (defun select-safe-coding-system (from to &optional default-coding-system
                                       accept-default-p file)
   "Ask a user to select a safe coding system from candidates.
@@ -721,7 +893,6 @@ and TO is ignored."
 
   (let ((codings (find-coding-systems-region from to))
        (coding-system nil)
-       (bufname (buffer-name))
        safe rejected unsafe)
     (if (eq (car codings) 'undecided)
        ;; Any coding system is ok.
@@ -739,172 +910,8 @@ and TO is ignored."
 
     ;; If all the defaults failed, ask a user.
     (when (not 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))
-             (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))))
-
-      ;; 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 "  "))
-                 (mapc #'(lambda (x) (princ "  ") (princ (car x)))
-                       default-coding-system)
-                 (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,
-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 safe
-                         "\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)))
+      (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)))
@@ -1368,12 +1375,14 @@ If INPUT-METHOD is nil, deactivate any current input method."
              current-input-method-title nil)
        (force-mode-line-update)))))
 
-(defun set-input-method (input-method)
+(defun set-input-method (input-method &optional interactive)
   "Select and activate input method INPUT-METHOD for the current buffer.
 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].
+When called interactively, the optional arg INTERACTIVE is non-nil,
+which marks the variable `default-input-method' as set for Custom buffers.
 
 To deactivate the input method interactively, use \\[toggle-input-method].
 To deactivate it programmatically, use \\[inactivate-input-method]."
@@ -1381,14 +1390,15 @@ To deactivate it programmatically, use \\[inactivate-input-method]."
    (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))))
+           default t)
+          t)))
   (activate-input-method input-method)
   (setq default-input-method input-method)
-  (when (interactive-p)
+  (when interactive
     (customize-mark-as-set 'default-input-method))
   default-input-method)
 
-(defun toggle-input-method (&optional arg)
+(defun toggle-input-method (&optional arg interactive)
   "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.
 
@@ -1401,9 +1411,12 @@ 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)."
+\(not including the currently active input method, if any).
 
-  (interactive "P")
+When called interactively, the optional arg INTERACTIVE is non-nil,
+which marks the variable `default-input-method' as set for Custom buffers."
+
+  (interactive "P\np")
   (if (and current-input-method (not arg))
       (inactivate-input-method)
     (let ((default (or (car input-method-history) default-input-method)))
@@ -1420,7 +1433,7 @@ and enable that one.  The default is the most recent input method specified
       (unless default-input-method
        (prog1
            (setq default-input-method current-input-method)
-         (when (interactive-p)
+         (when interactive
            (customize-mark-as-set 'default-input-method)))))))
 
 (defun describe-input-method (input-method)
@@ -1679,10 +1692,13 @@ The default status is as follows:
      coding-category-ccl
      coding-category-binary))
 
+  ;; Changing the binding of a coding category requires this call.
   (update-coding-systems-internal)
 
   (set-default-coding-systems nil)
   (setq default-sendmail-coding-system 'iso-latin-1)
+  ;; On Darwin systems, this should be utf-8, but when this file is loaded
+  ;; utf-8 is not yet defined, so we set it in set-locale-environment instead.
   (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
@@ -1720,7 +1736,7 @@ The default status is as follows:
 
 (reset-language-environment)
 
-(defun set-display-table-and-terminal-coding-system (language-name)
+(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
@@ -1734,7 +1750,7 @@ The default status is as follows:
        (dotimes (i 128)
          (aset standard-display-table (+ i 128) nil))))
     (or (eq window-system 'pc)
-       (set-terminal-coding-system coding))))
+       (set-terminal-coding-system (or coding-system coding)))))
 
 (defun set-language-environment (language-name)
   "Set up multi-lingual environment for using LANGUAGE-NAME.
@@ -1854,12 +1870,14 @@ specifies the character set for the major languages of Western Europe."
   ;; different there.
   (or (and (eq window-system 'pc) (not default-enable-multibyte-characters))
       (progn
-       ;; 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])
-       ;; With luck, non-Latin-1 fonts are more recent and so don't
-       ;; have this bug.
-       (aset standard-display-table (make-char 'latin-iso8859-1 160) [32])
+       ;; Most X fonts used to do the wrong thing for latin-1 code 160.
+       (unless (and (eq window-system 'x)
+                    ;; XFree86 4 has fixed the fonts.
+                    (string= "The XFree86 Project, Inc" (x-server-vendor))
+                    (> (aref (number-to-string (nth 2 (x-server-version))) 0)
+                       ?3))
+         ;; Make non-line-break space display as a plain space.
+         (aset standard-display-table 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,
@@ -1867,23 +1885,7 @@ specifies the character set for the major languages of Western Europe."
        ;; 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])
-       ;; 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$,1ry\e(B])
-         ;; (aset standard-display-table ?` [?\e$,1rx\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)))))
+       (aset standard-display-table 146 [39]))))
 
 (defun set-language-environment-coding-systems (language-name
                                                &optional eol-type)
@@ -1904,6 +1906,7 @@ of `buffer-file-coding-system' set by this function."
          (while priority
            (set (car categories) (car priority))
            (setq priority (cdr priority) categories (cdr categories)))
+         ;; Changing the binding of a coding category requires this call.
          (update-coding-systems-internal)))))
 
 (defsubst princ-list (&rest args)
@@ -1944,8 +1947,7 @@ of `buffer-file-coding-system' set by this function."
       (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)
+  (let ((doc (get-language-info language-name 'documentation)))
     (help-setup-xref (list #'describe-language-environment language-name)
                     (interactive-p))
     (with-output-to-temp-buffer (help-buffer)
@@ -2044,55 +2046,60 @@ of `buffer-file-coding-system' set by this function."
      ;; and Chinese are exceptions, which are listed in the
      ;; non-standard section at the bottom of locale-language-names.
 
-    ; aa Afar
-    ; ab Abkhazian
+    ("aa_DJ" . "Latin-1") ; Afar
+    ("aa" . "UTF-8")
+    ;; ab Abkhazian
     ("af" . "Latin-1") ; Afrikaans
-    ("am" . "Ethiopic") ; Amharic
+    ("am" "Ethiopic" utf-8) ; Amharic
+    ("an" . "Latin-9") ; Aragonese
     ; ar Arabic glibc uses 8859-6
     ; as Assamese
     ; ay Aymara
-    ; az Azerbaijani
+    ("az" . "UTF-8") ; Azerbaijani
     ; ba Bashkir
-    ("be" . "Belarusian") ; Belarusian [Byelorussian until early 1990s]
-    ("bg" . "Bulgarian") ; Bulgarian
+    ("be" "Belarusian" cp1251) ; Belarusian [Byelorussian until early 1990s]
+    ("bg" "Bulgarian" cp1251) ; Bulgarian
     ; bh Bihari
     ; bi Bislama
-    ; bn Bengali, Bangla
+    ("bn" . "UTF-8") ; Bengali, Bangla
     ("bo" . "Tibetan")
     ("br" . "Latin-1") ; Breton
     ("bs" . "Latin-2") ; Bosnian
+    ("byn" . "UTF-8")  ; Bilin; Blin
     ("ca" . "Latin-1") ; Catalan
     ; co Corsican
-    ("cs" . "Czech")
-    ("cy" . "Welsh") ; Welsh [glibc uses Latin-8.  Did this change?]
+    ("cs" "Czech" iso-8859-2)
+    ("cy" "Welsh" iso-8859-14)
     ("da" . "Latin-1") ; Danish
-    ("de" . "German")
+    ("de" "German" iso-8859-1)
     ; dz Bhutani
-    ("el" . "Greek")
+    ("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
-    ("es" . "Spanish")
-    ("et" . "Latin-4") ; Estonian
+    ("es" "Spanish" iso-8859-1)
+    ("et" . "Latin-1") ; Estonian
     ("eu" . "Latin-1") ; Basque
-    ; fa Persian glibc uses utf-8
+    ("fa" . "UTF-8") ; Persian
     ("fi" . "Latin-1") ; Finnish
-    ; fj Fiji
+    ("fj" . "Latin-1") ; Fiji
     ("fo" . "Latin-1") ; Faroese
-    ("fr" . "French") ; French
+    ("fr" "French" iso-8859-1) ; French
     ("fy" . "Latin-1") ; Frisian
     ("ga" . "Latin-1") ; Irish Gaelic (new orthography)
-    ("gd" . "Latin-1") ; Scots Gaelic
-    ("gl" . "Latin-1") ; Galician
+    ("gd" . "Latin-9") ; Scots Gaelic
+    ("gez" "Ethiopic" utf-8) ; Geez
+    ("gl" . "Latin-1") ; Gallegan; Galician
     ; gn Guarani
-    ; gu Gujarati
-    ("gv" . "Latin-8") ; Manx Gaelic  glibc uses 8859-1
+    ("gu" . "UTF-8") ; Gujarati
+    ("gv" . "Latin-1") ; Manx Gaelic
     ; ha Hausa
-    ("he" . "Hebrew")
-    ("hi" . "Devanagari") ; Hindi  glibc uses utf-8
-    ("hr" . "Croatian") ; Croatian
+    ("he" "Hebrew" iso-8859-8)
+    ("hi" "Devanagari" utf-8) ; Hindi
+    ("hr" "Croatian" iso-8859-2) ; Croatian
     ("hu" . "Latin-2") ; Hungarian
     ; hy Armenian
     ; ia Interlingua
@@ -2100,110 +2107,114 @@ of `buffer-file-coding-system' set by this function."
     ; ie Interlingue
     ; ik Inupiak
     ("is" . "Latin-1") ; Icelandic
-    ("it" . "Italian") ; Italian
+    ("it" "Italian" iso-8859-1) ; Italian
     ; iu Inuktitut
-    ("ja" . "Japanese")
+    ("iw" "Hebrew" iso-8859-8)
+    ("ja" "Japanese" euc-jp)
     ; jw Javanese
-    ("ka" . "Georgian") ; Georgian
+    ("ka" "Georgian" georgian-ps) ; Georgian
     ; kk Kazakh
     ("kl" . "Latin-1") ; Greenlandic
     ; km Cambodian
-    ; kn Kannada
-    ("ko" . "Korean")
+    ("kn" "Kannada" utf-8)
+    ("ko" "Korean" euc-kr)
     ; ks Kashmiri
     ; ku Kurdish
     ("kw" . "Latin-1") ; Cornish
     ; ky Kirghiz
     ("la" . "Latin-1") ; Latin
     ("lb" . "Latin-1") ; Luxemburgish
+    ("lg" . "Laint-6") ; Ganda
     ; ln Lingala
-    ("lo" . "Lao") ; Laothian
-    ("lt" . "Lithuanian")
+    ("lo" "Lao" utf-8) ; Laothian
+    ("lt" "Lithuanian" iso-8859-13)
     ("lv" . "Latvian") ; Latvian, Lettish
     ; mg Malagasy
     ("mi" . "Latin-7") ; Maori
-    ("mk" . "Cyrillic-ISO") ; Macedonian
-    ; ml Malayalam
-    ; mn Mongolian
+    ("mk" "Cyrillic-ISO" iso-8859-5) ; Macedonian
+    ("ml" "Malayalam" utf-8)
+    ("mn" . "UTF-8") ; Mongolian
     ; mo Moldavian
-    ("mr" . "Devanagari") ; Marathi  glibc uses utf-8
+    ("mr" "Devanagari" utf-8) ; Marathi
     ("ms" . "Latin-1") ; Malay
     ("mt" . "Latin-3") ; Maltese
     ; my Burmese
     ; na Nauru
-    ("ne" . "Devanagari") ; Nepali
-    ("nl" . "Dutch")
+    ("nb" . "Latin-1") ; Norwegian
+    ("ne" "Devanagari" utf-8) ; Nepali
+    ("nl" "Dutch" iso-8859-1)
     ("no" . "Latin-1") ; Norwegian
     ("oc" . "Latin-1") ; Occitan
-    ; om (Afan) Oromo
+    ("om_ET" . "UTF-8") ; (Afan) Oromo
+    ("om" . "Latin-1") ; (Afan) Oromo
     ; or Oriya
-    ; pa Punjabi
+    ("pa" . "UTF-8") ; Punjabi
     ("pl" . "Latin-2") ; Polish
     ; ps Pashto, Pushto
     ("pt" . "Latin-1") ; Portuguese
     ; qu Quechua
     ("rm" . "Latin-1") ; Rhaeto-Romanic
     ; rn Kirundi
-    ("ro" . "Romanian")
-    ("ru.*[_.]koi8" . "Russian")
-    ("ru" . "Cyrillic-ISO") ; Russian
+    ("ro" "Romanian" iso-8859-2)
+    ("ru_RU" "Russian" iso-8859-5)
+    ("ru_UA" "Russian" koi8-u)
     ; rw Kinyarwanda
     ("sa" . "Devanagari") ; Sanskrit
     ; sd Sindhi
-    ; se   Northern Sami
+    ("se" . "UTF-8") ; Northern Sami
     ; sg Sangho
     ("sh" . "Latin-2") ; Serbo-Croatian
     ; si Sinhalese
-    ("sk" . "Slovak")
-    ("sl" . "Slovenian")
+    ("sid" . "UTF-8") ; Sidamo
+    ("sk" "Slovak" iso-8859-2)
+    ("sl" "Slovenian" iso-8859-2)
     ; sm Samoan
     ; sn Shona
-    ; so Somali
+    ("so_ET" "UTF-8") ; Somali
+    ("so" "Latin-1") ; Somali
     ("sq" . "Latin-1") ; Albanian
+    ("sr_YU@cyrillic" . "Cyrillic-ISO")        ; Serbian (Cyrillic alphabet)
     ("sr" . "Latin-2") ; Serbian (Latin alphabet)
-    ("sr_YU@cyrillic" . "Cyrillic-ISO")        ; per glibc
     ; ss Siswati
-    ; st Sesotho
+    ("st" . "Latin-1") ;  Sesotho
     ; su Sundanese
-    ("sv" . "Swedish") ; Swedish
+    ("sv" "Swedish" iso-8859-1)                ; Swedish
     ("sw" . "Latin-1") ; Swahili
-    ; ta Tamil  glibc uses utf-8
-    ; te Telugu  glibc uses utf-8
-    ("tg" . "Tajik")
-    ("th" . "Thai")
-    ; ti Tigrinya
+    ("ta" "Tamil" utf-8)
+    ("te" . "UTF-8") ; Telugu
+    ("tg" "Tajik" koi8-t)
+    ("th" "Thai" tis-620)
+    ("ti" "Ethiopic" utf-8) ; Tigrinya
+    ("tig_ER" . "UTF-8") ; Tigre
     ; tk Turkmen
     ("tl" . "Latin-1") ; Tagalog
     ; tn Setswana
     ; to Tonga
-    ("tr" . "Turkish")
+    ("tr" "Turkish" iso-8859-9)
     ; ts Tsonga
-    ; tt Tatar
+    ("tt" . "UTF-8") ; Tatar
     ; tw Twi
     ; ug Uighur
-    ("uk" . "Ukrainian") ; Ukrainian
-    ; ur Urdu  glibc uses utf-8
+    ("uk" "Ukrainian" koi8-u)
+    ("ur" . "UTF-8") ; Urdu
+    ("uz_UZ@cyrillic" . "UTF-8"); Uzbek
     ("uz" . "Latin-1") ; Uzbek
-    ("vi" . "Vietnamese") ;  glibc uses utf-8
+    ("vi" "Vietnamese" utf-8)
     ; vo Volapuk
     ("wa" . "Latin-1") ; Walloon
     ; wo Wolof
-    ; xh Xhosa
+    ("xh" . "Latin-1") ; Xhosa
     ("yi" . "Windows-1255") ; Yiddish
     ; yo Yoruba
     ; za Zhuang
-
-    ; glibc:
+    ("zh_HK" . "Chinese-Big5")
+    ("zh_TW" . "Chinese-Big5")
+    ("zh_CN" . "Chinese-GB")
+    ("zh" . "Chinese-GB")
     ; zh_CN.GB18030/GB18030 \
     ; zh_CN.GBK/GBK \
     ; zh_HK/BIG5-HKSCS \
-
-    ("zh.*[._]big5" . "Chinese-BIG5")
-    ("zh.*[._]gbk" . nil) ; Solaris 2.7; has gbk-0 as well as GB 2312.1980-0
-    ("zh_tw" . "Chinese-CNS") ; glibc uses big5
-    ("zh_tw[._]euc-tw" . "Chinese-EUC-TW")
-    ("zh" . "Chinese-GB")
-    ; zu Zulu
+    ("zu" . "Latin-1") ; Zulu
 
     ;; ISO standard locales
     ("c$" . "ASCII")
@@ -2223,10 +2234,16 @@ of `buffer-file-coding-system' set by this function."
     ("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.")
+  "Alist of locale regexps vs the corresponding languages and coding systems.
+Each element has these form:
+  \(LOCALE-REGEXP LANG-ENV CODING-SYSTEM)
+The first element whose LOCALE-REGEXP matches the start of a
+downcased locale specifies the LANG-ENV \(language environtment)
+and CODING-SYSTEM corresponding to that locale.  If there is no
+appropriate language environment, the element may have this form:
+  \(LOCALE-REGEXP . LANG-ENV)
+In this case, LANG-ENV is one of generic language environments for an
+specific encoding such as \"Latin-1\" and \"UTF-8\".")
 
 (defconst locale-charset-language-names
   (purecopy
@@ -2244,20 +2261,43 @@ If the language name is nil, there is no corresponding language environment.")
   "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 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.")
+This language name is used if the locale is not listed in
+`locale-language-names'")
 
 (defconst locale-preferred-coding-systems
   (purecopy
-   '(("ja.*[._]euc" . japanese-iso-8bit)
+   '((".*8859[-_]?1\\>" . iso-8859-1)
+     (".*8859[-_]?2\\>" . iso-8859-2)
+     (".*8859[-_]?3\\>" . iso-8859-3)
+     (".*8859[-_]?4\\>" . iso-8859-4)
+     (".*8859[-_]?9\\>" . iso-8859-9)
+     (".*8859[-_]?14\\>" . iso-8859-14)
+     (".*8859[-_]?15\\>" . iso-8859-15)
+     (".*utf\\(?:-?8\\)?" . utf-8)
+     ;; utf-8@euro exists, so put this after utf-8.  (@euro really
+     ;; specifies the currency, rather than the charset.)
+     (".*@euro" . iso-8859-15)
+     ("koi8-?r" . koi8-r)
+     ("koi8-?u" . koi8-u)
+     ("tcvn" . tcvn)
+     ("big5" . big5)
+     ("euc-?tw" . euc-tw)
+     ;; We don't support GBK, but as it is upper compatible with
+     ;; GB-2312, we setup the default coding system to gb2312.
+     ("gbk" . gb2312)
+     ;; We don't support BIG5-HKSCS, but as it is upper compatible with
+     ;; BIG5, we setup the default coding system to big5.
+     ("big5hkscs" . big5)
+     ("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.")
+specifies the coding system to prefer when using that locale.
+This coding system is used if the locale specifies a specific charset.")
 
 (defun locale-name-match (key alist)
   "Search for KEY in ALIST, which should be a list of regexp-value pairs.
@@ -2300,115 +2340,6 @@ is returned.  Thus, for instance, if charset \"ISO8859-2\",
            (pop cs)))
        (if c (coding-system-base c)))))
 
-(defun set-locale-translation-file-name ()
-  "Set up the locale-translation-file-name on the current system.
-
-This needs to be done 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" ; 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,
-                ;; since the X-related names are what X actually uses.
-                "/usr/share/locale/locale.alias" ; GNU/Linux sans X
-                )))
-         (while (and files (not (file-exists-p (car files))))
-           (setq files (cdr files)))
-         (car files))))
-
-(defun get-locale-real-name (&optional locale-name)
-  "Return the canonicalized name of locale LOCALE-NAME.
-
-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).
-On server frames, the environment of the emacsclient process is
-used.
-
-See also `set-locale-environment'."
-  (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
-                 (= 0 (length locale-name))) ; nil or empty string
-       (setq locale-name (server-getenv (pop 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)))))))
-    locale-name)
-
-(defun get-locale-coding-system (&optional locale)
-  "Return the coding system corresponding to locale LOCALE."
-  (setq locale (or locale (get-locale-real-name nil)))
-  (when locale
-    (or (locale-name-match locale locale-preferred-coding-systems)
-       (when locale
-         (if (string-match "\\.\\([^@]+\\)" locale)
-             (locale-charset-to-coding-system
-              (match-string 1 locale)))))))
-
-(defun configure-display-for-locale (&optional locale)
-  "Set up terminal for locale LOCALE.
-
-The display table, the terminal coding system and the keyboard
-coding system of the current display device are set up for the
-given locale."
-  (setq locale (or locale (get-locale-real-name nil)))
-
-  (when locale
-    (let ((language-name
-          (locale-name-match locale locale-language-names))
-         (charset-language-name
-          (locale-name-match locale locale-charset-language-names))
-         (coding-system
-          (get-locale-coding-system locale)))
-
-      ;; 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
-
-       ;; 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
-         ;; Override default-terminal-coding-system in case the
-         ;; display coding can not be derived from the language
-         ;; environment.
-         (let ((default-terminal-coding-system coding-system))
-           (set-display-table-and-terminal-coding-system language-name)))
-
-       ;; 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))))))))
-
 ;; 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.
@@ -2428,8 +2359,6 @@ 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).
-On server frames, the environment of the emacsclient process is
-used.
 
 The locale names supported by your system can typically be found in a
 directory named `/usr/share/locale' or `/usr/lib/locale'.  LOCALE-NAME
@@ -2440,10 +2369,52 @@ See also `locale-charset-language-names', `locale-language-names',
 `locale-preferred-coding-systems' and `locale-coding-system'."
   (interactive "sSet environment for locale: ")
 
-  (let ((locale (get-locale-real-name locale-name)))
+  ;; 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" ; 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,
+                ;; since the X-related names are what X actually uses.
+                "/usr/share/locale/locale.alias" ; GNU/Linux sans X
+                )))
+         (while (and files (not (file-exists-p (car files))))
+           (setq files (cdr files)))
+         (car files)))
+
+  (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
+                   (= 0 (length locale))) ; nil or empty string
+         (setq locale (getenv (pop vars))))))
+
+    (unless (or locale (not (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,
+      ;; 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
@@ -2454,21 +2425,29 @@ See also `locale-charset-language-names', `locale-language-names',
 
       (setq locale (downcase locale))
 
-      (configure-display-for-locale locale)
-
       (let ((language-name
             (locale-name-match locale locale-language-names))
            (charset-language-name
             (locale-name-match locale locale-charset-language-names))
            (coding-system
-            (get-locale-coding-system locale)))
-
-       ;; 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))
+            (or (locale-name-match locale locale-preferred-coding-systems)
+                (when locale
+                  (if (string-match "\\.\\([^@]+\\)" locale)
+                      (locale-charset-to-coding-system
+                       (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.
+           ;; But, what specified in locale-preferred-coding-systems
+           ;; has higher priority.
+           (setq coding-system (or coding-system
+                                   (nth 1 language-name))
+                 language-name (car language-name))
+         ;; Otherwise, if locale is not listed in locale-language-names,
+         ;; use what listed in locale-charset-language-names.
+         (if (not language-name)
+             (setq language-name charset-language-name)))
 
        (when language-name
 
@@ -2476,23 +2455,52 @@ See also `locale-charset-language-names', `locale-language-names',
          ;; 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 coding-system))
+
+         ;; 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
+       (when (and coding-system
+                  (not (coding-system-equal coding-system
+                                            locale-coding-system)))
          (prefer-coding-system coding-system)
          (setq locale-coding-system coding-system))))
 
-    ;; On Windows, override locale-coding-system, keyboard-coding-system,
-    ;; selection-coding-system with system codepage.
+    ;; On Windows, override locale-coding-system,
+    ;; keyboard-coding-system with system codepage.  Note:
+    ;; selection-coding-system is already set in w32select.c.
     (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))))
 
+    (when (eq system-type 'darwin)
+      ;; On Darwin, file names are always encoded in utf-8, no matter
+      ;; the locale.
+      (setq default-file-name-coding-system 'utf-8)
+      ;; Mac OS X's Terminal.app by default uses utf-8 regardless of
+      ;; the locale.
+      (when (and (null window-system)
+                (equal (getenv "TERM_PROGRAM") "Apple_Terminal"))
+       (set-terminal-coding-system 'utf-8)
+       (set-keyboard-coding-system 'utf-8)))
+
     ;; Default to A4 paper if we're not in a C, POSIX or US locale.
     ;; (See comments in Flocale_info.)
     (let ((locale locale)
@@ -2621,5 +2629,5 @@ If CODING-SYSTEM can't safely encode CHAR, return nil."
       (substring enc2 0 i2))))
 
 
-;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
+;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
 ;;; mule-cmds.el ends here