(select-safe-coding-system-interactively):

New function extracted from select-safe-coding-system.
(select-safe-coding-system): Use it.

1 files changed, 177 insertions, 172 deletions

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 448144d6b28..12a4f036373 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1,7 +1,8 @@
-;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*-
+;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: utf-8 -*-
+
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004  Free Software Foundation, Inc.
 ;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
 ;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
 
 ;; Keywords: mule, multilingual
 
@@ -625,6 +626,175 @@ 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 encodes the target text,
+but it is 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 "And the others"
+                        "However, each of them")
+                      " encountered these problematic characters:\n")
+              (dolist (coding unsafe)
+                (insert (format "  %s:" (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
+                           (cdr elt)
+                           :type 'help-xref
+                           'help-echo
+                           "mouse-2, RET: jump to this character"
+                           'help-function func1
+                           'help-args (list bufname (car elt)))
+                        (insert-text-button
+                         "..."
+                         :type 'help-xref
+                         'help-echo
+                         "mouse-2, RET: next unencodable character"
+                         'help-function func2
+                         'help-args (list bufname (car elt)
+                                          (car coding)))))
+                    (setq i (1+ i))))
+                (insert "\n"))
+              (insert "\
+The first problematic character is at point in the displayed buffer,\n"
+                      (substitute-command-keys "\
+and \\[universal-argument] \\[what-cursor-position] will give information about it.\n"))))
+          (insert "\nSelect \
+one of the following safe coding systems, or edit the buffer:\n")
+          (let ((pos (point))
+                (fill-prefix "  "))
+            (dolist (x codings)
+              (princ "  ") (princ x))
+            (insert "\n")
+            (fill-region-as-paragraph pos (point)))
+          (insert "Or specify any other coding system
+at the risk of losing the problematic characters.\n")))
+
+      ;; Read a coding system.
+      (setq coding-system
+            (read-coding-system
+             (format "Select coding system (default %s): " default)
+             default))
+      (setq last-coding-system-specified coding-system))
+
+    (kill-buffer "*Warning*")
+    (set-window-configuration window-configuration)
+    coding-system))
+
 (defun select-safe-coding-system (from to &optional default-coding-system
                                        accept-default-p file)
   "Ask a user to select a safe coding system from candidates.
@@ -721,7 +891,6 @@ and TO is ignored."
 
   (let ((codings (find-coding-systems-region from to))
         (coding-system nil)
-        (bufname (buffer-name))
         safe rejected unsafe)
     (if (eq (car codings) 'undecided)
         ;; Any coding system is ok.
@@ -739,172 +908,8 @@ and TO is ignored."
 
     ;; If all the defaults failed, ask a user.
     (when (not coding-system)
-      ;; 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
-          (if (stringp from)
-              (setq unsafe
-                    (mapcar #'(lambda (coding)
-                                (cons coding
-                                      (mapcar #'(lambda (pos)
-                                                  (cons pos (aref from pos)))
-                                              (unencodable-char-position
-                                               0 (length from) coding
-                                               11 from))))
-                            unsafe))
-            (setq unsafe
-                  (mapcar #'(lambda (coding)
-                              (cons coding
-                                    (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)))
-        (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*"
-            (save-excursion
-              (set-buffer standard-output)
-              (if (not default-coding-system)
-                  (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 "  "))
-                  (mapc #'(lambda (x) (princ "  ") (princ (car x)))
-                        default-coding-system)
-                  (insert "\n")
-                  (fill-region-as-paragraph pos (point)))
-                (when rejected
-                  (insert "These safely encodes the target text,
-but it is not recommended for encoding text in this context,
-e.g., for sending an email message.\n ")
-                  (mapc #'(lambda (x) (princ " ") (princ x)) rejected)
-                  (insert "\n"))
-                (when unsafe
-                  (insert (if rejected "And the others"
-                            "However, each of them")
-                          " encountered these problematic characters:\n")
-                  (mapc
-                   #'(lambda (coding)
-                       (insert (format "  %s:" (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
-                                  (cdr elt)
-                                  :type 'help-xref
-                                  'help-echo
-                                  "mouse-2, RET: jump to this character"
-                                  'help-function func1
-                                  'help-args (list bufname (car elt)))
-                               (insert-text-button
-                                "..."
-                                :type 'help-xref
-                                'help-echo
-                                "mouse-2, RET: next unencodable character"
-                                'help-function func2
-                                'help-args (list bufname (car elt)
-                                                 (car coding)))))
-                           (setq i (1+ i))))
-                       (insert "\n"))
-                   unsafe)
-                  (insert "\
-The first problematic character is at point in the displayed buffer,\n"
-                          (substitute-command-keys "\
-and \\[universal-argument] \\[what-cursor-position] will give information about it.\n"))))
-              (insert (if safe
-                          "\nSelect the above, or "
-                        "\nSelect ")
-                      "\
-one of the following safe coding systems, or edit the buffer:\n")
-              (let ((pos (point))
-                    (fill-prefix "  "))
-                (mapcar (function (lambda (x) (princ "  ") (princ x)))
-                        codings)
-                (insert "\n")
-                (fill-region-as-paragraph pos (point)))
-              (insert "Or specify any other coding system
-at the risk of losing the problematic characters.\n")))
-
-          ;; Read a coding system.
-          (setq default-coding-system (or (car safe) (car codings)))
-          (setq coding-system
-                (read-coding-system
-                 (format "Select coding system (default %s): "
-                         default-coding-system)
-                 default-coding-system))
-          (setq last-coding-system-specified coding-system))
-
-        (kill-buffer "*Warning*")
-        (set-window-configuration window-configuration)))
+      (setq coding-system (select-safe-coding-system-interactively
+                           from to codings unsafe rejected (car codings))))
 
     (if (vectorp (coding-system-eol-type coding-system))
         (let ((eol (coding-system-eol-type buffer-file-coding-system)))
@@ -1884,8 +1889,8 @@ specifies the character set for the major languages of Western Europe."
                       ?3))
           ;; We suppress these setting for the moment because the
           ;; above assumption is wrong.
-          ;; (aset standard-display-table ?' [?$,1ry(B])
-          ;; (aset standard-display-table ?` [?$,1rx(B])
+          ;; (aset standard-display-table ?' [?’])
+          ;; (aset standard-display-table ?` [?‘])
           ;; The fonts don't have the relevant bug.
           (aset standard-display-table 160 nil)
           (aset standard-display-table (make-char 'latin-iso8859-1 160)
@@ -2566,5 +2571,5 @@ If CODING-SYSTEM can't safely encode CHAR, return nil."
       (substring enc2 0 i2))))
 
 
-;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
+;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
 ;;; mule-cmds.el ends here