From c0d3ed9724ae7b8a118565e9a175096b37185726 Mon Sep 17 00:00:00 2001 From: Kenichi Handa Date: Wed, 25 Sep 2002 13:19:59 +0000 Subject: [PATCH] (select-safe-coding-system): Handle safe but rejected default coding systems and unsafe default coding systems differently. --- lisp/international/mule-cmds.el | 167 +++++++++++++++++--------------- 1 file 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 -- 2.39.2