X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/29d04c4f94fec9092a99154e5abaee387b5a5cca..bdf36482bbea390390ae7ab1461b14b807c4fb1f:/lisp/international/mule-cmds.el diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 077a196f47..8e63729b7a 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -33,6 +33,9 @@ (defvar dos-codepage) (autoload 'widget-value "wid-edit")) +(defvar mac-system-coding-system) +(defvar mac-system-locale) + ;;; MULE related key bindings and menus. (defvar mule-keymap (make-sparse-keymap) @@ -145,7 +148,7 @@ 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] @@ -275,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 @@ -613,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 @@ -1027,10 +1030,19 @@ it asks the user to select a proper coding system." ;; We should never use no-conversion for outgoing mail. (setq coding nil)) (if (fboundp select-safe-coding-system-function) - (funcall select-safe-coding-system-function - (point-min) (point-max) coding - (function (lambda (x) (coding-system-get x 'mime-charset)))) - coding))) + (setq coding + (funcall select-safe-coding-system-function + (point-min) (point-max) coding + (function (lambda (x) + (coding-system-get x 'mime-charset)))))) + (if coding + ;; Be sure to use LF for end-of-line. + (setq coding (coding-system-change-eol-conversion coding 'unix)) + ;; No coding system is decided. Usually this is the case that + ;; the current buffer contains only ASCII. So, we hope + ;; iso-8859-1 works. + (setq coding 'iso-8859-1-unix)) + coding)) ;;; Language support stuff. @@ -1114,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. @@ -1184,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. @@ -1478,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 @@ -1774,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 @@ -1788,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. @@ -1798,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))) @@ -1855,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) @@ -1889,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)) @@ -1975,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) @@ -2003,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") @@ -2116,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 @@ -2382,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. @@ -2403,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: ") @@ -2411,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 ;; @@ -2431,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)) @@ -2491,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) @@ -2524,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 @@ -2535,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) ;;; Charset property @@ -2631,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)