;;; 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.
+;; Copyright (C) 1997-2011 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, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Copyright (C) 2003
;;; Code:
+(eval-when-compile (require 'cl)) ; letf
+
(defvar dos-codepage)
(autoload 'widget-value "wid-edit")
(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]
- (list 'menu-item "Set Coding Systems" set-coding-system-map
- :enable 'default-enable-multibyte-characters))
+ `(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"
- describe-language-environment-map
- :help "Show multilingual settings for a specific language"))
+ `(menu-item ,(purecopy "Describe Language Environment")
+ ,describe-language-environment-map
+ :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)."
"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)
- (coding-system-for-read 'iso-2022-7bit))
+ (letf ((coding-system-for-read 'iso-2022-7bit))
(view-file (expand-file-name "HELLO" data-directory))))
(defun universal-coding-system-argument (coding-system)
(if (eq system-type 'darwin)
;; The file-name coding system on Darwin systems is always utf-8.
(setq default-file-name-coding-system 'utf-8)
- (if (and default-enable-multibyte-characters
+ (if (and (default-value 'enable-multibyte-characters)
(or (not coding-system)
(coding-system-get coding-system 'ascii-compatible-p)))
(setq default-file-name-coding-system coding-system)))
(let ((base (coding-system-base coding-system))
(eol-type (coding-system-eol-type coding-system)))
(set-coding-system-priority base)
- (and (interactive-p)
+ (and (called-interactively-p 'interactive)
(or (eq base coding-system)
(message "Highest priority is set to %s (base of %s)"
base coding-system)))
proper one is suggested as the default.
The list of `buffer-file-coding-system' of the current buffer, the
-`default-buffer-file-coding-system', and the most preferred coding
+default `buffer-file-coding-system', and the most preferred coding
system (if it corresponds to a MIME charset) is treated as the
default coding system list. Among them, the first one that safely
encodes the text is normally selected silently and returned without
list of coding systems to be prepended to the default coding system
list. However, if DEFAULT-CODING-SYSTEM is a list and the first
element is t, the cdr part is used as the default coding system list,
-i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
+i.e. current `buffer-file-coding-system', default `buffer-file-coding-system',
and the most preferred coding system are not used.
Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to
(let ((no-other-defaults nil)
auto-cs)
(unless (or (stringp from) find-file-literally)
- ;; Find an auto-coding that is specified for the the current
+ ;; Find an auto-coding that is specified for the current
;; buffer and file from the region FROM and TO.
(save-excursion
(save-restriction
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
(unless (and buffer-file-coding-system-explicit
(cdr buffer-file-coding-system-explicit))
- ;; If default-buffer-file-coding-system is not nil nor undecided,
+ ;; If default buffer-file-coding-system is not nil nor undecided,
;; append it to the defaults.
- (if default-buffer-file-coding-system
- (let ((base (coding-system-base default-buffer-file-coding-system)))
- (or (eq base 'undecided)
- (rassq base default-coding-system)
- (setq default-coding-system
- (append default-coding-system
- (list (cons default-buffer-file-coding-system
- base)))))))
+ (when (default-value 'buffer-file-coding-system)
+ (let ((base (coding-system-base
+ (default-value 'buffer-file-coding-system))))
+ (or (eq base 'undecided)
+ (rassq base default-coding-system)
+ (setq default-coding-system
+ (append default-coding-system
+ (list (cons (default-value
+ 'buffer-file-coding-system)
+ base)))))))
;; If the most preferred coding system has the property mime-charset,
;; append it to the defaults.
(setq accept-default-p select-safe-coding-system-accept-default-p))
;; Decide the eol-type from the top of the default codings,
- ;; buffer-file-coding-system, or
- ;; default-buffer-file-coding-system.
+ ;; current buffer-file-coding-system, or default buffer-file-coding-system.
(if default-coding-system
(let ((default-eol-type (coding-system-eol-type
(caar default-coding-system))))
(if (and (vectorp default-eol-type) buffer-file-coding-system)
(setq default-eol-type (coding-system-eol-type
buffer-file-coding-system)))
- (if (and (vectorp default-eol-type) default-buffer-file-coding-system)
- (setq default-eol-type (coding-system-eol-type
- default-buffer-file-coding-system)))
+ (if (and (vectorp default-eol-type)
+ (default-value 'buffer-file-coding-system))
+ (setq default-eol-type
+ (coding-system-eol-type
+ (default-value 'buffer-file-coding-system))))
(if (and default-eol-type (not (vectorp default-eol-type)))
(dolist (elt default-coding-system)
(setcar elt (coding-system-change-eol-conversion
(1) local value of `buffer-file-coding-system'
(2) value of `sendmail-coding-system'
(3) value of `default-sendmail-coding-system'
- (4) value of `default-buffer-file-coding-system'
+ (4) default value of `buffer-file-coding-system'
If the found coding system can't encode the current buffer,
or none of them are bound to a coding system,
it asks the user to select a proper coding system."
buffer-file-coding-system)
sendmail-coding-system
default-sendmail-coding-system
- default-buffer-file-coding-system)))
+ (default-value 'buffer-file-coding-system))))
(if (eq coding 'no-conversion)
;; We should never use no-conversion for outgoing mail.
(setq coding nil))
in extended segments of CTEXT. See the variable
`ctext-non-standard-encodings' for more detail.
-The following keys take effect only when multibyte characters are
-globally disabled, i.e. the value of `default-enable-multibyte-characters'
-is nil.
+The following key takes effect only when multibyte characters are
+globally disabled, i.e. the default value of `enable-multibyte-characters'
+is nil (which is an obsolete and deprecated use):
unibyte-display value is a coding system to encode characters for
the terminal. Characters in the range of 160 to
(set-language-environment-nonascii-translation lang-env))
((eq key 'charset)
(set-language-environment-charset lang-env))
- ((and (not default-enable-multibyte-characters)
+ ((and (not (default-value 'enable-multibyte-characters))
(or (eq key 'unibyte-syntax) (eq key 'unibyte-display)))
(set-language-environment-unibyte lang-env)))))
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
+(put 'input-method-alist 'risky-local-variable t)
(defun register-input-method (input-method lang-env &rest args)
"Register INPUT-METHOD as an input method for language environment LANG-ENV.
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
(setq input-method (symbol-name input-method)))
(help-setup-xref (list #'describe-input-method
(or input-method current-input-method))
- (interactive-p))
+ (called-interactively-p 'interactive))
(if (null input-method)
(describe-current-input-method)
(error
(activate-input-method current)
(help-setup-xref (list #'describe-input-method input-method)
- (interactive-p))
+ (called-interactively-p 'interactive))
(with-output-to-temp-buffer (help-buffer)
(let ((elt (assoc input-method input-method-alist)))
(princ (format
(set-language-environment-nonascii-translation language-name)
(set-language-environment-charset language-name)
;; Unibyte setups if necessary.
- (unless default-enable-multibyte-characters
+ (unless (default-value 'enable-multibyte-characters)
(set-language-environment-unibyte language-name))
(let ((func (get-language-info language-name 'setup-function)))
;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with
;; the native font, and codes 160 and 146 stand for something very
;; different there.
- (or (and (eq window-system 'pc) (not default-enable-multibyte-characters))
+ (or (and (eq window-system 'pc) (not (default-value
+ 'enable-multibyte-characters)))
(progn
;; Most X fonts used to do the wrong thing for latin-1 code 160.
(unless (and (eq window-system 'x)
(> (aref (number-to-string (nth 2 (x-server-version))) 0)
?3))
;; Make non-line-break space display as a plain space.
- (aset standard-display-table 160 [32]))
+ (aset standard-display-table (unibyte-char-to-multibyte 160) [32]))
;; Most Windows programs send out apostrophes as \222. Most X fonts
;; don't contain a character at that position. Map it to the ASCII
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
;; fonts probably have the appropriate glyph at this position,
;; so they could use standard-display-8bit. It's better to use a
;; proper windows-1252 coding system. --fx]
- (aset standard-display-table 146 [39]))))
+ (aset standard-display-table (unibyte-char-to-multibyte 146) [39]))))
(defun set-language-environment-coding-systems (language-name)
"Do various coding system setups for language environment LANGUAGE-NAME."
(let* ((priority (get-language-info language-name 'coding-priority))
(default-coding (car priority))
- ;; If default-buffer-file-coding-system is nil, don't use
+ ;; If the default buffer-file-coding-system is nil, don't use
;; coding-system-eol-type, because it treats nil as
- ;; `no-conversion'. default-buffer-file-coding-system is set
+ ;; `no-conversion'. The default buffer-file-coding-system is set
;; to nil by reset-language-environment, and in that case we
;; want to have here the native EOL type for each platform.
;; FIXME: there should be a common code that runs both on
;; which works only as long as the order of loading files at
;; dump time and calling functions at startup is not modified
;; significantly, i.e. as long as this function is called
- ;; _after_ default-buffer-file-coding-system was set by
+ ;; _after_ the default buffer-file-coding-system was set by
;; dos-w32.el.
(eol-type
- (if (null default-buffer-file-coding-system)
- (cond ((memq system-type '(windows-nt ms-dos)) 1)
- ((eq system-type 'macos) 2)
- (t 0))
- (coding-system-eol-type default-buffer-file-coding-system))))
+ (coding-system-eol-type
+ (or (default-value 'buffer-file-coding-system)
+ (if (memq system-type '(windows-nt ms-dos)) 'dos 'unix)))))
(when priority
(set-default-coding-systems
(if (memq eol-type '(0 1 2 unix dos mac))
"Do various unibyte-mode setups for language environment LANGUAGE-NAME."
(set-display-table-and-terminal-coding-system language-name))
-(defsubst princ-list (&rest args)
+(defun princ-list (&rest args)
"Print all arguments with `princ', then print \"\\n\"."
- (while args (princ (car args)) (setq args (cdr args)))
+ (mapc #'princ args)
(princ "\n"))
+(make-obsolete 'princ-list "use mapc and princ instead" "23.3")
(put 'describe-specified-language-support 'apropos-inhibit t)
(require feature))
(let ((doc (get-language-info language-name 'documentation)))
(help-setup-xref (list #'describe-language-environment language-name)
- (interactive-p))
+ (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"))
("af" . "Latin-1") ; Afrikaans
("am" "Ethiopic" utf-8) ; Amharic
("an" . "Latin-9") ; Aragonese
- ; ar Arabic glibc uses 8859-6
+ ("ar" . "Arabic")
; as Assamese
; ay Aymara
("az" . "UTF-8") ; Azerbaijani
(charset-language-name
(locale-name-match locale locale-charset-language-names))
(default-eol-type (coding-system-eol-type
- default-buffer-file-coding-system))
+ (default-value 'buffer-file-coding-system)))
(coding-system
(or (locale-name-match locale locale-preferred-coding-systems)
(when locale
(unless frame
(set-language-environment language-name))
- ;; If default-enable-multibyte-characters is nil,
+ ;; If the 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
+ (when (default-value 'enable-multibyte-characters)
(set-display-table-and-terminal-coding-system
language-name coding-system frame))
(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")
:group 'mule
:global t)
-(defvar nonascii-insert-offset 0 "This variable is obsolete.")
-(defvar nonascii-translation-table nil "This variable is obsolete.")
+(defvar nonascii-insert-offset 0)
+(make-obsolete-variable 'nonascii-insert-offset "do not use it." "23.1")
+(defvar nonascii-translation-table nil)
+(make-obsolete-variable 'nonascii-translation-table "do not use it." "23.1")
(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-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 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))))
+ (let ((bmp-ranges
+ '((#x0000 . #x33FF)
+ ;; (#x3400 . #x4DBF) CJK Ideographs Extension A
+ (#x4DC0 . #x4DFF)
+ ;; (#x4E00 . #x9FFF) CJK Unified Ideographs
+ (#xA000 . #xD7FF)
+ ;; (#xD800 . #xFAFF) Surrogate/Private
+ (#xFB00 . #xFFFD)))
+ (upper-ranges
+ '((#x10000 . #x134FF)
+ ;; (#x13500 . #x167FF) unused
+ (#x16800 . #x16A3F)
+ ;; (#x16A40 . #x1AFFF) unused
+ (#x1B000 . #x1B0FF)
+ ;; (#x1B100 . #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.")
(t
(cdr (assoc-string input (ucs-names) t))))))
-(defun ucs-insert (arg)
- "Insert a character of the given Unicode code point.
+(defun ucs-insert (character &optional count inherit)
+ "Insert COUNT copies of CHARACTER of the given Unicode code point.
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)))
+using `read-char-by-name'.
+The optional third arg INHERIT (non-nil when called interactively),
+says to inherit text properties from adjoining text, if those
+properties are sticky."
+ (interactive
+ (list (read-char-by-name "Unicode (name or hex): ")
+ (prefix-numeric-value current-prefix-arg)
+ t))
+ (unless count (setq count 1))
+ (if (stringp character)
+ (setq character (string-to-number character 16)))
(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))
+ ((not (integerp character))
+ (error "Not a Unicode character code: %S" character))
+ ((or (< character 0) (> character #x10FFFF))
+ (error "Not a Unicode character code: 0x%X" character)))
+ (if inherit
+ (dotimes (i count) (insert-and-inherit character))
+ (dotimes (i count) (insert character))))
(define-key ctl-x-map "8\r" 'ucs-insert)
-;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
;;; mule-cmds.el ends here