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 cca659f2cc1732c74908cdd3af96b71f7a3c861a..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)
 


@@ -177,7 +175,7 @@
                    "\\(charset\\)"
                    "\\)\\s-+\\)?"
                    ;; Note starting with word-syntax character:
                    "\\(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.
 
 (defun coding-system-change-eol-conversion (coding-system eol-type)
   "Return a coding system which differs from CODING-SYSTEM in EOL conversion.


@@ -397,7 +395,7 @@ 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)))
       (error "Invalid coding system `%s'" coding-system))
   (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)
              (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 "\
+                (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"
 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"))
                 :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.


@@ -1587,7 +1586,7 @@ 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
+            (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))))))))))
 
                     "Input method: %s (`%s' in mode line) for %s\n  %s\n"
                     input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
 


@@ -1698,7 +1697,7 @@ Usually, the input method inserts the intermediate key sequence,
 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."
 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
   :group 'mule)
 
 (defvar input-method-exit-on-invalid-key nil


@@ -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,10 +2172,11 @@ 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"
-                     (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
                      "\n")
              (let ((aliases (coding-system-aliases (car l))))
                (when aliases


@@ -2235,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)


@@ -2411,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\".")
 


@@ -2518,6 +2518,9 @@ is returned.  Thus, for instance, if charset \"ISO8859-2\",
 ;; too, for setting things such as calendar holidays, ps-print paper
 ;; size, spelling dictionary.
 
 ;; 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\"."
 (defun locale-translate (locale)
   "Expand LOCALE according to `locale-translation-file-name', if possible.
 For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."


@@ -2599,7 +2602,18 @@ See also `locale-charset-language-names', `locale-language-names',
        (setq system-time-locale locale))
 
       (if (string-match "^[a-z][a-z]" locale)
        (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
 
     (setq woman-locale
           (or system-messages-locale


@@ -2687,14 +2701,22 @@ See also `locale-charset-language-names', `locale-language-names',
 
     ;; On Windows, override locale-coding-system,
     ;; default-file-name-coding-system, keyboard-coding-system,
 
     ;; 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))
     (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)
        (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)
          (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)
          (setq default-file-name-coding-system code-page-coding))))
 
     (when (eq system-type 'darwin)


@@ -2711,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


@@ -2913,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)))


@@ -2949,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


@@ -2962,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


@@ -2977,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))