;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;;; 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 ,(purecopy "Default") describe-specified-language-support))
+ (bindings--define-key map
+ [Default] '(menu-item "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 ,(purecopy "Default") setup-specified-language-environment))
+ (bindings--define-key map
+ [Default] '(menu-item "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 ,(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
+ (bindings--define-key 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 ,(purecopy "How to en/decode I/O from/to subprocess connected to this buffer")))
+ :help "How to en/decode I/O from/to subprocess connected to this buffer"))
+ (bindings--define-key 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"))
+ (bindings--define-key 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"))
+
+ (bindings--define-key map [separator-3] menu-bar-separator)
+ (bindings--define-key map [set-terminal-coding-system]
+ '(menu-item "For Terminal" set-terminal-coding-system
+ :enable (null (memq initial-window-system '(x w32 ns)))
+ :help "How to encode terminal output"))
+ (bindings--define-key map [set-keyboard-coding-system]
+ '(menu-item "For Keyboard" set-keyboard-coding-system
+ :help "How to decode keyboard input"))
+
+ (bindings--define-key map [separator-2] menu-bar-separator)
+ (bindings--define-key map [set-file-name-coding-system]
+ '(menu-item "For File Name" set-file-name-coding-system
+ :help "How to decode/encode file names"))
+ (bindings--define-key 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"))
+ (bindings--define-key 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"))
+ (bindings--define-key map [separator-1] menu-bar-separator)
+ (bindings--define-key map [universal-coding-system-argument]
+ '(menu-item "For Next Command" universal-coding-system-argument
+ :help "Coding system to be used by next command"))
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
+ (bindings--define-key map [mule-diag]
+ '(menu-item "Show All Multilingual Settings" mule-diag
+ :help "Display multilingual environment settings"))
+ (bindings--define-key map [list-character-sets]
+ '(menu-item "List Character Sets" list-character-sets
+ :help "Show table of available character sets"))
+ (bindings--define-key map [describe-coding-system]
+ '(menu-item "Describe Coding System..." describe-coding-system))
+ (bindings--define-key map [describe-input-method]
+ '(menu-item "Describe Input Method..." describe-input-method
+ :help "Keyboard layout for a specific input method"))
+ (bindings--define-key map [describe-language-environment]
+ `(menu-item "Describe Language Environment"
+ ,describe-language-environment-map
+ :help "Show multilingual settings for a specific language"))
+
+ (bindings--define-key map [separator-coding-system] menu-bar-separator)
+ (bindings--define-key map [view-hello-file]
+ '(menu-item "Show Multilingual Sample 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)
+ :help "Demonstrate various character sets"))
+ (bindings--define-key map [set-various-coding-system]
+ `(menu-item "Set Coding Systems" ,set-coding-system-map
+ :enable (default-value 'enable-multibyte-characters)))
- (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")))
+ (bindings--define-key map [separator-input-method] menu-bar-separator)
+ (bindings--define-key map [describe-input-method]
+ '(menu-item "Describe Input Method" describe-input-method))
+ (bindings--define-key map [set-input-method]
+ '(menu-item "Select Input Method..." set-input-method))
+ (bindings--define-key map [toggle-input-method]
+ '(menu-item "Toggle Input Method" toggle-input-method))
+
+ (bindings--define-key map [separator-mule] menu-bar-separator)
+ (bindings--define-key map [set-language-environment]
+ `(menu-item "Set Language Environment" ,setup-language-environment-map))
map)
"Keymap for Mule (Multilingual environment) menu specific commands.")
"Display the HELLO file, which lists many languages and characters."
(interactive)
;; We have to decode the file in any environment.
- (letf ((coding-system-for-read 'iso-2022-7bit))
+ (let ((coding-system-for-read 'iso-2022-7bit))
(view-file (expand-file-name "HELLO" data-directory))))
(defun universal-coding-system-argument (coding-system)
if CODING-SYSTEM is ASCII-compatible"
(check-coding-system coding-system)
(setq-default buffer-file-coding-system coding-system)
- (if (fboundp 'ucs-set-table-for-input)
- (dolist (buffer (buffer-list))
- (or (local-variable-p 'buffer-file-coding-system buffer)
- (ucs-set-table-for-input buffer))))
(if (eq system-type 'darwin)
;; The file-name coding system on Darwin systems is always utf-8.
systems set by this function will use that type of EOL conversion.
A coding system that requires automatic detection of text+encoding
-\(e.g. undecided, unix) can't be preferred."
+\(e.g. undecided, unix) can't be preferred.
+
+To prefer, for instance, utf-8, say the following:
+
+ \(prefer-coding-system 'utf-8)"
(interactive "zPrefer coding system: ")
(if (not (and coding-system (coding-system-p coding-system)))
(error "Invalid coding system `%s'" coding-system))
(if (memq eol-type '(0 1 2))
(setq base
(coding-system-change-eol-conversion base eol-type)))
- (set-default-coding-systems base)))
+ (set-default-coding-systems base)
+ (if (called-interactively-p 'interactive)
+ (or (eq base default-file-name-coding-system)
+ (message "The default value of `file-name-coding-system' was not changed because the specified coding system is not suitable for file names.")))))
(defvar sort-coding-systems-predicate nil
"If non-nil, a predicate function to sort coding systems.
and try again)? " coding-system auto-cs))
(error "Save aborted"))))
(when (and tick (/= tick (buffer-chars-modified-tick)))
- (error "Cancelled because the buffer was modified"))
+ (error "Canceled because the buffer was modified"))
coding-system)))
(setq select-safe-coding-system-function 'select-safe-coding-system)
(make-variable-buffer-local 'current-input-method-title)
(put 'current-input-method-title 'permanent-local t)
+(define-widget 'mule-input-method-string 'string
+ "String widget with completion for input method."
+ :completions
+ (lambda (string pred action)
+ (let ((completion-ignore-case t))
+ (complete-with-action action input-method-alist string pred)))
+ :prompt-history 'input-method-history)
+
(defcustom default-input-method nil
"Default input method for multilingual text (a string).
This is the input method activated automatically by the command
`toggle-input-method' (\\[toggle-input-method])."
:link '(custom-manual "(emacs)Input Methods")
:group 'mule
- :type '(choice (const nil) (string
- :completion-ignore-case t
- :complete-function widget-string-complete
- :completion-alist input-method-alist
- :prompt-history input-method-history))
+ :type `(choice (const nil)
+ mule-input-method-string)
:set-after '(current-language-environment))
(put 'input-method-function 'permanent-local t)
(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 up multilingual environment for using LANGUAGE-NAME.
This sets the coding system priority and the default input method
and sometimes other things. LANGUAGE-NAME should be a string
which is the name of a language environment. For example, \"Latin-1\"
-specifies the character set for the major languages of Western Europe."
+specifies the character set for the major languages of Western Europe.
+
+If there is a prior value for `current-language-environment', this
+runs the hook `exit-language-environment-hook'. After setting up
+the new language environment, it runs `set-language-environment-hook'."
(interactive (list (read-language-name
nil
"Set language environment (default English): ")))
(define-widget 'charset 'symbol
"An Emacs charset."
:tag "Charset"
- :complete-function (lambda ()
- (interactive)
- (lisp-complete-symbol 'charsetp))
- :completion-ignore-case t
+ :completions
+ (lambda (string pred action)
+ (let ((completion-ignore-case t))
+ (completion-table-with-predicate
+ obarray #'charsetp 'strict string pred action)))
:value 'ascii
:validate (lambda (widget)
(unless (charsetp (widget-value widget))
(set-language-environment current-language-environment)))
:type `(alist
:key-type (string :tag "Language environment"
- :completion-ignore-case t
- :complete-function widget-string-complete
- :completion-alist language-info-alist)
+ :completions
+ (lambda (string pred action)
+ (let ((completion-ignore-case t))
+ (complete-with-action
+ action language-info-alist string pred))))
:value-type
(alist :key-type symbol
:options ((documentation string)
(coding-system (repeat coding-system))
(coding-priority (repeat coding-system))
(nonascii-translation charset)
- (input-method
- (string
- :completion-ignore-case t
- :complete-function widget-string-complete
- :completion-alist input-method-alist
- :prompt-history input-method-history))
+ (input-method mule-input-method-string)
(features (repeat symbol))
(unibyte-display coding-system)))))
(or (not (eq last-command-event 'Default))
(setq last-command-event 'English))
(setq language-name (symbol-name last-command-event))))
- (error "Bogus calling sequence"))
+ (error "This command should only be called from the menu bar"))
(describe-language-environment language-name)))
(defun describe-language-environment (language-name)
locale))
(defun set-locale-environment (&optional locale-name frame)
- "Set up multi-lingual environment for using LOCALE-NAME.
+ "Set up multilingual environment for using LOCALE-NAME.
This sets the language environment, the coding system priority,
the default input method and sometimes other things.
;; On Windows, override locale-coding-system,
;; default-file-name-coding-system, keyboard-coding-system,
- ;; terminal-coding-system with system codepage.
+ ;; terminal-coding-system with the appropriate codepages.
(when (boundp 'w32-ansi-code-page)
- (let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
- (when (coding-system-p code-page-coding)
- (unless frame (setq locale-coding-system code-page-coding))
- (set-keyboard-coding-system code-page-coding frame)
- (set-terminal-coding-system code-page-coding frame)
- ;; Set default-file-name-coding-system last, so that Emacs
- ;; doesn't try to use cpNNNN when it defines keyboard and
- ;; terminal encoding. That's because the above two lines
- ;; will want to load code-pages.el, where cpNNNN are
- ;; defined; if default-file-name-coding-system were set to
- ;; cpNNNN while these two lines run, Emacs will want to use
- ;; it for encoding the file name it wants to load. And that
- ;; will fail, since cpNNNN is not yet usable until
- ;; code-pages.el finishes loading.
- (setq default-file-name-coding-system code-page-coding))))
+ (let ((ansi-code-page-coding (intern (format "cp%d" w32-ansi-code-page)))
+ (oem-code-page-coding
+ (intern (format "cp%d" (w32-get-console-codepage))))
+ (oem-code-page-output-coding
+ (intern (format "cp%d" (w32-get-console-output-codepage))))
+ ansi-cs-p oem-cs-p oem-o-cs-p)
+ (setq ansi-cs-p (coding-system-p ansi-code-page-coding))
+ (setq oem-cs-p (coding-system-p oem-code-page-coding))
+ (setq oem-o-cs-p (coding-system-p oem-code-page-output-coding))
+ ;; Set the keyboard and display encoding to either the current
+ ;; ANSI codepage of the OEM codepage, depending on whether
+ ;; this is a GUI or a TTY frame.
+ (when ansi-cs-p
+ (unless frame (setq locale-coding-system ansi-code-page-coding))
+ (when (display-graphic-p frame)
+ (set-keyboard-coding-system ansi-code-page-coding frame)
+ (set-terminal-coding-system ansi-code-page-coding frame))
+ (setq default-file-name-coding-system ansi-code-page-coding))
+ (when oem-cs-p
+ (unless (display-graphic-p frame)
+ (set-keyboard-coding-system oem-code-page-coding frame)
+ (set-terminal-coding-system
+ (if oem-o-cs-p oem-code-page-output-coding oem-code-page-coding)
+ frame)))))
(when (eq system-type 'darwin)
;; On Darwin, file names are always encoded in utf-8, no matter
\f
;;; Character property
-;; Each element has the form (PROP . TABLE).
-;; PROP is a symbol representing a character property.
-;; TABLE is a char-table containing the property value for each character.
-;; TABLE may be a name of file to load to build a char-table.
-;; Don't modify this variable directly but use `define-char-code-property'.
-
-(defvar char-code-property-alist nil
- "Alist of character property name vs char-table containing property values.
-Internal use only.")
-
(put 'char-code-property-table 'char-table-extra-slots 5)
(defun define-char-code-property (name table &optional docstring)
(defun get-char-code-property (char propname)
"Return the value of CHAR's PROPNAME property."
- (let ((slot (assq propname char-code-property-alist)))
- (if slot
- (let (table value func)
- (if (stringp (cdr slot))
- (load (cdr slot) nil t))
- (setq table (cdr slot)
- value (aref table char)
- func (char-table-extra-slot table 1))
+ (let ((table (unicode-property-table-internal propname)))
+ (if table
+ (let ((func (char-table-extra-slot table 1)))
(if (functionp func)
- (setq value (funcall func char value table)))
- value)
+ (funcall func char (aref table char) table)
+ (get-unicode-property-internal table char)))
(plist-get (aref char-code-property-table char) propname))))
(defun put-char-code-property (char propname value)
"Store CHAR's PROPNAME property with VALUE.
It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
- (let ((slot (assq propname char-code-property-alist)))
- (if slot
- (let (table func)
- (if (stringp (cdr slot))
- (load (cdr slot) nil t))
- (setq table (cdr slot)
- func (char-table-extra-slot table 2))
+ (let ((table (unicode-property-table-internal propname)))
+ (if table
+ (let ((func (char-table-extra-slot table 2)))
(if (functionp func)
(funcall func char value table)
- (aset table char value)))
+ (put-unicode-property-internal table char value)))
(let* ((plist (aref char-code-property-table char))
(x (plist-put plist propname value)))
(or (eq x plist)
(defun char-code-property-description (prop value)
"Return a description string of character property PROP's value VALUE.
If there's no description string for VALUE, return nil."
- (let ((slot (assq prop char-code-property-alist)))
- (if slot
- (let (table func)
- (if (stringp (cdr slot))
- (load (cdr slot) nil t))
- (setq table (cdr slot)
- func (char-table-extra-slot table 3))
+ (let ((table (unicode-property-table-internal prop)))
+ (if table
+ (let ((func (char-table-extra-slot table 3)))
(if (functionp func)
(funcall func value))))))
;; Backwards compatibility. These might be better with :init-value t,
;; but that breaks loadup.
(define-minor-mode unify-8859-on-encoding-mode
- "Obsolete."
+ "Exists only for backwards compatibility."
:group 'mule
:global t)
+;; Doc said "obsolete" in 23.1, this statement only added in 24.1.
+(make-obsolete 'unify-8859-on-encoding-mode "don't use it." "23.1")
+
(define-minor-mode unify-8859-on-decoding-mode
- "Obsolete."
+ "Exists only for backwards compatibility."
:group 'mule
:global t)
+;; Doc said "obsolete" in 23.1, this statement only added in 24.1.
+(make-obsolete 'unify-8859-on-decoding-mode "don't use it." "23.1")
(defvar nonascii-insert-offset 0)
(make-obsolete-variable 'nonascii-insert-offset "do not use it." "23.1")
(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
point or a number in hash notation, e.g. #o21430 for octal,
#x2318 for hex, or #10r8984 for decimal."
(let* ((completion-ignore-case t)
- (input (completing-read prompt ucs-completions)))
+ (input (completing-read
+ prompt
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ '(metadata (category . unicode-name))
+ (complete-with-action action (ucs-names) string pred))))))
(cond
- ((string-match-p "^[0-9a-fA-F]+$" input)
+ ((string-match-p "\\`[0-9a-fA-F]+\\'" input)
(string-to-number input 16))
- ((string-match-p "^#" input)
+ ((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'.
-
-You can type a few of the first letters of the Unicode name and
-use completion. If you type a substring of the Unicode name
-preceded by an asterisk `*' and use completion, it will show all
-the characters whose names include that substring, not necessarily
-at the beginning of the 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)
+(define-obsolete-function-alias 'ucs-insert 'insert-char "24.2")
+(define-key ctl-x-map "8\r" 'insert-char)
;;; mule-cmds.el ends here
HCoop / bpt / emacs.git / blobdiff