mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-08 15:35:02 +00:00
(select-safe-coding-system-interactively):
New function extracted from select-safe-coding-system. (select-safe-coding-system): Use it.
This commit is contained in:
Stefan Monnier
parent
00912e6c7d
commit
9ee5b74454
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user