Commit 14de9163 authored by Karoly Lorentey's avatar Karoly Lorentey
Browse files

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
parent 44070fdf
......@@ -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))))
......
......@@ -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)))
......
......@@ -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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment