root/trunk/lisp/international/mule-cmds.el

;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-

;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;;   2006, 2007, 2008  Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008
;;   National Institute of Advanced Industrial Science and Technology (AIST)
;;   Registration Number H14PRO021

;; Keywords: mule, multilingual

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(eval-when-compile
  (defvar dos-codepage)
  (autoload 'widget-value "wid-edit"))

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

;;; MULE related key bindings and menus.

(defvar mule-keymap (make-sparse-keymap)
  "Keymap for Mule (Multilingual environment) specific commands.")

;; Keep "C-x C-m ..." for mule specific commands.
(define-key ctl-x-map "\C-m" mule-keymap)

(define-key mule-keymap "f" 'set-buffer-file-coding-system)
(define-key mule-keymap "r" 'revert-buffer-with-coding-system)
(define-key mule-keymap "F" 'set-file-name-coding-system)
(define-key mule-keymap "t" 'set-terminal-coding-system)
(define-key mule-keymap "k" 'set-keyboard-coding-system)
(define-key mule-keymap "p" 'set-buffer-process-coding-system)
(define-key mule-keymap "x" 'set-selection-coding-system)
(define-key mule-keymap "X" 'set-next-selection-coding-system)
(define-key mule-keymap "\C-\\" 'set-input-method)
(define-key mule-keymap "c" 'universal-coding-system-argument)
(define-key mule-keymap "l" 'set-language-environment)

(defvar mule-menu-keymap
  (make-sparse-keymap "Mule (Multilingual Environment)")
  "Keymap for Mule (Multilingual environment) menu specific commands.")

(defvar describe-language-environment-map
  (make-sparse-keymap "Describe Language Environment"))

(defvar setup-language-environment-map
  (make-sparse-keymap "Set Language Environment"))

(defvar set-coding-system-map
  (make-sparse-keymap "Set Coding System"))

(define-key-after mule-menu-keymap [set-language-environment]
  (list 'menu-item  "Set Language Environment" setup-language-environment-map))
(define-key-after mule-menu-keymap [separator-mule]
  '("--")
  t)
(define-key-after mule-menu-keymap [toggle-input-method]
  '(menu-item "Toggle Input Method" toggle-input-method)
  t)
(define-key-after mule-menu-keymap [set-input-method]
  '(menu-item "Select Input Method..." set-input-method)
  t)
(define-key-after mule-menu-keymap [describe-input-method]
  '(menu-item "Describe Input Method"  describe-input-method))
(define-key-after mule-menu-keymap [separator-input-method]
  '("--")
  t)
(define-key-after mule-menu-keymap [set-various-coding-system]
  (list 'menu-item "Set Coding Systems" set-coding-system-map
        :enable 'default-enable-multibyte-characters))
(define-key-after mule-menu-keymap [view-hello-file]
  '(menu-item "Show Multi-lingual Text" view-hello-file
              :enable (file-readable-p
                       (expand-file-name "HELLO" data-directory))
              :help "Display file which says HELLO in many languages")
  t)
(define-key-after mule-menu-keymap [separator-coding-system]
  '("--")
  t)
(define-key-after mule-menu-keymap [describe-language-environment]
  (list 'menu-item "Describe Language Environment"
        describe-language-environment-map
        :help "Show multilingual settings for a specific language")
  t)
(define-key-after mule-menu-keymap [describe-input-method]
  '(menu-item "Describe Input Method..." describe-input-method
              :help "Keyboard layout for a specific input method")
  t)
(define-key-after mule-menu-keymap [describe-coding-system]
  '(menu-item "Describe Coding System..." describe-coding-system)
  t)
(define-key-after mule-menu-keymap [list-character-sets]
  '(menu-item "List Character Sets" list-character-sets
              :help "Show table of available character sets"))
(define-key-after mule-menu-keymap [mule-diag]
  '(menu-item "Show All of Mule Status" mule-diag
              :help "Display multilingual environment settings")
  t)

(define-key-after set-coding-system-map [universal-coding-system-argument]
  '(menu-item "For Next Command" universal-coding-system-argument
              :help "Coding system to be used by next command")
  t)
(define-key-after set-coding-system-map [separator-1]
  '("--")
  t)
(define-key-after set-coding-system-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")
  t)
(define-key-after set-coding-system-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")
  t)
(define-key-after set-coding-system-map [set-file-name-coding-system]
  '(menu-item "For File Name" set-file-name-coding-system
              :help "How to decode/encode file names")
  t)
(define-key-after set-coding-system-map [separator-2]
  '("--")
  t)

(define-key-after set-coding-system-map [set-keyboard-coding-system]
  '(menu-item "For Keyboard" set-keyboard-coding-system
              :help "How to decode keyboard input")
  t)
(define-key-after set-coding-system-map [set-terminal-coding-system]
  '(menu-item "For Terminal" set-terminal-coding-system
              :enable (null (memq window-system '(x w32 mac)))
              :help "How to encode terminal output")
  t)
(define-key-after set-coding-system-map [separator-3]
  '("--")
  t)
(define-key-after set-coding-system-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")
  t)
(define-key-after set-coding-system-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")
  t)
(define-key-after set-coding-system-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 "How to en/decode I/O from/to subprocess connected to this buffer")
  t)


(define-key setup-language-environment-map
  [Default] '(menu-item "Default" setup-specified-language-environment))

(define-key describe-language-environment-map
  [Default] '(menu-item "Default" describe-specified-language-support))

;; This should be a single character key binding because users use it
;; 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'
;; but it won't be used that frequently.
(define-key global-map "\C-\\" 'toggle-input-method)

;; This is no good because people often type Shift-SPC
;; meaning to type SPC.  -- rms.
;; ;; Here's an alternative key binding for X users (Shift-SPACE).
;; (define-key global-map [?\S- ] 'toggle-input-method)

;;; Mule related hyperlinks.
(defconst help-xref-mule-regexp-template
  (purecopy (concat "\\(\\<\\("
                    "\\(coding system\\)\\|"
                    "\\(input method\\)\\|"
                    "\\(character set\\)\\|"
                    "\\(charset\\)"
                    "\\)\\s-+\\)?"
                    ;; Note starting with word-syntax character:
                    "`\\(\\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.
The returned coding system converts end-of-line by EOL-TYPE
but text as the same way as CODING-SYSTEM.
EOL-TYPE should be `unix', `dos', `mac', or nil.
If EOL-TYPE is nil, the returned coding system detects
how end-of-line is formatted automatically while decoding.

EOL-TYPE can be specified by an integer 0, 1, or 2.
They means `unix', `dos', and `mac' respectively."
  (if (symbolp eol-type)
      (setq eol-type (cond ((eq eol-type 'unix) 0)
                           ((eq eol-type 'dos) 1)
                           ((eq eol-type 'mac) 2)
                           (t eol-type))))
  ;; We call `coding-system-base' before `coding-system-eol-type',
  ;; because the coding-system may not be initialized until then.
  (let* ((base (coding-system-base coding-system))
         (orig-eol-type (coding-system-eol-type coding-system)))
    (cond ((vectorp orig-eol-type)
           (if (not eol-type)
               coding-system
             (aref orig-eol-type eol-type)))
          ((not eol-type)
           base)
          ((= eol-type orig-eol-type)
           coding-system)
          ((progn (setq orig-eol-type (coding-system-eol-type base))
                  (vectorp orig-eol-type))
           (aref orig-eol-type eol-type)))))

(defun coding-system-change-text-conversion (coding-system coding)
  "Return a coding system which differs from CODING-SYSTEM in text conversion.
The returned coding system converts text by CODING
but end-of-line as the same way as CODING-SYSTEM.
If CODING is nil, the returned coding system detects
how text is formatted automatically while decoding."
  (let ((eol-type (coding-system-eol-type coding-system)))
    (coding-system-change-eol-conversion
     (if coding coding 'undecided)
     (if (numberp eol-type) (aref [unix dos mac] eol-type)))))

(defun toggle-enable-multibyte-characters (&optional arg)
  "Change whether this buffer uses multibyte characters.
With arg, use multibyte characters if the arg is positive.

Note that this command does not convert the byte contents of
the buffer; it only changes the way those bytes are interpreted.
In general, therefore, this command *changes* the sequence of
characters that the current buffer contains.

We suggest you avoid using this command unless you know what you are
doing.  If you use it by mistake, and the buffer is now displayed
wrong, use this command again to toggle back to the right mode."
  (interactive "P")
  (let ((new-flag
         (if (null arg) (null enable-multibyte-characters)
           (> (prefix-numeric-value arg) 0))))
    (set-buffer-multibyte new-flag))
  (force-mode-line-update))

(defun view-hello-file ()
  "Display the HELLO file which list up many languages and characters."
  (interactive)
  ;; We have to decode the file in any environment.
  (let ((default-enable-multibyte-characters t)
        (coding-system-for-read 'iso-2022-7bit))
    (view-file (expand-file-name "HELLO" data-directory))))

(defun universal-coding-system-argument (coding-system)
  "Execute an I/O command using the specified coding system."
  (interactive
   (let ((default (and buffer-file-coding-system
                       (not (eq (coding-system-type buffer-file-coding-system)
                                t))
                       buffer-file-coding-system)))
     (list (read-coding-system
            (if default
                (format "Coding system for following command (default %s): " default)
              "Coding system for following command: ")
            default))))
  (let* ((keyseq (read-key-sequence
                  (format "Command to execute with %s:" coding-system)))
         (cmd (key-binding keyseq))
         prefix)

    (when (eq cmd 'universal-argument)
      (call-interactively cmd)

      ;; Process keys bound in `universal-argument-map'.
      (while (progn
               (setq keyseq (read-key-sequence nil t)
                     cmd (key-binding keyseq t))
               (not (eq cmd 'universal-argument-other-key)))
        (let ((current-prefix-arg prefix-arg)
              ;; Have to bind `last-command-char' here so that
              ;; `digit-argument', for instance, can compute the
              ;; prefix arg.
              (last-command-char (aref keyseq 0)))
          (call-interactively cmd)))

      ;; This is the final call to `universal-argument-other-key', which
      ;; set's the final `prefix-arg.
      (let ((current-prefix-arg prefix-arg))
        (call-interactively cmd))

      ;; Read the command to execute with the given prefix arg.
      (setq prefix prefix-arg
            keyseq (read-key-sequence nil t)
            cmd (key-binding keyseq)))

    (let ((coding-system-for-read coding-system)
          (coding-system-for-write coding-system)
          (coding-system-require-warning t)
          (current-prefix-arg prefix))
      (message "")
      (call-interactively cmd))))

(defun set-default-coding-systems (coding-system)
  "Set default value of various coding systems to CODING-SYSTEM.
This sets the following coding systems:
  o coding system of a newly created buffer
  o default coding system for subprocess I/O
This also sets the following values:
  o default value used as `file-name-coding-system' for converting file names
      if CODING-SYSTEM is ASCII-compatible
  o default value for the command `set-terminal-coding-system' (not on MSDOS)
  o default value for the command `set-keyboard-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.
      (setq default-file-name-coding-system 'utf-8)
    (if (and default-enable-multibyte-characters
             (or (not coding-system)
                 (not (coding-system-get coding-system 'ascii-incompatible))))
        (setq default-file-name-coding-system coding-system)))
  ;; If coding-system is nil, honor that on MS-DOS as well, so
  ;; that they could reset the terminal coding system.
  (unless (and (eq window-system 'pc) coding-system)
    (setq default-terminal-coding-system coding-system))
  (if (or (not coding-system)
          (not (coding-system-get coding-system 'ascii-incompatible)))
      (setq default-keyboard-coding-system coding-system))
  ;; Preserve eol-type from existing default-process-coding-systems.
  ;; On non-unix-like systems in particular, these may have been set
  ;; carefully by the user, or by the startup code, to deal with the
  ;; users shell appropriately, so should not be altered by changing
  ;; language environment.
  (let ((output-coding
         (coding-system-change-text-conversion
          (car default-process-coding-system) coding-system))
        (input-coding
         (coding-system-change-text-conversion
          (cdr default-process-coding-system) coding-system)))
    (setq default-process-coding-system
          (cons output-coding input-coding))))

(defun prefer-coding-system (coding-system)
  "Add CODING-SYSTEM at the front of the priority list for automatic detection.
This also sets the following coding systems:
  o coding system of a newly created buffer
  o default coding system for subprocess I/O
This also sets the following values:
  o default value used as `file-name-coding-system' for converting file names
  o default value for the command `set-terminal-coding-system' (not on MSDOS)
  o default value for the command `set-keyboard-coding-system'

If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
systems set by this function will use that type of EOL conversion.

This command does not change the default value of terminal coding system
for MS-DOS terminal, because DOS terminals only support a single coding
system, and Emacs automatically sets the default to that coding system at
startup.

A coding system that requires automatic detection of text
encoding (e.g. undecided, unix) can't be preferred.

See also `coding-category-list' and `coding-system-category'."
  (interactive "zPrefer coding system: ")
  (if (not (and coding-system (coding-system-p coding-system)))
      (error "Invalid coding system `%s'" coding-system))
  (let ((coding-category (coding-system-category coding-system))
        (base (coding-system-base coding-system))
        (eol-type (coding-system-eol-type coding-system)))
    (if (not coding-category)
        ;; CODING-SYSTEM is no-conversion or undecided.
        (error "Can't prefer the coding system `%s'" coding-system))
    (set coding-category (or base coding-system))
    ;; Changing the binding of a coding category requires this call.
    (update-coding-systems-internal)
    (or (eq coding-category (car coding-category-list))
        ;; We must change the order.
        (set-coding-priority (list coding-category)))
    (if (and base (interactive-p))
        (message "Highest priority is set to %s (base of %s)"
                 base coding-system))
    ;; If they asked for specific EOL conversion, honor that.
    (if (memq eol-type '(0 1 2))
        (setq coding-system
              (coding-system-change-eol-conversion base eol-type))
      (setq coding-system base))
    (set-default-coding-systems coding-system)))

(defvar sort-coding-systems-predicate nil
  "If non-nil, a predicate function to sort coding systems.

It is called with two coding systems, and should return t if the first
one is \"less\" than the second.

The function `sort-coding-systems' use it.")

(defun sort-coding-systems (codings)
  "Sort coding system list CODINGS by a priority of each coding system.
Return the sorted list.  CODINGS is modified by side effects.

If a coding system is most preferred, it has the highest priority.
Otherwise, coding systems that correspond to MIME charsets have
higher priorities.  Among them, a coding system included in the
`coding-system' key of the current language environment has higher
priority.  See also the documentation of `language-info-alist'.

If the variable `sort-coding-systems-predicate' (which see) is
non-nil, it is used to sort CODINGS instead."
  (if sort-coding-systems-predicate
      (sort codings sort-coding-systems-predicate)
    (let* ((from-categories (mapcar #'(lambda (x) (symbol-value x))
                                    coding-category-list))
           (most-preferred (car from-categories))
           (lang-preferred (get-language-info current-language-environment
                                              'coding-system))
           (func (function
                  (lambda (x)
                    (let ((base (coding-system-base x)))
                      ;; We calculate the priority number 0..255 by
                      ;; using the 8 bits PMMLCEII as this:
                      ;; P: 1 if most preferred.
                      ;; MM: greater than 0 if mime-charset.
                      ;; L: 1 if one of the current lang. env.'s codings.
                      ;; C: 1 if one of codings listed in the category list.
                      ;; E: 1 if not XXX-with-esc
                      ;; II: if iso-2022 based, 0..3, else 1.
                      (logior
                       (lsh (if (eq base most-preferred) 1 0) 7)
                       (lsh
                        (let ((mime (coding-system-get base 'mime-charset)))
                           ;; Prefer coding systems corresponding to a
                           ;; MIME charset.
                           (if mime
                               ;; Lower utf-16 priority so that we
                               ;; normally prefer utf-8 to it, and put
                               ;; x-ctext below that.
                               (cond ((string-match "utf-16"
                                                    (symbol-name mime))
                                      2)
                                     ((string-match "^x-" (symbol-name mime))
                                      1)
                                     (t 3))
                             0))
                        5)
                       (lsh (if (memq base lang-preferred) 1 0) 4)
                       (lsh (if (memq base from-categories) 1 0) 3)
                       (lsh (if (string-match "-with-esc\\'"
                                              (symbol-name base))
                                0 1) 2)
                       (if (eq (coding-system-type base) 2)
                           ;; For ISO based coding systems, prefer
                           ;; one that doesn't use escape sequences.
                           (let ((flags (coding-system-flags base)))
                             (if (or (consp (aref flags 0))
                                     (consp (aref flags 1))
                                     (consp (aref flags 2))
                                     (consp (aref flags 3)))
                                 (if (or (aref flags 8) (aref flags 9))
                                     0
                                   1)
                               2))
                         1)))))))
      (sort codings (function (lambda (x y)
                                (> (funcall func x) (funcall func y))))))))

(defun find-coding-systems-region (from to)
  "Return a list of proper coding systems to encode a text between FROM and TO.
If FROM is a string, find coding systems in that instead of the buffer.
All coding systems in the list can safely encode any multibyte characters
in the text.

If the text contains no multibyte characters, return a list of a single
element `undecided'."
  (let ((codings (find-coding-systems-region-internal from to)))
    (if (eq codings t)
        ;; The text contains only ASCII characters.  Any coding
        ;; systems are safe.
        '(undecided)
      ;; We need copy-sequence because sorting will alter the argument.
      (sort-coding-systems (copy-sequence codings)))))

(defun find-coding-systems-string (string)
  "Return a list of proper coding systems to encode STRING.
All coding systems in the list can safely encode any multibyte characters
in STRING.

If STRING contains no multibyte characters, return a list of a single
element `undecided'."
  (find-coding-systems-region string nil))

(defun find-coding-systems-for-charsets (charsets)
  "Return a list of proper coding systems to encode characters of CHARSETS.
CHARSETS is a list of character sets.
It actually checks at most the first 96 characters of each charset.
So, if a charset of dimension two is included in CHARSETS, the value may
contain a coding system that can't encode all characters of the charset."
  (cond ((or (null charsets)
             (and (= (length charsets) 1)
                  (eq 'ascii (car charsets))))
         '(undecided))
        ((or (memq 'eight-bit-control charsets)
             (memq 'eight-bit-graphic charsets))
         '(raw-text emacs-mule))
        (t
         (let ((codings t)
               charset l str)
           (while (and codings charsets)
             (setq charset (car charsets) charsets (cdr charsets))
             (unless (eq charset 'ascii)
               (setq str (make-string 96 32))
               (if (= (charset-dimension charset) 1)
                   (if (= (charset-chars charset) 96)
                       (dotimes (i 96)
                         (aset str i (make-char charset (+ i 32))))
                     (dotimes (i 94)
                       (aset str i (make-char charset (+ i 33)))))
                 (if (= (charset-chars charset) 96)
                     (dotimes (i 96)
                       (aset str i (make-char charset 32 (+ i 32))))
                   (dotimes (i 94)
                     (aset str i (make-char charset 33 (+ i 33))))))
               (setq l (find-coding-systems-string str))
               (if (eq codings t)
                   (setq codings l)
                 (let ((ll nil))
                   (dolist (elt codings)
                     (if (memq elt l)
                         (setq ll (cons elt ll))))
                   (setq codings ll)))))
           codings))))

(defun find-multibyte-characters (from to &optional maxcount excludes)
  "Find multibyte characters in the region specified by FROM and TO.
If FROM is a string, find multibyte characters in the string.
The return value is an alist of the following format:
  ((CHARSET COUNT CHAR ...) ...)
where
  CHARSET is a character set,
  COUNT is a number of characters,
  CHARs are the characters found from the character set.
Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
Optional 4th arg EXCLUDES is a list of character sets to be ignored.

For invalid characters, CHARs are actually strings."
  (let ((chars nil)
        charset char)
    (if (stringp from)
        (let ((idx 0))
          (while (setq idx (string-match "[^\000-\177]" from idx))
            (setq char (aref from idx)
                  charset (char-charset char))
            (if (eq charset 'unknown)
                (setq char (match-string 0)))
            (if (or (memq charset '(unknown
                                    eight-bit-control eight-bit-graphic))
                    (not (or (eq excludes t) (memq charset excludes))))
                (let ((slot (assq charset chars)))
                  (if slot
                      (if (not (memq char (nthcdr 2 slot)))
                          (let ((count (nth 1 slot)))
                            (setcar (cdr slot) (1+ count))
                            (if (or (not maxcount) (< count maxcount))
                                (nconc slot (list char)))))
                    (setq chars (cons (list charset 1 char) chars)))))
            (setq idx (1+ idx))))
      (save-excursion
        (goto-char from)
        (while (re-search-forward "[^\000-\177]" to t)
          (setq char (preceding-char)
                charset (char-charset char))
          (if (eq charset 'unknown)
              (setq char (match-string 0)))
          (if (or (memq charset '(unknown eight-bit-control eight-bit-graphic))
                  (not (or (eq excludes t) (memq charset excludes))))
              (let ((slot (assq charset chars)))
                (if slot
                    (if (not (member char (nthcdr 2 slot)))
                        (let ((count (nth 1 slot)))
                          (setcar (cdr slot) (1+ count))
                          (if (or (not maxcount) (< count maxcount))
                              (nconc slot (list char)))))
                  (setq chars (cons (list charset 1 char) chars))))))))
    (nreverse chars)))


(defun search-unencodable-char (coding-system)
  "Search forward from point for a character that is not encodable.
It asks which coding system to check.
If such a character is found, set point after that character.
Otherwise, don't move point.

When called from a program, the value is the position of the unencodable
character found, or nil if all characters are encodable."
  (interactive
   (list (let ((default (or buffer-file-coding-system 'us-ascii)))
           (read-coding-system
            (format "Coding-system (default %s): " default)
            default))))
  (let ((pos (unencodable-char-position (point) (point-max) coding-system)))
    (if pos
        (goto-char (1+ pos))
      (message "All following characters are encodable by %s" coding-system))
    pos))


(defvar last-coding-system-specified nil
  "Most recent coding system explicitly specified by the user when asked.
This variable is set whenever Emacs asks the user which coding system
to use in order to write a file.  If you set it to nil explicitly,
then call `write-region', then afterward this variable will be non-nil
only if the user was explicitly asked and specified a coding system.")

(defvar select-safe-coding-system-accept-default-p nil
  "If non-nil, a function to control the behavior of coding system selection.
The meaning is the same as the argument ACCEPT-DEFAULT-P of the
function `select-safe-coding-system' (which see).  This variable
overrides that argument.")

(defun select-safe-coding-system-interactively (from to codings unsafe
                                                &optional rejected default)
  "Select interactively a coding system for the region FROM ... TO.
FROM can be a string, as in `write-region'.
CODINGS is the list of base coding systems known to be safe for this region,
  typically obtained with `find-coding-systems-region'.
UNSAFE is a list of coding systems known to be unsafe for this region.
REJECTED is a list of coding systems which were safe but for some reason
  were not recommended in the particular context.
DEFAULT is the coding system to use by default in the query."
  ;; At first, if some defaults are unsafe, record at most 11
  ;; problematic characters and their positions for them by turning
  ;;    (CODING ...)
  ;; into
  ;;    ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
  (if unsafe
      (setq unsafe
            (mapcar #'(lambda (coding)
                        (cons coding
                              (if (stringp from)
                                  (mapcar #'(lambda (pos)
                                              (cons pos (aref from pos)))
                                          (unencodable-char-position
                                           0 (length from) coding
                                           11 from))
                                (mapcar #'(lambda (pos)
                                            (cons pos (char-after pos)))
                                        (unencodable-char-position
                                         from to coding 11)))))
                    unsafe)))

  ;; Change each safe coding system to the corresponding
  ;; mime-charset name if it is also a coding system.  Such a name
  ;; is more friendly to users.
  (let ((l codings)
        mime-charset)
    (while l
      (setq mime-charset (coding-system-get (car l) 'mime-charset))
      (if (and mime-charset (coding-system-p mime-charset))
          (setcar l mime-charset))
      (setq l (cdr l))))

  ;; Don't offer variations with locking shift, which you
  ;; basically never want.
  (let (l)
    (dolist (elt codings (setq codings (nreverse l)))
      (unless (or (eq 'coding-category-iso-7-else
                      (coding-system-category elt))
                  (eq 'coding-category-iso-8-else
                      (coding-system-category elt)))
        (push elt l))))

  ;; Remove raw-text, emacs-mule and no-conversion unless nothing
  ;; else is available.
  (setq codings
        (or (delq 'raw-text
                  (delq 'emacs-mule
                        (delq 'no-conversion codings)))
            '(raw-text emacs-mule no-conversion)))

  (let ((window-configuration (current-window-configuration))
        (bufname (buffer-name))
        coding-system)
    (save-excursion
      ;; If some defaults are unsafe, make sure the offending
      ;; buffer is displayed.
      (when (and unsafe (not (stringp from)))
        (pop-to-buffer bufname)
        (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
                                       unsafe))))
      ;; Then ask users to select one from CODINGS while showing
      ;; the reason why none of the defaults are not used.
      (with-output-to-temp-buffer "*Warning*"
        (with-current-buffer standard-output
          (if (and (null rejected) (null unsafe))
              (insert "No default coding systems to try for "
                      (if (stringp from)
                          (format "string \"%s\"." from)
                        (format "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))
             ":\n")
            (let ((pos (point))
                  (fill-prefix "  "))
              (dolist (x (append rejected unsafe))
                (princ "  ") (princ (car x)))
              (insert "\n")
              (fill-region-as-paragraph pos (point)))
            (when rejected
              (insert "These safely encode the text in the buffer,
but are not recommended for encoding text in this context,
e.g., for sending an email message.\n ")
              (dolist (x rejected)
                (princ " ") (princ x))
              (insert "\n"))
            (when unsafe
              (insert (if rejected "The other coding systems"
                        "However, each of them")
                      " encountered characters it couldn't encode:\n")
              (dolist (coding unsafe)
                (insert (format "  %s cannot encode these:" (car coding)))
                (let ((i 0)
                      (func1
                       #'(lambda (bufname pos)
                           (when (buffer-live-p (get-buffer bufname))
                             (pop-to-buffer bufname)
                             (goto-char pos))))
                      (func2
                       #'(lambda (bufname pos coding)
                           (when (buffer-live-p (get-buffer bufname))
                             (pop-to-buffer bufname)
                             (if (< (point) pos)
                                 (goto-char pos)
                               (forward-char 1)
                               (search-unencodable-char coding)
                               (forward-char -1))))))
                  (dolist (elt (cdr coding))
                    (insert " ")
                    (if (stringp from)
                        (insert (if (< i 10) (cdr elt) "..."))
                      (if (< i 10)
                          (insert-text-button