]> code.delx.au - gnu-emacs/blobdiff - lisp/international/mule-cmds.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / international / mule-cmds.el
index 59fc37de43c469816e461a3122d6bb340ddb9e46..28eec4f0df91b3aa09a151f6b05ade99acc4c370 100644 (file)
@@ -1,6 +1,6 @@
 ;;; 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)
@@ -35,8 +35,6 @@
 (defvar dos-codepage)
 (autoload 'widget-value "wid-edit")
 
-(defvar mac-system-coding-system)
-
 ;;; MULE related key bindings and menus.
 
 (defvar mule-keymap
@@ -74,7 +72,7 @@
   (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)
 
@@ -397,7 +395,7 @@ A coding system that requires automatic detection of text+encoding
 
 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))
@@ -719,14 +717,14 @@ DEFAULT is the coding system to use by default in the query."
              (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 "  "))
@@ -744,7 +742,8 @@ e.g., for sending an email message.\n ")
            (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)
@@ -875,13 +874,13 @@ and TO is ignored."
                  (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"))
@@ -1271,7 +1270,7 @@ This file contains a list of libraries of Emacs input methods (LEIM)
 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.
@@ -1587,8 +1586,8 @@ which marks the variable `default-input-method' as set for Custom buffers."
                          (called-interactively-p 'interactive))
         (with-output-to-temp-buffer (help-buffer)
           (let ((elt (assoc input-method input-method-alist)))
-            (princ (format
-                    "Input method: %s (ā€˜%sā€™ in mode line) for %s\n  %s\n"
+            (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))))))))))
 
 (defun describe-current-input-method ()
@@ -2120,7 +2119,7 @@ See `set-language-info-alist' for use in programs."
       (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)
@@ -2173,9 +2172,9 @@ See `set-language-info-alist' for use in programs."
              (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"
+                     (substitute-command-keys "' in mode line):\n\t")
                       (substitute-command-keys
                        (coding-system-doc-string (car l)))
                      "\n")
@@ -2236,7 +2235,7 @@ See `set-language-info-alist' for use in programs."
     ("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)
@@ -2412,12 +2411,12 @@ See `set-language-info-alist' for use in programs."
     ))
   "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\".")
 
@@ -2734,8 +2733,8 @@ See also `locale-charset-language-names', `locale-language-names',
     ;; 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
@@ -2936,11 +2935,18 @@ on encoding."
               (#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)))
@@ -2972,6 +2978,27 @@ on encoding."
   (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
@@ -2985,9 +3012,11 @@ 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.
 
-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
@@ -3000,13 +3029,13 @@ point or a number in hash notation, e.g. #o21430 for octal,
                   (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))