Mercurial > emacs

changeset 58055:005c3ebdd545

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(select-safe-coding-system-interactively): New function extracted from select-safe-coding-system. (select-safe-coding-system): Use it.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Mon, 08 Nov 2004 23:03:30 +0000
parents b40b27d0c034
children 2fc2f5f0917d
files lisp/international/mule-cmds.el
diffstat 1 files changed, 177 insertions(+), 172 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/international/mule-cmds.el	Mon Nov 08 22:30:00 2004 +0000
+++ b/lisp/international/mule-cmds.el	Mon Nov 08 23:03:30 2004 +0000
@@ -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 @@
 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 @@
 
   (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 @@
 
     ;; 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 @@
 		      ?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 @@
       (substring enc2 0 i2))))
 
 
-;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
+;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
 ;;; mule-cmds.el ends here