Merge from origin/emacs-25

[gnu-emacs] / lisp / international / mule-cmds.el

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 2142f0bb961fb1cc1f588869ee07ec2029fa47c2..28eec4f0df91b3aa09a151f6b05ade99acc4c370 100644 (file)
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1,6 +1,6 @@
 ;;; mule-cmds.el --- commands for multilingual environment  -*- lexical-binding:t -*-
 
 ;;; 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)
 ;; 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 dos-codepage)
 (autoload 'widget-value "wid-edit")
 

-(defvar mac-system-coding-system)
-

 ;;; MULE related key bindings and menus.
 
 (defvar mule-keymap
 ;;; 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
   (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]
         :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]


@@ -159,7 +157,7 @@
 ;; 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
 ;; 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)
 
 ;; but it won't be used that frequently.
 (define-key global-map "\C-\\" 'toggle-input-method)
 


@@ -397,12 +395,12 @@ A coding system that requires automatic detection of text+encoding
 
 To prefer, for instance, utf-8, say the following:
 
 
 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)))
   (interactive "zPrefer coding system: ")
   (if (not (and coding-system (coding-system-p coding-system)))

-      (error "Invalid coding system ‘%s’" coding-system))
+      (error "Invalid coding system `%s'" coding-system))

   (if (memq (coding-system-type coding-system) '(raw-text undecided))
   (if (memq (coding-system-type coding-system) '(raw-text undecided))

-      (error "Can't prefer the coding system ‘%s’" coding-system))
+      (error "Can't prefer the 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)
   (let ((base (coding-system-base coding-system))
        (eol-type (coding-system-eol-type coding-system)))
     (set-coding-system-priority base)


@@ -417,7 +415,7 @@ To prefer, for instance, utf-8, say the following:
     (set-default-coding-systems base)
     (if (called-interactively-p 'interactive)
        (or (eq base default-file-name-coding-system)
     (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.")))))
+           (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.
 
 (defvar sort-coding-systems-predicate nil
   "If non-nil, a predicate function to sort coding systems.


@@ -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)
              (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 "\"")))
            (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 "  "))
             ":\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")
            (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)
              (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
                  (setq auto-cs (car auto-cs))
                (display-warning
                 'mule

-                (format "\
-Invalid coding system ‘%s’ is specified
+                (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"
 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"))
                 :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.")
 
 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.
 ";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
 ;;
 ;; This file is automatically generated.


@@ -1451,7 +1450,7 @@ If INPUT-METHOD is nil, deactivate any current input method."
   (unless (or current-input-method (null input-method))
     (let ((slot (assoc input-method input-method-alist)))
       (if (null slot)
   (unless (or current-input-method (null input-method))
     (let ((slot (assoc input-method input-method-alist)))
       (if (null slot)

-         (error "Can't activate input method ‘%s’" input-method))
+         (error "Can't activate input method `%s'" input-method))

       (setq current-input-method-title nil)
       (let ((func (nth 2 slot)))
        (if (functionp func)
       (setq current-input-method-title nil)
       (let ((func (nth 2 slot)))
        (if (functionp func)


@@ -1460,7 +1459,7 @@ If INPUT-METHOD is nil, deactivate any current input method."
              (progn
                (require (cdr func))
                (apply (car func) input-method (nthcdr 5 slot)))
              (progn
                (require (cdr func))
                (apply (car func) input-method (nthcdr 5 slot)))

-           (error "Can't activate input method ‘%s’" input-method))))
+           (error "Can't activate input method `%s'" input-method))))

       (setq current-input-method input-method)
       (or (stringp current-input-method-title)
          (setq current-input-method-title (nth 3 slot)))
       (setq current-input-method input-method)
       (or (stringp current-input-method-title)
          (setq current-input-method-title (nth 3 slot)))


@@ -1538,7 +1537,7 @@ which marks the variable `default-input-method' as set for Custom buffers."
 
   (interactive "P\np")
   (if toggle-input-method-active
 
   (interactive "P\np")
   (if toggle-input-method-active

-      (error "Recursive use of ‘toggle-input-method’"))
+      (error "Recursive use of `toggle-input-method'"))

   (if (and current-input-method (not arg))
       (deactivate-input-method)
     (let ((toggle-input-method-active t)
   (if (and current-input-method (not arg))
       (deactivate-input-method)
     (let ((toggle-input-method-active t)


@@ -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)))
                          (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 ()
                     input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
 
 (defun describe-current-input-method ()


@@ -1598,7 +1597,7 @@ This is a subroutine for `describe-input-method'."
       (if (and (symbolp describe-current-input-method-function)
               (fboundp describe-current-input-method-function))
          (funcall describe-current-input-method-function)
       (if (and (symbolp describe-current-input-method-function)
               (fboundp describe-current-input-method-function))
          (funcall describe-current-input-method-function)

-       (message "No way to describe the current input method ‘%s’"
+       (message "No way to describe the current input method `%s'"

                 current-input-method)
        (ding))
     (error "No input method is activated now")))
                 current-input-method)
        (ding))
     (error "No input method is activated now")))


@@ -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)
       (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)
        (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))
              (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))
                      (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")
                       (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
     ("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)
     ; 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:
     ))
   "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:
 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\".")
 
 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
     ;; 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
        (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)
               (#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)
               (#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)))
               (#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)))))
 
   (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
 (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.
 
 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
   (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
                   (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))
     (unless (characterp char)
       (error "Invalid character"))
     char))