]> code.delx.au - gnu-emacs/blobdiff - lisp/international/mule-cmds.el
Merged from emacs@sv.gnu.org
[gnu-emacs] / lisp / international / mule-cmds.el
index 5fefc2f31cb2548f0ffddf4a90f4caf545954fcd..8e63729b7a5c17beaf87f0d03798b8a494398ba9 100644 (file)
   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]
@@ -278,7 +278,7 @@ wrong, use this command again to toggle back to the right mode."
                       buffer-file-coding-system)))
      (list (read-coding-system
            (if default
-               (format "Coding system for following command (default, %s): " default)
+               (format "Coding system for following command (default %s): " default)
              "Coding system for following command: ")
            default))))
   (let* ((keyseq (read-key-sequence
@@ -616,7 +616,7 @@ or nil if all characters are encodable."
   (interactive
    (list (let ((default (or buffer-file-coding-system 'us-ascii)))
           (read-coding-system
-           (format "Coding-system (default, %s): " default)
+           (format "Coding-system (default %s): " default)
            default))))
   (let ((pos (unencodable-char-position (point) (point-max) coding-system)))
     (if pos
@@ -1126,6 +1126,13 @@ For a list of useful values for KEY and their meanings,
 see `language-info-alist'."
   (if (symbolp lang-env)
       (setq lang-env (symbol-name lang-env)))
+  (set-language-info-internal lang-env key info)
+  (if (equal lang-env current-language-environment)
+      (set-language-environment lang-env)))
+
+(defun set-language-info-internal (lang-env key info)
+  "Internal use only.
+Arguments are the same as `set-language-info'."
   (let (lang-slot key-slot)
     (setq lang-slot (assoc lang-env language-info-alist))
     (if (null lang-slot)               ; If no slot for the language, add it.
@@ -1196,9 +1203,11 @@ in the European submenu in each of those two menus."
     (define-key-after setup-map (vector (intern lang-env))
       (cons lang-env 'setup-specified-language-environment) t)
 
-    (while alist
-      (set-language-info lang-env (car (car alist)) (cdr (car alist)))
-      (setq alist (cdr alist)))))
+    (dolist (elt alist)
+      (set-language-info-internal lang-env (car elt) (cdr elt)))
+    
+    (if (equal lang-env current-language-environment)
+       (set-language-environment lang-env))))
 
 (defun read-language-name (key prompt &optional default)
   "Read a language environment name which has information for KEY.
@@ -1490,7 +1499,7 @@ which marks the variable `default-input-method' as set for Custom buffers."
   "Describe input method INPUT-METHOD."
   (interactive
    (list (read-input-method-name
-         "Describe input method (default, current choice): ")))
+         "Describe input method (default current choice): ")))
   (if (and input-method (symbolp input-method))
       (setq input-method (symbol-name input-method)))
   (help-setup-xref (list #'describe-input-method
@@ -1786,10 +1795,12 @@ The default status is as follows:
 
 (reset-language-environment)
 
-(defun set-display-table-and-terminal-coding-system (language-name &optional coding-system)
+(defun set-display-table-and-terminal-coding-system (language-name &optional coding-system display)
   "Set up the display table and terminal coding system for LANGUAGE-NAME."
   (let ((coding (get-language-info language-name 'unibyte-display)))
-    (if coding
+    (if (and coding
+            (or (not coding-system)
+                (coding-system-equal coding coding-system)))
        (standard-display-european-internal)
       ;; The following 2 lines undo the 8-bit display that we set up
       ;; in standard-display-european-internal, which see.  This is in
@@ -1800,7 +1811,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 (or coding-system coding)))))
+       (set-terminal-coding-system (or coding-system coding) display))))
 
 (defun set-language-environment (language-name)
   "Set up multi-lingual environment for using LANGUAGE-NAME.
@@ -1810,7 +1821,7 @@ which is the name of a language environment.  For example, \"Latin-1\"
 specifies the character set for the major languages of Western Europe."
   (interactive (list (read-language-name
                      nil
-                     "Set language environment (default, English): ")))
+                     "Set language environment (default English): ")))
   (if language-name
       (if (symbolp language-name)
          (setq language-name (symbol-name language-name)))
@@ -1867,16 +1878,18 @@ specifies the character set for the major languages of Western Europe."
            (load syntax nil t))
        ;; No information for syntax and case.  Reset to the defaults.
        (let ((syntax-table (standard-syntax-table))
-             (case-table (standard-case-table))
+             (standard-table (standard-case-table))
+             (case-table (make-char-table 'case-table))
              (ch (if (eq window-system 'pc) 128 160)))
          (while (< ch 256)
            (modify-syntax-entry ch " " syntax-table)
-           (aset case-table ch ch)
            (setq ch (1+ ch)))
+         (dotimes (i 128)
+           (aset case-table i (aref standard-table i)))
          (set-char-table-extra-slot case-table 0 nil)
          (set-char-table-extra-slot case-table 1 nil)
-         (set-char-table-extra-slot case-table 2 nil))
-       (set-standard-case-table (standard-case-table))
+         (set-char-table-extra-slot case-table 2 nil)
+         (set-standard-case-table case-table))
        (let ((list (buffer-list)))
          (while list
            (with-current-buffer (car list)
@@ -1901,7 +1914,6 @@ specifies the character set for the major languages of Western Europe."
     (if (functionp func)
        (funcall func)))
   (if (and utf-translate-cjk-mode
-          utf-translate-cjk-lang-env
           (not (eq utf-translate-cjk-lang-env language-name))
           (catch 'tag
             (dolist (charset (get-language-info language-name 'charset))
@@ -1987,7 +1999,7 @@ of `buffer-file-coding-system' set by this function."
   (interactive
    (list (read-language-name
          'documentation
-         "Describe language environment (default, current choice): ")))
+         "Describe language environment (default current choice): ")))
   (if (null language-name)
       (setq language-name current-language-environment))
   (if (or (null language-name)
@@ -2015,7 +2027,7 @@ of `buffer-file-coding-system' set by this function."
              (l (copy-sequence input-method-alist)))
          (insert "Input methods")
          (when input-method
-           (insert " (default, " input-method ")")
+           (insert " (default " input-method ")")
            (setq input-method (assoc input-method input-method-alist))
            (setq l (cons input-method (delete input-method l))))
          (insert ":\n")
@@ -2128,7 +2140,7 @@ of `buffer-file-coding-system' set by this function."
     ;; 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
+    ("en" "English" iso-8859-1) ; English
     ("eo" . "Latin-3") ; Esperanto
     ("es" "Spanish" iso-8859-1)
     ("et" . "Latin-1") ; Estonian
@@ -2394,7 +2406,7 @@ is returned.  Thus, for instance, if charset \"ISO8859-2\",
 ;; too, for setting things such as calendar holidays, ps-print paper
 ;; size, spelling dictionary.
 
-(defun set-locale-environment (&optional locale-name)
+(defun set-locale-environment (&optional locale-name display)
   "Set up multi-lingual environment for using LOCALE-NAME.
 This sets the language environment, the coding system priority,
 the default input method and sometimes other things.
@@ -2415,6 +2427,11 @@ directory named `/usr/share/locale' or `/usr/lib/locale'.  LOCALE-NAME
 will be translated according to the table specified by
 `locale-translation-file-name'.
 
+If DISPLAY is non-nil, only set the keyboard coding system and
+the terminal coding system for the given display, and don't touch
+session-global parameters like the language environment.  DISPLAY
+may be a display id or a frame.
+
 See also `locale-charset-language-names', `locale-language-names',
 `locale-preferred-coding-systems' and `locale-coding-system'."
   (interactive "sSet environment for locale: ")
@@ -2423,7 +2440,8 @@ See also `locale-charset-language-names', `locale-language-names',
   ;; to a system without X.
   (setq locale-translation-file-name
        (let ((files
-              '("/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
+              '("/usr/share/X11/locale/locale.alias" ; e.g. X11R7
+                "/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
                 "/usr/X11R6/lib/X11/locale/locale.alias" ; XFree86, e.g. RedHat 4.2
                 "/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6
                 ;;
@@ -2443,14 +2461,17 @@ See also `locale-charset-language-names', `locale-language-names',
       (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))))))
+         (setq locale (getenv (pop vars) display)))))
+
+    (unless locale
+      ;; The two tests are kept separate so the byte-compiler sees
+      ;; that mac-get-preference is only called after checking its existence.
+      (when (fboundp 'mac-get-preference)
+        (setq locale (mac-get-preference "AppleLocale"))
+        (unless locale
+          (let ((languages (mac-get-preference "AppleLanguages")))
+            (unless (= (length languages) 0) ; nil or empty vector
+              (setq locale (aref languages 0)))))))
     (unless (or locale (not (boundp 'mac-system-locale)))
       (setq locale mac-system-locale))
 
@@ -2503,28 +2524,34 @@ See also `locale-charset-language-names', `locale-language-names',
 
          ;; 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)
+         (unless display
+           (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))
+            language-name coding-system display))
 
          ;; 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 (and coding-system
+         ;; XXX This was disabled unless `window-system', but that
+         ;; leads to buggy behaviour when a tty frame is opened
+         ;; later.  Setting the keyboard coding system has no adverse
+         ;; effect on X, so let's do it anyway. -- Lorentey
+         (let ((kcs (or coding-system
+                        (car (get-language-info language-name
+                                                'coding-system)))))
+           (if kcs (set-keyboard-coding-system kcs display)))
+
+         (unless display
+           (setq locale-coding-system
+                 (car (get-language-info language-name 'coding-priority)))))
+
+       (when (and (not display)
+                  coding-system
                   (not (coding-system-equal coding-system
                                             locale-coding-system)))
          (prefer-coding-system coding-system)
@@ -2536,9 +2563,9 @@ See also `locale-charset-language-names', `locale-language-names',
     (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-keyboard-coding-system code-page-coding)
-         (set-terminal-coding-system code-page-coding))))
+         (unless display (setq locale-coding-system code-page-coding))
+         (set-keyboard-coding-system code-page-coding display)
+         (set-terminal-coding-system code-page-coding display))))
 
     (when (eq system-type 'darwin)
       ;; On Darwin, file names are always encoded in utf-8, no matter
@@ -2547,38 +2574,39 @@ See also `locale-charset-language-names', `locale-language-names',
       ;; 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"))
+                (equal (getenv "TERM_PROGRAM" display) "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)
-         (paper (locale-info 'paper)))
-      (if paper
-         ;; This will always be null at the time of writing.
-         (cond
-          ((equal paper '(216 279))
-           (setq ps-paper-type 'letter))
-          ((equal paper '(210 297))
-           (setq ps-paper-type 'a4)))
-       (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
-         (while (and vars (= 0 (length locale)))
-           (setq locale (getenv (pop vars)))))
-       (when locale
-         ;; As of glibc 2.2.5, these are the only US Letter locales,
-         ;; and the rest are A4.
-         (setq ps-paper-type
-               (or (locale-name-match locale '(("c$" . letter)
-                                               ("posix$" . letter)
-                                               (".._us" . letter)
-                                               (".._pr" . letter)
-                                               (".._ca" . letter)
-                                               ("enu$" . letter) ; Windows
-                                               ("esu$" . letter)
-                                               ("enc$" . letter)
-                                               ("frc$" . letter)))
-                   'a4))))))
+    (unless display
+      (let ((locale locale)
+           (paper (locale-info 'paper)))
+       (if paper
+           ;; This will always be null at the time of writing.
+           (cond
+            ((equal paper '(216 279))
+             (setq ps-paper-type 'letter))
+            ((equal paper '(210 297))
+             (setq ps-paper-type 'a4)))
+         (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
+           (while (and vars (= 0 (length locale)))
+             (setq locale (getenv (pop vars) display))))
+         (when locale
+           ;; As of glibc 2.2.5, these are the only US Letter locales,
+           ;; and the rest are A4.
+           (setq ps-paper-type
+                 (or (locale-name-match locale '(("c$" . letter)
+                                                 ("posix$" . letter)
+                                                 (".._us" . letter)
+                                                 (".._pr" . letter)
+                                                 (".._ca" . letter)
+                                                 ("enu$" . letter) ; Windows
+                                                 ("esu$" . letter)
+                                                 ("enc$" . letter)
+                                                 ("frc$" . letter)))
+                     'a4)))))))
   nil)
 \f
 ;;; Charset property
@@ -2643,8 +2671,8 @@ It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
    (if (and coding-system (eq (coding-system-type coding-system) 2))
        ;; Try to get a pretty description for ISO 2022 escape sequences.
        (function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
-                                (format "0x%02X" x))))
-     (function (lambda (x) (format "0x%02X" x))))
+                                (format "#x%02X" x))))
+     (function (lambda (x) (format "#x%02X" x))))
    str " "))
 
 (defun encode-coding-char (char coding-system)