(select-safe-coding-system): Handle

safe but rejected default coding systems and unsafe default
coding systems differently.

1 files changed, 89 insertions, 78 deletions

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 1f657700fc..7ea2046bb0 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -661,43 +661,48 @@ and TO is ignored."
   (let ((codings (find-coding-systems-region from to))
 	(coding-system nil)
 	(bufname (buffer-name))
-	(l default-coding-system))
+	safe rejected unsafe)
     (if (eq (car codings) 'undecided)
 	;; Any coding system is ok.
 	(setq coding-system t)
-      ;; Try the defaults.
-      (while (and l (not coding-system))
-	(if (memq (cdr (car l)) codings)
-	    (setq coding-system (car (car l)))
-	  (setq l (cdr l))))
-      (if (and coding-system accept-default-p)
-	  (or (funcall accept-default-p coding-system)
-	      (setq coding-system (list coding-system)))))
-
+      ;; Classify the defaults into safe, rejected, and unsafe.
+      (dolist (elt default-coding-system)
+	(if (memq (cdr elt) codings)
+	    (if (and (functionp accept-default-p)
+		     (not (funcall accept-default-p (cdr elt))))
+		(push (car elt) rejected)
+	      (push (car elt) safe))
+	  (push (car elt) unsafe)))
+      (if safe
+	  (setq coding-system (car (last safe)))))
+
+    (setq x (list default-coding-system safe rejected unsafe))
     ;; If all the defaults failed, ask a user.
-    (when (or (not coding-system) (consp coding-system))
-      ;; At first, record at most 11 problematic characters and their
-      ;; positions for each default.
-      (if (stringp from)
-	  (mapc #'(lambda (coding)
-		    (setcdr coding
-			    (mapcar #'(lambda (pos)
-					(cons pos (aref from pos)))
-				    (unencodable-char-position
-				     0 (length from) (car coding) 11 from))))
-		default-coding-system)
-	(mapc #'(lambda (coding)
-		  (setcdr coding
-			  (mapcar #'(lambda (pos)
-				      (cons pos (char-after pos)))
-				  (unencodable-char-position
-				   from to (car coding) 11))))
-	      default-coding-system))
-      ;; If 11 unencodable characters were found, mark the last one as nil.
-      (mapc #'(lambda (coding)
-		(if (> (length coding) 11)
-		    (setcdr (car (last coding)) nil)))
-	    default-coding-system)
+    (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
@@ -722,13 +727,14 @@ and TO is ignored."
 
       (let ((window-configuration (current-window-configuration)))
 	(save-excursion
-	  ;; Make sure the offending buffer is displayed.
-	  (when (and (consp default-coding-system) (not (stringp from)))
+	  ;; If some defaults are unsafe, make sure the offending
+	  ;; buffer is displayed.
+	  (when (and unsafe (not (stringp from)))
 	    (pop-to-buffer bufname)
-	    ;; The `or' is because sometimes (car (cadr x)) is nil.
-	    (goto-char (apply 'min (mapcar #'(lambda (x) (or (car (cadr x)) (point-max)))
-					   default-coding-system))))
-	  ;; Then ask users to select one from CODINGS.
+	    (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)
@@ -747,44 +753,30 @@ and TO is ignored."
 		 ":\n")
 		(let ((pos (point))
 		      (fill-prefix "  "))
-		  (mapcar (function (lambda (x)
-				      (princ "  ") (princ (car x))))
-			  default-coding-system)
+		  (mapc #'(lambda (x) (princ "  ") (princ (car x)))
+			default-coding-system)
 		  (insert "\n")
 		  (fill-region-as-paragraph pos (point)))
-		(if (consp coding-system)
-		    (insert (format "%s safely encodes the target text,\n"
-				    (car coding-system))
-			    "\
+		(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")
-		  (insert "\
-However, each of them encountered these problematic characters:\n")
+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)))
-		       (dolist (elt (cdr coding))
-			 (insert " ")
-			 (if (stringp from)
-			     (insert (or (cdr elt) "..."))
-			   (if (cdr elt)
-			       (insert-text-button
-				(cdr elt)
-				:type 'help-xref
-				'help-echo
-				"mouse-2, RET: jump to this character"
-				'help-function
-				#'(lambda (bufname pos)
-				    (when (buffer-live-p (get-buffer bufname))
-				      (pop-to-buffer bufname)
-				      (goto-char pos)))
-				'help-args (list bufname (car elt)))
-			     (insert-text-button
-			      "..."
-			      :type 'help-xref
-			      'help-echo
-			      "mouse-2, RET: next unencodable character"
-			      'help-function
+		       (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)
@@ -792,16 +784,35 @@ However, each of them encountered these problematic characters:\n")
 					(goto-char pos)
 				      (forward-char 1)
 				      (search-unencodable-char coding)
-				      (forward-char -1))))
-			      'help-args (list bufname (car elt)
-					       (car 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"))
-		   default-coding-system)
+		   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 (consp coding-system)
+	      (insert (if safe
 			  "\nSelect the above, or "
 			"\nSelect ")
 		      "\
@@ -814,8 +825,8 @@ one of the following safe coding systems, or edit the buffer:\n")
 		(fill-region-as-paragraph pos (point)))))
 
 	  ;; Read a coding system.
-	  (if (consp coding-system)
-	      (setq codings (cons (car coding-system) codings)))
+	  (if safe
+	      (setq codings (append safe codings)))
 	  (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x)))
 				     codings))
 		 (name (completing-read