[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/international/mule-cmds.el
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/international/mule-cmds.el |
|
Date: |
Mon, 08 Nov 2004 18:09:52 -0500 |
Index: emacs/lisp/international/mule-cmds.el
diff -c emacs/lisp/international/mule-cmds.el:1.258
emacs/lisp/international/mule-cmds.el:1.259
*** emacs/lisp/international/mule-cmds.el:1.258 Thu Nov 4 10:10:35 2004
--- emacs/lisp/international/mule-cmds.el Mon Nov 8 23:03:30 2004
***************
*** 1,7 ****
! ;;; mule-cmds.el --- commands for mulitilingual environment -*-coding:
iso-2022-7bit -*-
;; 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
--- 1,8 ----
! ;;; 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.
;; Keywords: mule, multilingual
***************
*** 625,630 ****
--- 626,800 ----
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,727 ****
(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.
--- 891,896 ----
***************
*** 739,910 ****
;; 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)))
(if (vectorp (coding-system-eol-type coding-system))
(let ((eol (coding-system-eol-type buffer-file-coding-system)))
--- 908,915 ----
;; If all the defaults failed, ask a user.
(when (not coding-system)
! (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,1891 ****
?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])
;; The fonts don't have the relevant bug.
(aset standard-display-table 160 nil)
(aset standard-display-table (make-char 'latin-iso8859-1 160)
--- 1889,1896 ----
?3))
;; We suppress these setting for the moment because the
;; above assumption is wrong.
! ;; (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,2570 ****
(substring enc2 0 i2))))
! ;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
;;; mule-cmds.el ends here
--- 2571,2575 ----
(substring enc2 0 i2))))
! ;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
;;; mule-cmds.el ends here