Mercurial > emacs
changeset 46857:31feee29e69a
(search-unencodable-char): New
function.
(select-safe-coding-system): Show unencodable characters.
(unencodable-char-position): Deleted, and implemented by C in
coding.c.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Sun, 11 Aug 2002 01:04:41 +0000 |
| parents | eba75fedd593 |
| children | 62112f8664f7 |
| files | lisp/international/mule-cmds.el |
| diffstat | 1 files changed, 144 insertions(+), 103 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/international/mule-cmds.el Sun Aug 11 00:26:24 2002 +0000 +++ b/lisp/international/mule-cmds.el Sun Aug 11 01:04:41 2002 +0000 @@ -548,6 +548,27 @@ (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 a position of the found character, +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 @@ -655,7 +676,30 @@ ;; If all the defaults failed, ask a user. (when (or (not coding-system) (consp coding-system)) - ;; At first, change each coding system to the corresponding + ;; 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) + + ;; 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) @@ -676,75 +720,112 @@ (coding-system-category elt))) (push elt l)))) - (unwind-protect - (save-window-excursion + (let ((window-configuration (current-window-configuration))) + (save-excursion + ;; Make sure the offending buffer is displayed. + (when (and default-coding-system (not (stringp from))) + (pop-to-buffer bufname) + (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x))) + default-coding-system)))) + ;; Then ask users to select one from CODINGS. + (with-output-to-temp-buffer "*Warning*" (save-excursion - ;; Make sure the offending buffer is displayed. - (unless (stringp from) - (pop-to-buffer bufname) - (goto-char (unencodable-char-position - from to (mapcar #'car default-coding-system)))) - ;; Then ask users to select one from CODINGS. - (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 " ")) - (mapcar (function (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)) - "\ + (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 " ")) + (mapcar (function (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)) + "\ but it is not recommended for encoding text in this context, e.g., for sending an email message.\n") - (insert "\ -However, none of them safely encodes the target text. - + (insert "\ +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 + #'(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)))) + 'help-args (list bufname (car elt) + (car coding)))))) + (insert "\n")) + default-coding-system) + (insert "\ The first problematic character is at point in the displayed buffer,\n" - (substitute-command-keys "\ + (substitute-command-keys "\ and \\[universal-argument] \\[what-cursor-position] will give information about it.\n")))) - (insert (if (consp coding-system) - "\nSelect the above, or " - "\nSelect ") - "\ + (insert (if (consp coding-system) + "\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))))) + (let ((pos (point)) + (fill-prefix " ")) + (mapcar (function (lambda (x) (princ " ") (princ x))) + codings) + (insert "\n") + (fill-region-as-paragraph pos (point))))) - ;; Read a coding system. - (if (consp coding-system) - (setq codings (cons (car coding-system) codings))) - (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x))) - codings)) - (name (completing-read - (format "Select coding system (default %s): " - (car codings)) - safe-names nil t nil nil - (car (car safe-names))))) - (setq last-coding-system-specified (intern name) - coding-system last-coding-system-specified))) - (kill-buffer "*Warning*")))) + ;; Read a coding system. + (if (consp coding-system) + (setq codings (cons (car coding-system) codings))) + (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x))) + codings)) + (name (completing-read + (format "Select coding system (default %s): " + (car codings)) + safe-names nil t nil nil + (car (car safe-names))))) + (setq last-coding-system-specified (intern name) + coding-system last-coding-system-specified))) + (kill-buffer "*Warning*") + (set-window-configuration window-configuration))) (if (vectorp (coding-system-eol-type coding-system)) (let ((eol (coding-system-eol-type buffer-file-coding-system))) @@ -780,46 +861,6 @@ (error "Save aborted"))))) coding-system)) -(defun unencodable-char-position (start end coding-system) - "Return position of first un-encodable character in a region. -START and END specfiy the region and CODING-SYSTEM specifies the -encoding to check. Return nil if CODING-SYSTEM does encode the region. - -CODING-SYSTEM may also be a list of coding systems, in which case return -the first position not encodable by any of them. - -This function is fairly slow." - ;; Use recursive calls in the binary chop below, since we're - ;; O(logN), and the call overhead shouldn't be a bottleneck. - (unless enable-multibyte-characters - (error "Unibyte buffer")) - ;; Recurse if list of coding systems. - (if (consp coding-system) - (let ((end end) res) - (dolist (elt coding-system (and res (>= res 0) res)) - (let ((pos (unencodable-char-position start end elt))) - (if pos - (setq end pos - res pos))))) - ;; Skip ASCII initially. - (save-excursion - (goto-char start) - (skip-chars-forward "\000-\177" end) - (setq start (point)) - (unless (= start end) - (setq coding-system (coding-system-base coding-system)) ; canonicalize - (let ((codings (find-coding-systems-region start end))) - (unless (or (equal codings '(undecided)) - (memq coding-system - (find-coding-systems-region start end))) - ;; Binary chop. - (if (= start (1- end)) - start - (or (unencodable-char-position start (/ (+ start end) 2) - coding-system) - (unencodable-char-position (/ (+ start end) 2) end - coding-system))))))))) - (setq select-safe-coding-system-function 'select-safe-coding-system) (defun select-message-coding-system ()