;;; mule-cmds.el --- commands for multilingual environment -*- lexical-binding:t -*-
-;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2016 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)
(defvar dos-codepage)
(autoload 'widget-value "wid-edit")
-(defvar mac-system-coding-system)
-
;;; MULE related key bindings and menus.
(defvar mule-keymap
(let ((map (make-sparse-keymap "Set 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)
+ :visible (fboundp 'make-process)
:enable (get-buffer-process (current-buffer))
:help "How to en/decode I/O from/to subprocess connected to this buffer"))
(bindings--define-key map [set-next-selection-coding-system]
;; very frequently while editing multilingual text. Now we can use
;; only two such keys: "\C-\\" and "\C-^", but the latter is not
;; convenient because it requires shifting on most keyboards. An
-;; alternative is "\C-\]" which is now bound to `abort-recursive-edit'
+;; alternative is "\C-]" which is now bound to `abort-recursive-edit'
;; but it won't be used that frequently.
(define-key global-map "\C-\\" 'toggle-input-method)
"\\(charset\\)"
"\\)\\s-+\\)?"
;; Note starting with word-syntax character:
- "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")))
+ "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]")))
(defun coding-system-change-eol-conversion (coding-system eol-type)
"Return a coding system which differs from CODING-SYSTEM in EOL conversion.
To prefer, for instance, utf-8, say the following:
- \(prefer-coding-system 'utf-8)"
+ (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))
(insert "No default coding systems to try for "
(if (stringp from)
(format "string \"%s\"." from)
- (format "buffer `%s'." bufname)))
+ (format-message "buffer `%s'." bufname)))
(insert
"These default coding systems were tried to encode"
(if (stringp from)
(concat " \"" (if (> (length from) 10)
(concat (substring from 0 10) "...\"")
(concat from "\"")))
- (format " text\nin the buffer `%s'" bufname))
+ (format-message " text\nin the buffer `%s'" bufname))
":\n")
(let ((pos (point))
(fill-prefix " "))
(when unsafe
(insert (if rejected "The other coding systems"
"However, each of them")
- " encountered characters it couldn't encode:\n")
+ (substitute-command-keys
+ " encountered characters it couldn't encode:\n"))
(dolist (coding unsafe)
(insert (format " %s cannot encode these:" (car coding)))
(let ((i 0)
(setq auto-cs (car auto-cs))
(display-warning
'mule
- (format "\
+ (format-message "\
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-message "variable `%s'" (cdr auto-cs))))
:warning)
(or (yes-or-no-p "Really proceed with writing? ")
(error "Save aborted"))
in the format of Lisp expression for registering each input method.
Emacs loads this file at startup time.")
-(defconst leim-list-header (format
+(defconst leim-list-header (format-message
";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
;;
;; This file is automatically generated.
(called-interactively-p 'interactive))
(with-output-to-temp-buffer (help-buffer)
(let ((elt (assoc input-method input-method-alist)))
- (princ (format
+ (princ (format-message
"Input method: %s (`%s' in mode line) for %s\n %s\n"
input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
or candidate translations corresponding to the sequence,
at point in the current buffer.
But, if this flag is non-nil, it displays them in echo area instead."
- :type 'hook
+ :type 'boolean
:group 'mule)
(defvar input-method-exit-on-invalid-key nil
(with-current-buffer standard-output
(insert language-name " language environment\n\n")
(if (stringp doc)
- (insert doc "\n\n"))
+ (insert (substitute-command-keys doc) "\n\n"))
(condition-case nil
(let ((str (eval (get-language-info language-name 'sample-text))))
(if (stringp str)
(search-backward (symbol-name (car l)))
(help-xref-button 0 'help-coding-system (car l))
(goto-char (point-max))
- (insert " (`"
+ (insert (substitute-command-keys " (`")
(coding-system-mnemonic (car l))
- "' in mode line):\n\t"
- (coding-system-doc-string (car l))
+ (substitute-command-keys "' in mode line):\n\t")
+ (substitute-command-keys
+ (coding-system-doc-string (car l)))
"\n")
(let ((aliases (coding-system-aliases (car l))))
(when aliases
("br" . "Latin-1") ; Breton
("bs" . "Latin-2") ; Bosnian
("byn" . "UTF-8") ; Bilin; Blin
- ("ca" . "Latin-1") ; Catalan
+ ("ca" "Catalan" iso-8859-1) ; Catalan
; co Corsican
("cs" "Czech" iso-8859-2)
("cy" "Welsh" iso-8859-14)
))
"Alist of locale regexps vs the corresponding languages and coding systems.
Each element has this form:
- \(LOCALE-REGEXP LANG-ENV CODING-SYSTEM)
+ (LOCALE-REGEXP LANG-ENV CODING-SYSTEM)
The first element whose LOCALE-REGEXP matches the start of a
downcased locale specifies the LANG-ENV \(language environment)
and CODING-SYSTEM corresponding to that locale. If there is no
appropriate language environment, the element may have this form:
- \(LOCALE-REGEXP . LANG-ENV)
+ (LOCALE-REGEXP . LANG-ENV)
In this case, LANG-ENV is one of generic language environments for an
specific encoding such as \"Latin-1\" and \"UTF-8\".")
;; too, for setting things such as calendar holidays, ps-print paper
;; size, spelling dictionary.
+(declare-function w32-get-console-codepage "w32proc.c" ())
+(declare-function w32-get-console-output-codepage "w32proc.c" ())
+
(defun locale-translate (locale)
"Expand LOCALE according to `locale-translation-file-name', if possible.
For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."
(setq system-time-locale locale))
(if (string-match "^[a-z][a-z]" locale)
- (setq current-iso639-language (intern (match-string 0 locale)))))
+ ;; The value of 'current-iso639-language' is matched against
+ ;; the ':lang' property of font-spec objects when selecting
+ ;; and prioritizing available fonts for displaying
+ ;; characters; see fontset.c.
+ (setq current-iso639-language
+ ;; The call to 'downcase' is for w32, where the
+ ;; MS-Windows locale names are in caps, as in "ENU",
+ ;; the equivalent of the Posix "en_US". Since the
+ ;; match mentioned above uses memq, and ':lang'
+ ;; properties have lower-case values, the letter-case
+ ;; must match exactly.
+ (intern (downcase (match-string 0 locale))))))
(setq woman-locale
(or system-messages-locale
;; 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 ANSI or console codepage.
(when (and (eq system-type 'windows-nt)
(boundp 'w32-ansi-code-page))
- (let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
+ (let* ((code-page-coding
+ (intern (format "cp%d" (if noninteractive
+ (w32-get-console-codepage)
+ w32-ansi-code-page))))
+ (output-coding
+ (if noninteractive
+ (intern (format "cp%d" (w32-get-console-output-codepage)))
+ code-page-coding)))
(when (coding-system-p code-page-coding)
+ (or output-coding (setq output-coding 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-terminal-coding-system output-coding frame)
(setq default-file-name-coding-system code-page-coding))))
(when (eq system-type 'darwin)
;; Default to A4 paper if we're not in a C, POSIX or US locale.
;; (See comments in Flocale_info.)
(unless frame
- (let ((locale locale)
- (paper (locale-info 'paper)))
+ (let ((paper (locale-info 'paper))
+ locale)
(if paper
;; This will always be null at the time of writing.
(cond
(#xA000 . #xD7FF)
;; (#xD800 . #xFAFF) Surrogate/Private
(#xFB00 . #x134FF)
- ;; (#x13500 . #x167FF) unused
- (#x16800 . #x16A3F)
- ;; (#x16A40 . #x1AFFF) unused
+ ;; (#x13500 . #x143FF) unused
+ (#x14400 . #x14646)
+ ;; (#x14647 . #x167FF) unused
+ (#x16800 . #x16F9F)
+ (#x16FE0 . #x16FE0)
+ ;; (#x17000 . #x187FF) Tangut Ideographs
+ ;; (#x18800 . #x18AFF) Tangut Components
+ ;; (#x18B00 . #x1AFFF) unused
(#x1B000 . #x1B0FF)
- ;; (#x1B100 . #x1CFFF) unused
+ ;; (#x1B100 . #x1BBFF) unused
+ (#x1BC00 . #x1BCAF)
+ ;; (#x1BCB0 . #x1CFFF) unused
(#x1D000 . #x1FFFF)
;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused
(#xE0000 . #xE01FF)))
(let ((char (assoc name ucs-names)))
(when char (format " (%c)" (cdr char)))))
+(defun char-from-name (string &optional ignore-case)
+ "Return a character as a number from its Unicode name STRING.
+If optional IGNORE-CASE is non-nil, ignore case in STRING.
+Return nil if STRING does not name a character."
+ (or (cdr (assoc-string string (ucs-names) ignore-case))
+ (let ((minus (string-match-p "-[0-9A-F]+\\'" string)))
+ (when minus
+ ;; Parse names like "VARIATION SELECTOR-17" and "CJK
+ ;; COMPATIBILITY IDEOGRAPH-F900" that are not in ucs-names.
+ (ignore-errors
+ (let* ((case-fold-search ignore-case)
+ (vs (string-match-p "\\`VARIATION SELECTOR-" string))
+ (minus-num (string-to-number (substring string minus)
+ (if vs 10 16)))
+ (vs-offset (if vs (if (< minus-num -16) #xE00EF #xFDFF) 0))
+ (code (- vs-offset minus-num))
+ (name (get-char-code-property code 'name)))
+ (when (eq t (compare-strings string nil nil name nil nil
+ ignore-case))
+ code)))))))
+
(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
the characters whose names include that substring, not necessarily
at the beginning of the name.
-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."
+Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal
+number like \"2A10\", or a number in hash notation (e.g.,
+\"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for
+octal). Treat otherwise-ambiguous strings like \"BED\" (U+1F6CF)
+as names, not numbers."
(let* ((enable-recursive-minibuffers t)
(completion-ignore-case t)
(input
(category . unicode-name))
(complete-with-action action (ucs-names) string pred)))))
(char
- (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))))))
+ (cond
+ ((char-from-name input t))
+ ((string-match-p "\\`[0-9a-fA-F]+\\'" input)
+ (ignore-errors (string-to-number input 16)))
+ ((string-match-p "\\`#\\([bBoOxX]\\|[0-9]+[rR]\\)[0-9a-zA-Z]+\\'"
+ input)
+ (ignore-errors (read input))))))
(unless (characterp char)
(error "Invalid character"))
char))