Mercurial > emacs

changeset 83131:24e9d5ea9a88

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use the remote locale for terminal & keyboard coding system. 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
author Karoly Lorentey <lorentey@elte.hu>
date Sun, 23 May 2004 03:56:10 +0000
parents 20f9fa3c5131
children f982df4459a4
files lisp/international/mule-cmds.el lisp/server.el lisp/startup.el
diffstat 3 files changed, 115 insertions(+), 60 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/international/mule-cmds.el	Sun May 23 03:37:58 2004 +0000
+++ b/lisp/international/mule-cmds.el	Sun May 23 03:56:10 2004 +0000
@@ -2291,6 +2291,111 @@
 	    (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 @@
 
 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 @@
 `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 @@
 
       (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 @@
 	  ;; 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))))
 
--- a/lisp/server.el	Sun May 23 03:37:58 2004 +0000
+++ b/lisp/server.el	Sun May 23 03:56:10 2004 +0000
@@ -514,6 +514,8 @@
 		    (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)))
--- a/lisp/startup.el	Sun May 23 03:37:58 2004 +0000
+++ b/lisp/startup.el	Sun May 23 03:56:10 2004 +0000
@@ -647,6 +647,8 @@
      (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.