;;; 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, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008
+;; 2005, 2006, 2007, 2008, 2009, 2010
;; 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"))
+(eval-when-compile (require 'cl)) ; letf
+
+(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)
+(defvar mule-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "f" 'set-buffer-file-coding-system)
+ (define-key map "r" 'revert-buffer-with-coding-system)
+ (define-key map "F" 'set-file-name-coding-system)
+ (define-key map "t" 'set-terminal-coding-system)
+ (define-key map "k" 'set-keyboard-coding-system)
+ (define-key map "p" 'set-buffer-process-coding-system)
+ (define-key map "x" 'set-selection-coding-system)
+ (define-key map "X" 'set-next-selection-coding-system)
+ (define-key map "\C-\\" 'set-input-method)
+ (define-key map "c" 'universal-coding-system-argument)
+ (define-key map "l" 'set-language-environment)
+ map)
"Keymap for Mule (Multilingual environment) specific commands.")
;; Keep "C-x C-m ..." for mule specific commands.
(define-key ctl-x-map "\C-m" mule-keymap)
-(define-key mule-keymap "f" 'set-buffer-file-coding-system)
-(define-key mule-keymap "r" 'revert-buffer-with-coding-system)
-(define-key mule-keymap "F" 'set-file-name-coding-system)
-(define-key mule-keymap "t" 'set-terminal-coding-system)
-(define-key mule-keymap "k" 'set-keyboard-coding-system)
-(define-key mule-keymap "p" 'set-buffer-process-coding-system)
-(define-key mule-keymap "x" 'set-selection-coding-system)
-(define-key mule-keymap "X" 'set-next-selection-coding-system)
-(define-key mule-keymap "\C-\\" 'set-input-method)
-(define-key mule-keymap "c" 'universal-coding-system-argument)
-(define-key mule-keymap "l" 'set-language-environment)
-
-(defvar mule-menu-keymap
- (make-sparse-keymap "Mule (Multilingual Environment)")
- "Keymap for Mule (Multilingual environment) menu specific commands.")
-
(defvar describe-language-environment-map
- (make-sparse-keymap "Describe Language Environment"))
+ (let ((map (make-sparse-keymap "Describe Language Environment")))
+ (define-key map
+ [Default] `(menu-item ,(purecopy "Default") describe-specified-language-support))
+ map))
(defvar setup-language-environment-map
- (make-sparse-keymap "Set Language Environment"))
+ (let ((map (make-sparse-keymap "Set Language Environment")))
+ (define-key map
+ [Default] `(menu-item ,(purecopy "Default") setup-specified-language-environment))
+ map))
(defvar set-coding-system-map
- (make-sparse-keymap "Set Coding System"))
-
-(define-key-after mule-menu-keymap [set-language-environment]
- (list 'menu-item "Set Language Environment" setup-language-environment-map))
-(define-key-after mule-menu-keymap [separator-mule]
- '("--")
- t)
-(define-key-after mule-menu-keymap [toggle-input-method]
- '(menu-item "Toggle Input Method" toggle-input-method)
- t)
-(define-key-after mule-menu-keymap [set-input-method]
- '(menu-item "Select Input Method..." set-input-method)
- t)
-(define-key-after mule-menu-keymap [describe-input-method]
- '(menu-item "Describe Input Method" describe-input-method))
-(define-key-after mule-menu-keymap [separator-input-method]
- '("--")
- t)
-(define-key-after mule-menu-keymap [set-various-coding-system]
- (list 'menu-item "Set Coding Systems" set-coding-system-map
- :enable 'default-enable-multibyte-characters))
-(define-key-after mule-menu-keymap [view-hello-file]
- '(menu-item "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")
- t)
-(define-key-after mule-menu-keymap [separator-coding-system]
- '("--")
- t)
-(define-key-after mule-menu-keymap [describe-language-environment]
- (list 'menu-item "Describe Language Environment"
- describe-language-environment-map
- :help "Show multilingual settings for a specific language")
- t)
-(define-key-after mule-menu-keymap [describe-input-method]
- '(menu-item "Describe Input Method..." describe-input-method
- :help "Keyboard layout for a specific input method")
- t)
-(define-key-after mule-menu-keymap [describe-coding-system]
- '(menu-item "Describe Coding System..." describe-coding-system)
- t)
-(define-key-after mule-menu-keymap [list-character-sets]
- '(menu-item "List Character Sets" list-character-sets
- :help "Show table of available character sets"))
-(define-key-after mule-menu-keymap [mule-diag]
- '(menu-item "Show All of Mule Status" mule-diag
- :help "Display multilingual environment settings")
- t)
-
-(define-key-after set-coding-system-map [universal-coding-system-argument]
- '(menu-item "For Next Command" universal-coding-system-argument
- :help "Coding system to be used by next command")
- t)
-(define-key-after set-coding-system-map [separator-1]
- '("--")
- t)
-(define-key-after set-coding-system-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")
- t)
-(define-key-after set-coding-system-map [revert-buffer-with-coding-system]
- '(menu-item "For Reverting This File Now" revert-buffer-with-coding-system
- :enable buffer-file-name
- :help "Revisit this file immediately using specified coding system")
- t)
-(define-key-after set-coding-system-map [set-file-name-coding-system]
- '(menu-item "For File Name" set-file-name-coding-system
- :help "How to decode/encode file names")
- t)
-(define-key-after set-coding-system-map [separator-2]
- '("--")
- t)
-
-(define-key-after set-coding-system-map [set-keyboard-coding-system]
- '(menu-item "For Keyboard" set-keyboard-coding-system
- :help "How to decode keyboard input")
- 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)))
- :help "How to encode terminal output")
- t)
-(define-key-after set-coding-system-map [separator-3]
- '("--")
- t)
-(define-key-after set-coding-system-map [set-selection-coding-system]
- '(menu-item "For X Selections/Clipboard" set-selection-coding-system
- :visible (display-selections-p)
- :help "How to en/decode data to/from selection/clipboard")
- t)
-(define-key-after set-coding-system-map [set-next-selection-coding-system]
- '(menu-item "For Next X Selection" set-next-selection-coding-system
- :visible (display-selections-p)
- :help "How to en/decode next selection/clipboard operation")
- t)
-(define-key-after set-coding-system-map [set-buffer-process-coding-system]
- '(menu-item "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")
- t)
-
-
-(define-key setup-language-environment-map
- [Default] '(menu-item "Default" setup-specified-language-environment))
-
-(define-key describe-language-environment-map
- [Default] '(menu-item "Default" describe-specified-language-support))
+ (let ((map (make-sparse-keymap "Set Coding System")))
+ (define-key-after map [universal-coding-system-argument]
+ `(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 ,(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 ,(purecopy "For Reverting This File Now")
+ revert-buffer-with-coding-system
+ :enable buffer-file-name
+ :help ,(purecopy "Revisit this file immediately using specified coding system")))
+ (define-key-after map [set-file-name-coding-system]
+ `(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 ,(purecopy "For Keyboard") set-keyboard-coding-system
+ :help ,(purecopy "How to decode keyboard input")))
+ (define-key-after map [set-terminal-coding-system]
+ `(menu-item ,(purecopy "For Terminal") set-terminal-coding-system
+ :enable (null (memq initial-window-system '(x w32 ns)))
+ :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 ,(purecopy "For X Selections/Clipboard") set-selection-coding-system
+ :visible (display-selections-p)
+ :help ,(purecopy "How to en/decode data to/from selection/clipboard")))
+ (define-key-after map [set-next-selection-coding-system]
+ `(menu-item ,(purecopy "For Next X Selection") set-next-selection-coding-system
+ :visible (display-selections-p)
+ :help ,(purecopy "How to en/decode next selection/clipboard operation")))
+ (define-key-after map [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 ,(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 ,(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 ,(purecopy "Toggle Input Method") toggle-input-method))
+ (define-key-after map [set-input-method]
+ `(menu-item ,(purecopy "Select Input Method...") set-input-method))
+ (define-key-after map [describe-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 ,(purecopy "Set Coding Systems") ,set-coding-system-map
+ :enable (default-value 'enable-multibyte-characters)))
+ (define-key-after map [view-hello-file]
+ `(menu-item ,(purecopy "Show Multi-lingual Text") view-hello-file
+ :enable (file-readable-p
+ (expand-file-name "HELLO" data-directory))
+ :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]
+ `(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 ,(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 ,(purecopy "Describe Coding System...") describe-coding-system))
+ (define-key-after map [list-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 ,(purecopy "Show All of Mule Status") mule-diag
+ :help ,(purecopy "Display multilingual environment settings")))
+ map)
+ "Keymap for Mule (Multilingual environment) menu specific commands.")
;; This should be a single character key binding because users use it
;; very frequently while editing multilingual text. Now we can use
(if coding coding 'undecided)
(if (numberp eol-type) (aref [unix dos mac] eol-type)))))
+;; Canonicalize the coding system name NAME by removing some prefixes
+;; 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))
+
+(defun coding-system-from-name (name)
+ "Return a coding system whose name matches with NAME (string or symbol)."
+ (let (sym)
+ (if (stringp name) (setq sym (intern name))
+ (setq sym name name (symbol-name name)))
+ (if (coding-system-p sym)
+ sym
+ (let ((eol-type
+ (if (string-match "-\\(unix\\|dos\\|mac\\)$" name)
+ (prog1 (intern (match-string 1 name))
+ (setq name (substring name 0 (match-beginning 0)))))))
+ (setq name (canonicalize-coding-system-name (downcase name)))
+ (catch 'tag
+ (dolist (elt (coding-system-list))
+ (if (string= (canonicalize-coding-system-name (symbol-name elt))
+ name)
+ (throw 'tag (if eol-type (coding-system-change-eol-conversion
+ elt eol-type)
+ elt)))))))))
+
(defun toggle-enable-multibyte-characters (&optional arg)
"Change whether this buffer uses multibyte characters.
-With arg, use multibyte characters if the arg is positive.
+With ARG, use multibyte characters if the ARG is positive.
Note that this command does not convert the byte contents of
the buffer; it only changes the way those bytes are interpreted.
(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)
- (coding-system-for-read 'iso-2022-7bit))
- (view-file (expand-file-name "HELLO" data-directory))))
+ (letf (((default-value 'enable-multibyte-characters) t)
+ (coding-system-for-read 'iso-2022-7bit))
+ (view-file (expand-file-name "HELLO" data-directory))))
(defun universal-coding-system-argument (coding-system)
"Execute an I/O command using the specified coding system."
(format "Command to execute with %s:" coding-system)))
(cmd (key-binding keyseq))
prefix)
-
- (when (eq cmd 'universal-argument)
+ ;; read-key-sequence ignores quit, so make an explicit check.
+ ;; Like many places, this assumes quit == C-g, but it need not be.
+ (if (equal last-input-event ?\C-g)
+ (keyboard-quit))
+ (when (memq cmd '(universal-argument digit-argument))
(call-interactively cmd)
;; Process keys bound in `universal-argument-map'.
cmd (key-binding keyseq t))
(not (eq cmd 'universal-argument-other-key)))
(let ((current-prefix-arg prefix-arg)
- ;; Have to bind `last-command-char' here so that
+ ;; Have to bind `last-command-event' here so that
;; `digit-argument', for instance, can compute the
;; prefix arg.
- (last-command-char (aref keyseq 0)))
+ (last-command-event (aref keyseq 0)))
(call-interactively cmd)))
;; This is the final call to `universal-argument-other-key', which
This also sets the following values:
o default value used as `file-name-coding-system' for converting file names
if CODING-SYSTEM is ASCII-compatible
- o default value for the command `set-terminal-coding-system' (not on MSDOS)
+ o default value for the command `set-terminal-coding-system'
o default value for the command `set-keyboard-coding-system'
if CODING-SYSTEM is ASCII-compatible"
(check-coding-system 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)))
- ;; If coding-system is nil, honor that on MS-DOS as well, so
- ;; that they could reset the terminal coding system.
- (unless (and (eq window-system 'pc) coding-system)
- (setq default-terminal-coding-system coding-system))
+ (setq default-terminal-coding-system coding-system)
(setq default-keyboard-coding-system coding-system)
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
o default coding system for subprocess I/O
This also sets the following values:
o default value used as `file-name-coding-system' for converting file names
- o default value for the command `set-terminal-coding-system' (not on MSDOS)
+ o default value for the command `set-terminal-coding-system'
o default value for the command `set-keyboard-coding-system'
If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
systems set by this function will use that type of EOL conversion.
-This command does not change the default value of terminal coding system
-for MS-DOS terminal, because DOS terminals only support a single coding
-system, and Emacs automatically sets the default to that coding system at
-startup.
-
-A coding system that requires automatic detection of text
-+encoding (e.g. undecided, unix) can't be preferred.."
+A coding system that requires automatic detection of text+encoding
+\(e.g. undecided, unix) can't be preferred."
(interactive "zPrefer coding system: ")
(if (not (and coding-system (coding-system-p coding-system)))
(error "Invalid coding system `%s'" 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)))
;; Lower utf-16 priority so that we
;; normally prefer utf-8 to it, and put
;; x-ctext below that.
- (cond ((string-match "utf-16"
- (symbol-name mime))
+ (cond ((string-match-p "utf-16"
+ (symbol-name mime))
2)
- ((string-match "^x-" (symbol-name mime))
+ ((string-match-p "^x-" (symbol-name mime))
1)
(t 3))
0))
5)
(lsh (if (memq base lang-preferred) 1 0) 4)
(lsh (if (memq base from-priority) 1 0) 3)
- (lsh (if (string-match "-with-esc\\'"
- (symbol-name base))
+ (lsh (if (string-match-p "-with-esc\\'"
+ (symbol-name base))
0 1) 2)
(if (eq (coding-system-type base) 'iso-2022)
(let ((category (coding-system-category base)))
This only finds coding systems of type `charset', whose
`:charset-list' property includes all of CHARSETS (plus `ascii' for
-ascii-compatible coding systems). It was used in older versions of
+ASCII-compatible coding systems). It was used in older versions of
Emacs, but is unlikely to be what you really want now."
;; Deal with aliases.
(setq charsets (mapcar (lambda (c)
(if (stringp from)
(if (multibyte-string-p from)
(let ((idx 0))
- (while (setq idx (string-match "[^\000-\177]" from idx))
+ (while (setq idx (string-match-p "[^\000-\177]" from idx))
(setq char (aref from idx)
charset (char-charset char))
(unless (memq charset excludes)
between FROM and TO are shown in a popup window. Among them, the most
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 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 any user interaction. See also the command
-`prefer-coding-system'.
+The list of `buffer-file-coding-system' of the current buffer, the
+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
+any user interaction. See also the command `prefer-coding-system'.
However, the user is queried if the chosen coding system is
inconsistent with what would be selected by `find-auto-coding' from
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
That is different from `buffer-file-name' when handling `write-region'
\(for example).
-The variable `select-safe-coding-system-accept-default-p', if
-non-nil, overrides ACCEPT-DEFAULT-P.
+The variable `select-safe-coding-system-accept-default-p', if non-nil,
+overrides ACCEPT-DEFAULT-P.
Kludgy feature: if FROM is a string, the string is the target text,
and TO is ignored."
- (if (and default-coding-system
- (not (listp default-coding-system)))
+ (if (not (listp default-coding-system))
(setq default-coding-system (list default-coding-system)))
(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
(if (coding-system-p (car auto-cs))
(setq auto-cs (car auto-cs))
(display-warning
- :warning
+ 'mule
(format "\
Invalid coding system `%s' is specified
for the current buffer/file by the %s.
It is highly recommended to fix it before writing to a file."
(car auto-cs)
(if (eq (cdr auto-cs) :coding) ":coding tag"
- (format "variable `%s'" (cdr auto-cs)))))
+ (format "variable `%s'" (cdr auto-cs))))
+ :warning)
(or (yes-or-no-p "Really proceed with writing? ")
(error "Save aborted"))
(setq auto-cs nil))))))
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
(append default-coding-system
(list (cons buffer-file-coding-system base)))))))
- ;; 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)))))))
-
- ;; If the most preferred coding system has the property mime-charset,
- ;; append it to the defaults.
- (let ((preferred (coding-system-priority-list t))
- base)
- (and (coding-system-p preferred)
- (setq base (coding-system-base preferred))
- (coding-system-get preferred :mime-charset)
- (not (rassq base default-coding-system))
- (setq default-coding-system
- (append default-coding-system
- (list (cons preferred base)))))))
+ (unless (and buffer-file-coding-system-explicit
+ (cdr buffer-file-coding-system-explicit))
+ ;; If default buffer-file-coding-system is not nil nor undecided,
+ ;; append it to the defaults.
+ (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.
+ (let ((preferred (coding-system-priority-list t))
+ base)
+ (and (coding-system-p preferred)
+ (setq base (coding-system-base preferred))
+ (coding-system-get preferred :mime-charset)
+ (not (rassq base default-coding-system))
+ (setq default-coding-system
+ (append default-coding-system
+ (list (cons preferred base))))))))
(if select-safe-coding-system-accept-default-p
(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
(let ((codings (find-coding-systems-region from to))
(coding-system nil)
- (tick (if (not (stringp from)) (buffer-modified-tick)))
+ (tick (if (not (stringp from)) (buffer-chars-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)))
+ (when (and tick (/= tick (buffer-chars-modified-tick)))
(error "Cancelled because the buffer was modified"))
coding-system)))
(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))
language environment.
exit-function value is a function to call to leave this
language environment.
- coding-system value is a list of coding systems that are good
- for saving text written in this language environment.
+ coding-system value is a list of coding systems that are good for
+ saving text written in this language environment.
This list serves as suggestions to the user;
in effect, as a kind of documentation.
coding-priority value is a list of coding systems for this language
features value is a list of features requested in this
language environment.
ctext-non-standard-encodings
- value is a list of non-standard encoding
- names used 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.
-
- unibyte-display value is a coding system to encode characters
- for the terminal. Characters in the range
- of 160 to 255 display not as octal escapes,
- but as non-ASCII characters in this language
- environment.")
+ value is a list of non-standard encoding names used
+ in extended segments of CTEXT. See the variable
+ `ctext-non-standard-encodings' for more detail.
+
+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
+ 255 display not as octal escapes, but as non-ASCII
+ characters in this language environment.")
(defun get-language-info (lang-env key)
"Return information listed under KEY for language environment LANG-ENV.
(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
(downcase parent))))
(define-prefix-command map nil prompt)
(define-key-after describe-map (vector parent-symbol)
- (cons parent map) t)))
+ (cons parent map))))
(setq describe-map (symbol-value map))
(setq map (lookup-key setup-map (vector parent-symbol)))
(if (not map)
(downcase parent))))
(define-prefix-command map nil prompt)
(define-key-after setup-map (vector parent-symbol)
- (cons parent map) t)))
+ (cons parent map))))
(setq setup-map (symbol-value map))
(setq l (cdr l)))))
(let ((doc (assq 'documentation alist)))
(when doc
(define-key-after describe-map (vector (intern lang-env))
- (cons lang-env 'describe-specified-language-support) t)))
+ (cons lang-env 'describe-specified-language-support))))
(define-key-after setup-map (vector (intern lang-env))
- (cons lang-env 'setup-specified-language-environment) t)
+ (cons lang-env 'setup-specified-language-environment))
(dolist (elt alist)
(set-language-info-internal lang-env (car elt) (cdr elt)))
in the format of Lisp expression for registering each input method.
Emacs loads this file at startup time.")
-(defvar leim-list-header (format
-";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: iso-2022-7bit;-*-
+(defconst leim-list-header (format
+";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
+;;
+;; This file is automatically generated.
;;
;; This file contains a list of LEIM (Library of Emacs Input Method)
;; methods in the same directory as this file. Loading this file
;; ARG ...)
;; See the function `register-input-method' for the meanings of the arguments.
;;
-;; If this directory is included in load-path, Emacs automatically
+;; If this directory is included in `load-path', Emacs automatically
;; loads this file at startup time.
"
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'.")
(defun update-leim-list-file (&rest dirs)
"Update LEIM list file in directories DIRS."
- (let ((functions update-leim-list-functions))
- (while functions
- (apply (car functions) dirs)
- (setq functions (cdr functions)))))
+ (dolist (function update-leim-list-functions)
+ (apply function dirs)))
(defvar current-input-method nil
"The current input method for multilingual text.
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
"Enable or disable multilingual text input method for the current buffer.
Only one input method can be enabled at any time in a given buffer.
-The normal action is to enable an input method if none was
-enabled, and disable the current one otherwise. Which input method
-to enable can be determined in various ways--either the one most
-recently used, or the one specified by `default-input-method', or
-as a last resort by reading the name of an input method in the
-minibuffer.
+The normal action is to enable an input method if none was enabled,
+and disable the current one otherwise. Which input method to enable
+can be determined in various ways--either the one most recently used,
+or the one specified by `default-input-method', or as a last resort
+by reading the name of an input method in the minibuffer.
-With a prefix argument, read an input method name with the minibuffer
+With a prefix argument ARG, read an input method name with the minibuffer
and enable that one. The default is the most recent input method specified
\(not including the currently active input method, if any).
-When called interactively, the optional arg INTERACTIVE is non-nil,
+When called interactively, the optional argument INTERACTIVE is non-nil,
which marks the variable `default-input-method' as set for Custom buffers."
(interactive "P\np")
(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."
(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
(defun read-multilingual-string (prompt &optional initial-input input-method)
"Read a multilingual string from minibuffer, prompting with string PROMPT.
The input method selected last time is activated in minibuffer.
-If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer
-initially.
-Optional 3rd argument INPUT-METHOD specifies the input method
-to be activated instead of the one selected last time. It is a symbol
-or a string."
+If optional second argument INITIAL-INPUT is non-nil, insert it in the
+minibuffer initially.
+Optional 3rd argument INPUT-METHOD specifies the input method to be activated
+instead of the one selected last time. It is a symbol or a string."
(setq input-method
(or input-method
current-input-method
"This flag controls when an input method returns.
Usually, the input method does not return while there's a possibility
that it may find a different translation if a user types another key.
-But, if this flag is non-nil, the input method returns as soon as
-the current key sequence gets long enough to have some valid translation.")
+But, if this flag is non-nil, the input method returns as soon as the
+current key sequence gets long enough to have some valid translation.")
(defcustom input-method-use-echo-area nil
"This flag controls how an input method shows an intermediate key sequence.
(setq default-process-coding-system
(cons output-coding input-coding)))
+ ;; Put the highest priority to the charset iso-8859-1 to prefer the
+ ;; registry iso8859-1 over iso8859-2 in font selection. It also
+ ;; makes unibyte-display-via-language-environment to use iso-8859-1
+ ;; as the unibyte charset.
+ (set-charset-priority 'iso-8859-1)
+
;; Don't alter the terminal and keyboard coding systems here.
;; The terminal still supports the same coding system
;; that it supported a minute ago.
;; The following 2 lines undo the 8-bit display that we set up
;; in standard-display-european-internal, which see. This is in
;; case the user has used standard-display-european earlier in
- ;; this session. (The MS-DOS port doesn't use that setup, so it
- ;; doesn't need to undo it.)
+ ;; this session.
(when standard-display-table
(dotimes (i 128)
(aset standard-display-table (+ i 128) nil))))
- (or (eq window-system 'pc)
- (set-terminal-coding-system (or coding-system coding) display))))
+ (set-terminal-coding-system (or coding-system coding) display)))
(defun set-language-environment (language-name)
"Set up multi-lingual environment for using LANGUAGE-NAME.
(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)))
(if (functionp func)
(funcall func)))
+ (setq current-iso639-language
+ (or (get-language-info language-name 'iso639-language)
+ current-iso639-language))
+
(run-hooks 'set-language-environment-hook)
(force-mode-line-update t))
This option is intended for use at startup. Removing items doesn't
remove them from the language info until you next restart Emacs.
-Setting this variable directly does not take effect. See
-`set-language-info-alist' for use in programs."
+Setting this variable directly does not take effect.
+See `set-language-info-alist' for use in programs."
:group 'mule
:version "23.1"
:set (lambda (s v)
(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)
;; 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)
"Do various coding system setups for language environment LANGUAGE-NAME."
(let* ((priority (get-language-info language-name 'coding-priority))
(default-coding (car priority))
- (eol-type (coding-system-eol-type default-buffer-file-coding-system)))
+ ;; If the default buffer-file-coding-system is nil, don't use
+ ;; coding-system-eol-type, because it treats nil as
+ ;; `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
+ ;; startup and here to set the default EOL type correctly.
+ ;; Right now, DOS/Windows platforms set this on dos-w32.el,
+ ;; 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_ the default buffer-file-coding-system was set by
+ ;; dos-w32.el.
+ (eol-type
+ (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))
;; defined.
(let ((nonascii (get-language-info language-name 'nonascii-translation)))
(if (eq window-system 'pc)
- (setq nonascii (intern "cp%d" dos-codepage)))
+ (setq nonascii (intern (format "cp%d" dos-codepage))))
(or (and (charsetp nonascii)
(get-charset-property nonascii :ascii-compatible-p))
(setq nonascii 'iso-8859-1))
;; coding systems of higher priorities in this environment.
(let ((charsets (get-language-info language-name 'charset)))
(dolist (coding (get-language-info language-name 'coding-priority))
- (setq charsets (append charsets (coding-system-charset-list coding))))
+ (let ((list (coding-system-charset-list coding)))
+ (if (consp list)
+ (setq charsets (append charsets list)))))
(if charsets
(apply 'set-charset-priority charsets))))
(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"))
(condition-case nil
(let ((str (eval (get-language-info language-name 'sample-text))))
(if (stringp str)
- (insert "Sample text:\n " str "\n\n")))
+ (insert "Sample text:\n "
+ (replace-regexp-in-string "\n" "\n " str)
+ "\n\n")))
(error nil))
(let ((input-method (get-language-info language-name 'input-method))
(l (copy-sequence input-method-alist))
("big5[-_]?hkscs" . big5-hkscs)
("big5" . big5)
("euc-?tw" . euc-tw)
- ("euc-?cn" .euc-cn)
+ ("euc-?cn" . euc-cn)
("gb2312" . gb2312)
("gbk" . gbk)
("gb18030" . gb18030)
start of KEY, or nil if there is no match."
(let (element)
(while (and alist (not element))
- (if (string-match (concat "\\`\\(?:" (car (car alist)) "\\)") key)
+ (if (string-match-p (concat "\\`\\(?:" (car (car alist)) "\\)") key)
(setq element (car alist)))
(setq alist (cdr alist)))
(cdr element)))
(= 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))
;; 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))
+
+ (if (string-match "^[a-z][a-z]" locale)
+ (setq current-iso639-language (intern (match-string 0 locale)))))
(setq woman-locale
(or system-messages-locale
(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
(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.
(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))
;; 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
TABLE may also be nil, in which case no property value is pre-assigned.
-Optional 3rd argment DOCSTRING is a documentation string of the property.
+Optional 3rd argument DOCSTRING is a documentation string of the property.
See also the documentation of `get-char-code-property' and
`put-char-code-property'."
(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)
(if slot
(let (table value func)
(if (stringp (cdr slot))
- (load (cdr slot)))
+ (load (cdr slot) nil t))
(setq table (cdr slot)
value (aref table char)
func (char-table-extra-slot table 1))
(if slot
(let (table func)
(if (stringp (cdr slot))
- (load (cdr slot)))
+ (load (cdr slot) nil t))
(setq table (cdr slot)
func (char-table-extra-slot table 2))
(if (functionp func)
(if slot
(let (table func)
(if (stringp (cdr slot))
- (load (cdr slot)))
+ (load (cdr slot) nil t))
(setq table (cdr slot)
func (char-table-extra-slot table 3))
(if (functionp func)
;; 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")
(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.")
-(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)
- (setq arg (string-to-number arg 16)))
- (if (or (< arg 0) (> arg #x10FFFF))
- (error "Not a Unicode character code: 0x%X" arg))
- (insert-and-inherit arg))
-
+(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
+ (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) unsed
+ (#x1D000 . #x1FFFF)
+ ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unsed
+ (#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.")
+(put 'ucs-completions 'risky-local-variable t)
+
+(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-p "^[0-9a-fA-F]+$" input)
+ (string-to-number input 16))
+ ((string-match-p "^#" input)
+ (read input))
+ (t
+ (cdr (assoc-string input (ucs-names) t))))))
+
+(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'.
+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 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
HCoop / bpt / emacs.git / blobdiff