X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a113b3ca322fd73d97d0d9d69c9f48dc13fb326a..430c6cede235d6c1b9197fdc30faddb20569b71a:/lisp/international/mule-cmds.el diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index a04ffe1877..c5b05d629a 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1,7 +1,7 @@ ;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*- -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008 ;; National Institute of Advanced Industrial Science and Technology (AIST) @@ -14,10 +14,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -25,20 +25,16 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: -(eval-when-compile - (defvar dos-codepage) - (autoload 'widget-value "wid-edit")) +(defvar dos-codepage) +(autoload 'widget-value "wid-edit") (defvar mac-system-coding-system) -(defvar mac-system-locale) ;;; MULE related key bindings and menus. @@ -151,7 +147,7 @@ t) (define-key-after set-coding-system-map [set-terminal-coding-system] '(menu-item "For Terminal" set-terminal-coding-system - :enable (null (memq initial-window-system '(x w32 mac))) + :enable (null (memq initial-window-system '(x w32 ns))) :help "How to encode terminal output") t) (define-key-after set-coding-system-map [separator-3] @@ -267,7 +263,7 @@ wrong, use this command again to toggle back to the right mode." (force-mode-line-update)) (defun view-hello-file () - "Display the HELLO file which list up many languages and characters." + "Display the HELLO file, which lists many languages and characters." (interactive) ;; We have to decode the file in any environment. (let ((default-enable-multibyte-characters t) @@ -1509,7 +1505,7 @@ which marks the variable `default-input-method' as set for Custom buffers." (when interactive (customize-mark-as-set 'default-input-method))))))) -(eval-when-compile (autoload 'help-buffer "help-mode")) +(autoload 'help-buffer "help-mode") (defun describe-input-method (input-method) "Describe input method INPUT-METHOD." @@ -1845,6 +1841,9 @@ specifies the character set for the major languages of Western Europe." (if (functionp func) (funcall func))) + (setq current-iso639-language + (get-language-info language-name 'iso639-language)) + (run-hooks 'set-language-environment-hook) (force-mode-line-update t)) @@ -1910,6 +1909,9 @@ Setting this variable directly does not take effect. See (features (repeat symbol)) (unibyte-display coding-system))))) +(declare-function x-server-vendor "xfns.c" (&optional terminal)) +(declare-function x-server-version "xfns.c" (&optional terminal)) + (defun standard-display-european-internal () ;; Actually set up direct output of non-ASCII characters. (standard-display-8bit (if (eq window-system 'pc) 128 160) 255) @@ -2499,18 +2501,6 @@ See also `locale-charset-language-names', `locale-language-names', (= 0 (length locale))) ; nil or empty string (setq locale (getenv (pop vars) frame))))) - (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)) - (when locale (setq locale (locale-translate locale)) @@ -2543,8 +2533,7 @@ See also `locale-charset-language-names', `locale-language-names', (when locale (if (string-match "\\.\\([^@]+\\)" locale) (locale-charset-to-coding-system - (match-string 1 locale)))) - (and (eq system-type 'macos) mac-system-coding-system)))) + (match-string 1 locale))))))) (if (consp language-name) ;; locale-language-names specify both lang-env and coding. @@ -2585,7 +2574,7 @@ See also `locale-charset-language-names', `locale-language-names', ;; only). At least X and MS Windows can generate ;; multilingual input. ;; XXX This was disabled unless `window-system', but that - ;; leads to buggy behaviour when a tty frame is opened + ;; leads to buggy behavior 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 @@ -2799,32 +2788,40 @@ If there's no description string for VALUE, return nil." (function (lambda (x) (format "#x%02X" x)))) str " ")) -(defun encode-coding-char (char coding-system) +(defun encode-coding-char (char coding-system &optional charset) "Encode CHAR by CODING-SYSTEM and return the resulting string. -If CODING-SYSTEM can't safely encode CHAR, return nil." - (let ((str1 (string-as-multibyte (string char))) - (str2 (string-as-multibyte (string char char))) +If CODING-SYSTEM can't safely encode CHAR, return nil. +The 3rd optional argument CHARSET, if non-nil, is a charset preferred +on encoding." + (let* ((str1 (string-as-multibyte (string char))) + (str2 (string-as-multibyte (string char char))) + (found (find-coding-systems-string str1)) enc1 enc2 i1 i2) - (when (memq (coding-system-base coding-system) - (find-coding-systems-string str1)) - ;; We must find the encoded string of CHAR. But, just encoding - ;; CHAR will put extra control sequences (usually to designate - ;; ASCII charset) at the tail if type of CODING is ISO 2022. - ;; To exclude such tailing bytes, we at first encode one-char - ;; string and two-char string, then check how many bytes at the - ;; tail of both encoded strings are the same. - - (setq enc1 (encode-coding-string str1 coding-system) - i1 (length enc1) - enc2 (encode-coding-string str2 coding-system) - i2 (length enc2)) - (while (and (> i1 0) (= (aref enc1 (1- i1)) (aref enc2 (1- i2)))) - (setq i1 (1- i1) i2 (1- i2))) - - ;; Now (substring enc1 i1) and (substring enc2 i2) are the same, - ;; and they are the extra control sequences at the tail to - ;; exclude. - (substring enc2 0 i2)))) + (if (and (consp found) + (eq (car found) 'undecided)) + str1 + (when (memq (coding-system-base coding-system) found) + ;; We must find the encoded string of CHAR. But, just encoding + ;; CHAR will put extra control sequences (usually to designate + ;; ASCII charset) at the tail if type of CODING is ISO 2022. + ;; To exclude such tailing bytes, we at first encode one-char + ;; string and two-char string, then check how many bytes at the + ;; tail of both encoded strings are the same. + + (when charset + (put-text-property 0 1 'charset charset str1) + (put-text-property 0 2 'charset charset str2)) + (setq enc1 (encode-coding-string str1 coding-system) + i1 (length enc1) + enc2 (encode-coding-string str2 coding-system) + i2 (length enc2)) + (while (and (> i1 0) (= (aref enc1 (1- i1)) (aref enc2 (1- i2)))) + (setq i1 (1- i1) i2 (1- i2))) + + ;; Now (substring enc1 i1) and (substring enc2 i2) are the same, + ;; and they are the extra control sequences at the tail to + ;; exclude. + (substring enc2 0 i2))))) ;; Backwards compatibility. These might be better with :init-value t, ;; but that breaks loadup. @@ -2840,16 +2837,63 @@ If CODING-SYSTEM can't safely encode CHAR, return nil." (defvar nonascii-insert-offset 0 "This variable is obsolete.") (defvar nonascii-translation-table nil "This variable is obsolete.") +(defvar ucs-names nil + "Alist of cached (CHAR-NAME . CHAR-CODE) pairs.") + +(defun ucs-names () + "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'." + (or ucs-names + (setq ucs-names + (let (name names) + (dotimes (c #xEFFFF) + (unless (or + (and (>= c #x3400 ) (<= c #x4dbf )) ; CJK Ideograph Extension A + (and (>= c #x4e00 ) (<= c #x9fff )) ; CJK Ideograph + (and (>= c #xd800 ) (<= c #xfaff )) ; Private/Surrogate + (and (>= c #x20000) (<= c #x2ffff)) ; CJK Ideograph Extension B + ) + (if (setq name (get-char-code-property c 'name)) + (setq names (cons (cons name c) names))) + (if (setq name (get-char-code-property c 'old-name)) + (setq names (cons (cons name c) names))))) + names)))) + +(defvar ucs-completions (lazy-completion-table ucs-completions ucs-names) + "Lazy completion table for completing on Unicode character names.") + +(defun read-char-by-name (prompt) + "Read a character by its Unicode name or hex number string. +Display PROMPT and read a string that represents a character by its +Unicode property `name' or `old-name'. You can type a few of first +letters of the Unicode name and use completion. This function also +accepts a hexadecimal number of Unicode code point or a number in +hash notation, e.g. #o21430 for octal, #x2318 for hex, or #10r8984 +for decimal. Returns a character as a number." + (let* ((completion-ignore-case t) + (input (completing-read prompt ucs-completions))) + (cond + ((string-match "^[0-9a-fA-F]+$" input) + (string-to-number input 16)) + ((string-match "^#" input) + (read input)) + (t + (cdr (assoc input (ucs-names))))))) + (defun ucs-insert (arg) "Insert a character of the given Unicode code point. -Interactively, prompts for a hex string giving the code." - (interactive "sUnicode (hex): ") - (or (integerp arg) +Interactively, prompts for a Unicode character name or a hex number +using `read-char-by-name'." + (interactive (list (read-char-by-name "Unicode (name or hex): "))) + (if (stringp arg) (setq arg (string-to-number arg 16))) - (if (or (< arg 0) (> arg #x10FFFF)) - (error "Not a Unicode character code: 0x%X" arg)) + (cond + ((not (integerp arg)) + (error "Not a Unicode character code: %S" arg)) + ((or (< arg 0) (> arg #x10FFFF)) + (error "Not a Unicode character code: 0x%X" arg))) (insert-and-inherit arg)) +(define-key ctl-x-map "8\r" 'ucs-insert) ;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc ;;; mule-cmds.el ends here