;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007 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
+;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Copyright (C) 2003
;; 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
;; 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 <http://www.gnu.org/licenses/>.
;;; 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.
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]
(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)
(let ((codings (find-coding-systems-region from to))
(coding-system nil)
+ (tick (if (not (stringp from)) (buffer-modified-tick)))
safe rejected unsafe)
(if (eq (car codings) 'undecided)
;; Any coding system is ok.
%s specified by file contents. Really save (else edit coding cookies \
and try again)? " coding-system auto-cs))
(error "Save aborted"))))
+ (when (and tick (/= tick (buffer-modified-tick)))
+ (error "Cancelled because the buffer was modified"))
coding-system)))
(setq select-safe-coding-system-function 'select-safe-coding-system)
(put 'input-method-function 'permanent-local t)
(defvar input-method-history nil
- "History list for some commands that read input methods.")
+ "History list of input methods read from the minibuffer.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
(make-variable-buffer-local 'input-method-history)
(put 'input-method-history 'permanent-local t)
(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."
;; (set-terminal-coding-system-internal nil)
;; (set-keyboard-coding-system-internal nil)
- (set-unibyte-charset 'iso-8859-1))
+ ;; Back in Emacs-20, it was necessary to provide some fallback implicit
+ ;; conversion, because almost no packages handled coding-system issues.
+ ;; Nowadays it'd just paper over bugs.
+ ;; (set-unibyte-charset 'iso-8859-1)
+ )
(reset-language-environment)
(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))
(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)
(or (and (charsetp nonascii)
(get-charset-property nonascii :ascii-compatible-p))
(setq nonascii 'iso-8859-1))
- (set-unibyte-charset nonascii)))
+ ;; Back in Emacs-20, it was necessary to provide some fallback implicit
+ ;; conversion, because almost no packages handled coding-system issues.
+ ;; Nowadays it'd just paper over bugs.
+ ;; (set-unibyte-charset nonascii)
+ ))
(defun set-language-environment-charset (language-name)
"Do various charset setups for language environment LANGUAGE-NAME."
;; too, for setting things such as calendar holidays, ps-print paper
;; size, spelling dictionary.
+(defun locale-translate (locale)
+ "Expand LOCALE according to `locale-translation-file-name', if possible.
+For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."
+ (if locale-translation-file-name
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents locale-translation-file-name)
+ (if (re-search-forward
+ (concat "^" (regexp-quote locale) ":?[ \t]+") nil t)
+ (buffer-substring (point) (line-end-position))
+ locale))
+ locale))
+
(defun set-locale-environment (&optional locale-name frame)
"Set up multi-lingual environment for using LOCALE-NAME.
This sets the language environment, the coding system priority,
(= 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
-
- ;; 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
- (set-buffer-multibyte nil)
- (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))))))
+ (setq locale (locale-translate locale))
;; Leave the system locales alone if the caller did not specify
;; an explicit locale name, as their defaults are set from
;; want to set them to the same value as LC_CTYPE.
(when locale-name
(setq system-messages-locale locale)
- (setq system-time-locale locale))
+ (setq system-time-locale locale)))
+
+ (setq woman-locale
+ (or system-messages-locale
+ (let ((msglocale (getenv "LC_MESSAGES" frame)))
+ (if (zerop (length msglocale))
+ locale
+ (locale-translate msglocale)))))
+ (when locale
(setq locale (downcase locale))
(let ((language-name
(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.
;; 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
;; Fixme: perhaps prefer-coding-system should set this too.
;; But it's not the time to do such a fundamental change.
(setq default-sendmail-coding-system coding-system)
- (setq locale-coding-system coding-system))
-
- (when (get-language-info current-language-environment 'coding-priority)
- (let ((codeset (locale-info 'codeset))
- (coding-system (car (coding-system-priority-list))))
- (when codeset
- (let ((cs (coding-system-aliases coding-system))
- result)
- (while (and cs (not result))
- (setq result
- (locale-charset-match-p (symbol-name (pop cs))
- (locale-info 'codeset))))
- (unless result
- (message "Warning: Default coding system `%s' disagrees with
-system codeset `%s' for this locale." coding-system codeset))))))))
+ (setq locale-coding-system coding-system))))
;; On Windows, override locale-coding-system,
;; default-file-name-coding-system, keyboard-coding-system,
(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.
(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))
- (insert 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