Use the remote locale for terminal & keyboard coding system.
authorKaroly Lorentey <lorentey@elte.hu>
Sun, 23 May 2004 03:56:10 +0000 (03:56 +0000)
committerKaroly Lorentey <lorentey@elte.hu>
Sun, 23 May 2004 03:56:10 +0000 (03:56 +0000)
lisp/international/mule-cmds.el (set-locale-translation-file-name)
(get-locale-real-name, get-locale-coding-system)
(configure-display-for-locale): New functions.
(set-locale-environment): Factored contents into separate functions.

lisp/server.el (server-process-filter): Call
configure-display-for-locale after creating a new terminal frame.

lisp/startup.el (command-line): Call set-locale-translation-file-name.

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-171

lisp/international/mule-cmds.el
lisp/server.el
lisp/startup.el

index d8683b5..7aed6a9 100644 (file)
@@ -2291,6 +2291,111 @@ 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
+         (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.
@@ -2310,6 +2415,8 @@ 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
@@ -2320,43 +2427,10 @@ See also `locale-charset-language-names', `locale-language-names',
 `locale-preferred-coding-systems' and `locale-coding-system'."
   (interactive "sSet environment for locale: ")
 
-  ;; Do this at runtime for the sake of binaries possibly transported
-  ;; to a system without X.
-  (setq locale-translation-file-name
-       (let ((files
-              '("/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
-                "/usr/X11R6/lib/X11/locale/locale.alias" ; 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))))))
+  (let ((locale (get-locale-real-name locale-name)))
 
     (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
@@ -2367,16 +2441,14 @@ 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
-            (or (locale-name-match locale locale-preferred-coding-systems)
-                (when locale
-                  (if (string-match "\\.\\([^@]+\\)" locale)
-                      (locale-charset-to-coding-system
-                       (match-string 1 locale)))))))
+            (get-locale-coding-system locale)))
 
        ;; Give preference to charset-language-name over language-name.
        (if (and charset-language-name
@@ -2391,27 +2463,6 @@ 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))
-
-         ;; Set the `keyboard-coding-system' if appropriate (tty
-         ;; only).  At least X and MS Windows can generate
-         ;; multilingual input.
-         (unless (or window-system
-                     keyboard-coding-system)
-           ;; FIXME: keyboard-coding-system must be removed from the above
-           ;; condition when multi-tty locale handling is correctly
-           ;; implemented.  Also, unconditionally overriding it with nil
-           ;; is not a good idea, as it ignores the user's
-           ;; customization. -- lorentey
-           (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))))
 
index 433d9a7..9758ac1 100644 (file)
@@ -514,6 +514,8 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
                    (select-frame frame)
                    (server-client-set client 'frame frame)
                    (server-client-set client 'tty (frame-tty-name frame))
+                   ;; Set up display for the remote locale.
+                   (configure-display-for-locale)
                    ;; Reply with our pid.
                    (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
                    (setq dontkill t)))
index d9b4c04..2402d11 100644 (file)
@@ -647,6 +647,8 @@ opening the first frame (e.g. open a connection to the server).")
      (setq initial-window-system nil)
      (kill-emacs)))
 
+  ;; Locale initialization.
+  (set-locale-translation-file-name)
   (set-locale-environment nil)
 
   ;; Convert the arguments to Emacs internal representation.