;;; 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, 2009 Free Software Foundation, Inc.
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009
+;; 2005, 2006, 2007, 2008, 2009, 2010
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Copyright (C) 2003
(defvar describe-language-environment-map
(let ((map (make-sparse-keymap "Describe Language Environment")))
(define-key map
- [Default] '(menu-item "Default" describe-specified-language-support))
+ [Default] `(menu-item ,(purecopy "Default") describe-specified-language-support))
map))
(defvar setup-language-environment-map
(let ((map (make-sparse-keymap "Set Language Environment")))
(define-key map
- [Default] '(menu-item "Default" setup-specified-language-environment))
+ [Default] `(menu-item ,(purecopy "Default") setup-specified-language-environment))
map))
(defvar set-coding-system-map
(let ((map (make-sparse-keymap "Set Coding System")))
(define-key-after map [universal-coding-system-argument]
- '(menu-item "For Next Command" universal-coding-system-argument
- :help "Coding system to be used by next command"))
- (define-key-after map [separator-1] '("--"))
+ `(menu-item ,(purecopy "For Next Command") universal-coding-system-argument
+ :help ,(purecopy "Coding system to be used by next command")))
+ (define-key-after map [separator-1] menu-bar-separator)
(define-key-after map [set-buffer-file-coding-system]
- '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
- :help "How to encode this buffer when saved"))
+ `(menu-item ,(purecopy "For Saving This Buffer") set-buffer-file-coding-system
+ :help ,(purecopy "How to encode this buffer when saved")))
(define-key-after map [revert-buffer-with-coding-system]
- '(menu-item "For Reverting This File Now"
+ `(menu-item ,(purecopy "For Reverting This File Now")
revert-buffer-with-coding-system
:enable buffer-file-name
- :help "Revisit this file immediately using specified coding system"))
+ :help ,(purecopy "Revisit this file immediately using specified coding system")))
(define-key-after map [set-file-name-coding-system]
- '(menu-item "For File Name" set-file-name-coding-system
- :help "How to decode/encode file names"))
- (define-key-after map [separator-2] '("--"))
+ `(menu-item ,(purecopy "For File Name") set-file-name-coding-system
+ :help ,(purecopy "How to decode/encode file names")))
+ (define-key-after map [separator-2] menu-bar-separator)
(define-key-after map [set-keyboard-coding-system]
- '(menu-item "For Keyboard" set-keyboard-coding-system
- :help "How to decode keyboard input"))
+ `(menu-item ,(purecopy "For Keyboard") set-keyboard-coding-system
+ :help ,(purecopy "How to decode keyboard input")))
(define-key-after map [set-terminal-coding-system]
- '(menu-item "For Terminal" set-terminal-coding-system
+ `(menu-item ,(purecopy "For Terminal") set-terminal-coding-system
:enable (null (memq initial-window-system '(x w32 ns)))
- :help "How to encode terminal output"))
- (define-key-after map [separator-3] '("--"))
+ :help ,(purecopy "How to encode terminal output")))
+ (define-key-after map [separator-3] menu-bar-separator)
(define-key-after map [set-selection-coding-system]
- '(menu-item "For X Selections/Clipboard" set-selection-coding-system
+ `(menu-item ,(purecopy "For X Selections/Clipboard") set-selection-coding-system
:visible (display-selections-p)
- :help "How to en/decode data to/from selection/clipboard"))
+ :help ,(purecopy "How to en/decode data to/from selection/clipboard")))
(define-key-after map [set-next-selection-coding-system]
- '(menu-item "For Next X Selection" set-next-selection-coding-system
+ `(menu-item ,(purecopy "For Next X Selection") set-next-selection-coding-system
:visible (display-selections-p)
- :help "How to en/decode next selection/clipboard operation"))
+ :help ,(purecopy "How to en/decode next selection/clipboard operation")))
(define-key-after map [set-buffer-process-coding-system]
- '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
+ `(menu-item ,(purecopy "For I/O with Subprocess") set-buffer-process-coding-system
:visible (fboundp 'start-process)
:enable (get-buffer-process (current-buffer))
- :help "How to en/decode I/O from/to subprocess connected to this buffer"))
+ :help ,(purecopy "How to en/decode I/O from/to subprocess connected to this buffer")))
map))
(defvar mule-menu-keymap
(let ((map (make-sparse-keymap "Mule (Multilingual Environment)")))
(define-key-after map [set-language-environment]
- `(menu-item "Set Language Environment" ,setup-language-environment-map))
- (define-key-after map [separator-mule] '("--"))
+ `(menu-item ,(purecopy "Set Language Environment") ,setup-language-environment-map))
+ (define-key-after map [separator-mule] menu-bar-separator)
(define-key-after map [toggle-input-method]
- '(menu-item "Toggle Input Method" toggle-input-method))
+ `(menu-item ,(purecopy "Toggle Input Method") toggle-input-method))
(define-key-after map [set-input-method]
- '(menu-item "Select Input Method..." set-input-method))
+ `(menu-item ,(purecopy "Select Input Method...") set-input-method))
(define-key-after map [describe-input-method]
- '(menu-item "Describe Input Method" describe-input-method))
- (define-key-after map [separator-input-method] '("--"))
+ `(menu-item ,(purecopy "Describe Input Method") describe-input-method))
+ (define-key-after map [separator-input-method] menu-bar-separator)
(define-key-after map [set-various-coding-system]
- `(menu-item "Set Coding Systems" ,set-coding-system-map
+ `(menu-item ,(purecopy "Set Coding Systems") ,set-coding-system-map
:enable (default-value 'enable-multibyte-characters)))
(define-key-after map [view-hello-file]
- '(menu-item "Show Multi-lingual Text" view-hello-file
+ `(menu-item ,(purecopy "Show Multi-lingual Text") view-hello-file
:enable (file-readable-p
(expand-file-name "HELLO" data-directory))
- :help "Display file which says HELLO in many languages"))
- (define-key-after map [separator-coding-system] '("--"))
+ :help ,(purecopy "Display file which says HELLO in many languages")))
+ (define-key-after map [separator-coding-system] menu-bar-separator)
(define-key-after map [describe-language-environment]
- (list 'menu-item "Describe Language Environment"
+ `(menu-item ,(purecopy "Describe Language Environment")
describe-language-environment-map
- :help "Show multilingual settings for a specific language"))
+ :help ,(purecopy "Show multilingual settings for a specific language")))
(define-key-after map [describe-input-method]
- '(menu-item "Describe Input Method..." describe-input-method
- :help "Keyboard layout for a specific input method"))
+ `(menu-item ,(purecopy "Describe Input Method...") describe-input-method
+ :help ,(purecopy "Keyboard layout for a specific input method")))
(define-key-after map [describe-coding-system]
- '(menu-item "Describe Coding System..." describe-coding-system))
+ `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system))
(define-key-after map [list-character-sets]
- '(menu-item "List Character Sets" list-character-sets
- :help "Show table of available character sets"))
+ `(menu-item ,(purecopy "List Character Sets") list-character-sets
+ :help ,(purecopy "Show table of available character sets")))
(define-key-after map [mule-diag]
- '(menu-item "Show All of Mule Status" mule-diag
- :help "Display multilingual environment settings"))
+ `(menu-item ,(purecopy "Show All of Mule Status") mule-diag
+ :help ,(purecopy "Display multilingual environment settings")))
map)
"Keymap for Mule (Multilingual environment) menu specific commands.")
;; and delimiter characters. Support function of
;; coding-system-from-name.
(defun canonicalize-coding-system-name (name)
- (if (string-match "^iso[-_ ]?[0-9]" name)
- ;; "iso-8859-1" -> "8859-1", "iso-2022-jp" ->"2022-jp"
- (setq name (substring name (1- (match-end 0)))))
- (let ((idx (string-match "[-_ /]" name)))
- ;; Delete "-", "_", " ", "/" but do distinguish "16-be" and "16be".
- (while idx
- (if (and (>= idx 2)
- (eq (string-match "16-[lb]e$" name (- idx 2))
- (- idx 2)))
- (setq idx (string-match "[-_ /]" name (match-end 0)))
- (setq name (concat (substring name 0 idx) (substring name (1+ idx)))
- idx (string-match "[-_ /]" name idx))))
- name))
+ (if (string-match "^\\(ms\\|ibm\\|windows-\\)\\([0-9]+\\)$" name)
+ ;; "ms950", "ibm950", "windows-950" -> "cp950"
+ (concat "cp" (match-string 2 name))
+ (if (string-match "^iso[-_ ]?[0-9]" name)
+ ;; "iso-8859-1" -> "8859-1", "iso-2022-jp" ->"2022-jp"
+ (setq name (substring name (1- (match-end 0)))))
+ (let ((idx (string-match "[-_ /]" name)))
+ ;; Delete "-", "_", " ", "/" but do distinguish "16-be" and "16be".
+ (while idx
+ (if (and (>= idx 2)
+ (eq (string-match "16-[lb]e$" name (- idx 2))
+ (- idx 2)))
+ (setq idx (string-match "[-_ /]" name (match-end 0)))
+ (setq name (concat (substring name 0 idx) (substring name (1+ idx)))
+ idx (string-match "[-_ /]" name idx))))
+ name)))
(defun coding-system-from-name (name)
"Return a coding system whose name matches with NAME (string or symbol)."
default-coding-system))
(if (and auto-cs (not no-other-defaults))
- ;; If the file has a coding cookie, try to use it before anything
- ;; else (i.e. before default-coding-system which will typically come
- ;; from file-coding-system-alist).
+ ;; If the file has a coding cookie, use it regardless of any
+ ;; other setting.
(let ((base (coding-system-base auto-cs)))
- (or (memq base '(nil undecided))
- (rassq base default-coding-system)
- (push (cons auto-cs base) default-coding-system))))
+ (unless (memq base '(nil undecided))
+ (setq default-coding-system (list (cons auto-cs base)))
+ (setq no-other-defaults t))))
(unless no-other-defaults
;; If buffer-file-coding-system is not nil nor undecided, append it
Describe Language Environment and Set Language Environment menus.
For example, (\"European\") means to put this language environment
in the European submenu in each of those two menus."
- (if (symbolp lang-env)
- (setq lang-env (symbol-name lang-env)))
+ (cond ((symbolp lang-env)
+ (setq lang-env (symbol-name lang-env)))
+ ((stringp lang-env)
+ (setq lang-env (purecopy lang-env))))
(let ((describe-map describe-language-environment-map)
(setup-map setup-language-environment-map))
(if parents
in the format of Lisp expression for registering each input method.
Emacs loads this file at startup time.")
-(defvar leim-list-header (format
+(defconst leim-list-header (format
";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
;;
;; This file is automatically generated.
leim-list-file-name)
"Header to be inserted in LEIM list file.")
-(defvar leim-list-entry-regexp "^(register-input-method"
+(defconst leim-list-entry-regexp "^(register-input-method"
"Regexp matching head of each entry in LEIM list file.
See also the variable `leim-list-header'.")
Each element has the form:
(INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...)
See the function `register-input-method' for the meanings of the elements.")
-;; Autoload if this file no longer dumped.
+;;;###autoload
(put 'input-method-alist 'risky-local-variable t)
(defun register-input-method (input-method lang-env &rest args)
without loading the relevant Quail packages.
\n(fn INPUT-METHOD LANG-ENV ACTIVATE-FUNC TITLE DESCRIPTION &rest ARGS)"
(if (symbolp lang-env)
- (setq lang-env (symbol-name lang-env)))
+ (setq lang-env (symbol-name lang-env))
+ (setq lang-env (purecopy lang-env)))
(if (symbolp input-method)
- (setq input-method (symbol-name input-method)))
+ (setq input-method (symbol-name input-method))
+ (setq input-method (purecopy input-method)))
+ (setq args (mapcar 'purecopy args))
(let ((info (cons lang-env args))
(slot (assoc input-method input-method-alist)))
(if slot
(help-setup-xref (list #'describe-language-environment language-name)
(called-interactively-p 'interactive))
(with-output-to-temp-buffer (help-buffer)
- (save-excursion
- (set-buffer standard-output)
+ (with-current-buffer standard-output
(insert language-name " language environment\n\n")
(if (stringp doc)
(insert doc "\n\n"))
(error "Invalid char-table: %s" table))
(or (stringp table)
(error "Not a char-table nor a file name: %s" table)))
+ (if (stringp table) (setq table (purecopy table)))
(let ((slot (assq name char-code-property-alist)))
(if slot
(setcdr slot table)
(setq char-code-property-alist
(cons (cons name table) char-code-property-alist))))
- (put name 'char-code-property-documentation docstring))
+ (put name 'char-code-property-documentation (purecopy docstring)))
(defvar char-code-property-table
(make-char-table 'char-code-property-table)
;; Pretty description of encoded string
;; Alist of ISO 2022 control code vs the corresponding mnemonic string.
-(defvar iso-2022-control-alist
+(defconst iso-2022-control-alist
'((?\x1b . "ESC")
(?\x0e . "SO")
(?\x0f . "SI")
(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-with-progress-reporter (c #xEFFFF)
- "Loading Unicode character names..."
- (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 Extensions B, C
- )
- (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))))
+ (let ((bmp-ranges
+ '((#x0000 . #x33FF)
+ ;; (#x3400 . #x4DBF) CJK Ideograph Extension A
+ (#x4DC0 . #x4DFF)
+ ;; (#x4E00 . #x9FFF) CJK Ideograph
+ (#xA000 . #x0D7FF)
+ ;; (#xD800 . #xFAFF) Surrogate/Private
+ (#xFB00 . #xFFFD)))
+ (upper-ranges
+ '((#x10000 . #x134FF)
+ ;; (#x13500 . #x1CFFF) unused
+ (#x1D000 . #x1FFFF)
+ ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused
+ (#xE0000 . #xE01FF)))
+ (gc-cons-threshold 10000000)
+ c end name names)
+ (dolist (range bmp-ranges)
+ (setq c (car range)
+ end (cdr range))
+ (while (<= c end)
+ (if (setq name (get-char-code-property c 'name))
+ (push (cons name c) names))
+ (if (setq name (get-char-code-property c 'old-name))
+ (push (cons name c) names))
+ (setq c (1+ c))))
+ (dolist (range upper-ranges)
+ (setq c (car range)
+ end (cdr range))
+ (while (<= c end)
+ (if (setq name (get-char-code-property c 'name))
+ (push (cons name c) names))
+ (setq c (1+ c))))
+ (setq ucs-names names))))
(defvar ucs-completions (lazy-completion-table ucs-completions ucs-names)
"Lazy completion table for completing on Unicode character names.")
HCoop / bpt / emacs.git / blobdiff