diff options
| author | Karoly Lorentey | 2004-11-13 18:34:40 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2004-11-13 18:34:40 +0000 |
| commit | e417405015c93c81641f5c4a33ec898b5c353772 (patch) | |
| tree | 017a980c35c8a71c372304418d151e3826f88636 /lisp/international | |
| parent | f590a2a442d19f3a74d7bbd02bbcb4e3239f2327 (diff) | |
| parent | 68d1b30d251b4771f739d20f507cd9523ae3919b (diff) | |
| download | emacs-e417405015c93c81641f5c4a33ec898b5c353772.tar.gz emacs-e417405015c93c81641f5c4a33ec898b5c353772.zip | |
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-673
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-674
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-675
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-676
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-677
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-678
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-679
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-680
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-681
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-682
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-683
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-684
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-685
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-686
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-687
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-688
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-689
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-690
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-691
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-692
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-693
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-69
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-70
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-71
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-267
Diffstat (limited to 'lisp/international')
| -rw-r--r-- | lisp/international/iso-cvt.el | 121 | ||||
| -rw-r--r-- | lisp/international/mule-cmds.el | 343 | ||||
| -rw-r--r-- | lisp/international/mule.el | 2 |
3 files changed, 235 insertions, 231 deletions
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el index b0dffc40f50..d7baabb29c8 100644 --- a/lisp/international/iso-cvt.el +++ b/lisp/international/iso-cvt.el | |||
| @@ -1,7 +1,8 @@ | |||
| 1 | ;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: iso-latin-1 -*- | 1 | ;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: iso-latin-1 -*- |
| 2 | ;; This file was formerly called gm-lingo.el. | 2 | ;; This file was formerly called gm-lingo.el. |
| 3 | 3 | ||
| 4 | ;; Copyright (C) 1993, 1994, 1995, 1996, 1998, 2000 Free Software Foundation, Inc. | 4 | ;; Copyright (C) 1993, 1994, 1995, 1996, 1998, 2000, 2003, 2004 |
| 5 | ;; Free Software Foundation, Inc. | ||
| 5 | 6 | ||
| 6 | ;; Author: Michael Gschwind <mike@vlsivie.tuwien.ac.at> | 7 | ;; Author: Michael Gschwind <mike@vlsivie.tuwien.ac.at> |
| 7 | ;; Keywords: tex, iso, latin, i18n | 8 | ;; Keywords: tex, iso, latin, i18n |
| @@ -828,69 +829,67 @@ Optional arg BUFFER is ignored (for use in `format-alist')." | |||
| 828 | 829 | ||
| 829 | ;;;###autoload | 830 | ;;;###autoload |
| 830 | (defun iso-cvt-define-menu () | 831 | (defun iso-cvt-define-menu () |
| 831 | "Add submenus to the Files menu, to convert to and from various formats." | 832 | "Add submenus to the File menu, to convert to and from various formats." |
| 832 | (interactive) | 833 | (interactive) |
| 833 | 834 | ||
| 834 | (define-key menu-bar-files-menu [load-as-separator] '("--")) | 835 | (let ((load-as-menu-map (make-sparse-keymap "Load As...")) |
| 835 | 836 | (insert-as-menu-map (make-sparse-keymap "Insert As...")) | |
| 836 | (define-key menu-bar-files-menu [load-as] '("Load As..." . load-as)) | 837 | (write-as-menu-map (make-sparse-keymap "Write As...")) |
| 837 | (defvar load-as-menu-map (make-sparse-keymap "Load As...")) | 838 | (translate-to-menu-map (make-sparse-keymap "Translate to...")) |
| 838 | (fset 'load-as load-as-menu-map) | 839 | (translate-from-menu-map (make-sparse-keymap "Translate from...")) |
| 839 | 840 | (menu menu-bar-file-menu)) | |
| 840 | ;;(define-key menu-bar-files-menu [insert-as] '("Insert As..." . insert-as)) | 841 | |
| 841 | (defvar insert-as-menu-map (make-sparse-keymap "Insert As...")) | 842 | (define-key menu [load-as-separator] '("--")) |
| 842 | (fset 'insert-as insert-as-menu-map) | 843 | |
| 843 | 844 | (define-key menu [load-as] '("Load As..." . iso-cvt-load-as)) | |
| 844 | (define-key menu-bar-files-menu [write-as] '("Write As..." . write-as)) | 845 | (fset 'iso-cvt-load-as load-as-menu-map) |
| 845 | (defvar write-as-menu-map (make-sparse-keymap "Write As...")) | 846 | |
| 846 | (fset 'write-as write-as-menu-map) | 847 | ;;(define-key menu [insert-as] '("Insert As..." . iso-cvt-insert-as)) |
| 847 | 848 | (fset 'iso-cvt-insert-as insert-as-menu-map) | |
| 848 | (define-key menu-bar-files-menu [translate-separator] '("--")) | 849 | |
| 849 | 850 | (define-key menu [write-as] '("Write As..." . iso-cvt-write-as)) | |
| 850 | (define-key menu-bar-files-menu [translate-to] '("Translate to..." . translate-to)) | 851 | (fset 'iso-cvt-write-as write-as-menu-map) |
| 851 | (defvar translate-to-menu-map (make-sparse-keymap "Translate to...")) | 852 | |
| 852 | (fset 'translate-to translate-to-menu-map) | 853 | (define-key menu [translate-separator] '("--")) |
| 853 | 854 | ||
| 854 | (define-key menu-bar-files-menu [translate-from] '("Translate from..." . translate-from)) | 855 | (define-key menu [translate-to] '("Translate to..." . iso-cvt-translate-to)) |
| 855 | (defvar translate-from-menu-map (make-sparse-keymap "Translate from...")) | 856 | (fset 'iso-cvt-translate-to translate-to-menu-map) |
| 856 | (fset 'translate-from translate-from-menu-map) | 857 | |
| 857 | 858 | (define-key menu [translate-from] '("Translate from..." . iso-cvt-translate-from)) | |
| 858 | (let ((file-types (reverse format-alist)) | 859 | (fset 'iso-cvt-translate-from translate-from-menu-map) |
| 859 | name | 860 | |
| 860 | str-name) | 861 | (dolist (file-type (reverse format-alist)) |
| 861 | (while file-types | 862 | (let ((name (car file-type)) |
| 862 | (setq name (car (car file-types)) | 863 | (str-name (cadr file-type))) |
| 863 | str-name (car (cdr (car file-types))) | 864 | (if (stringp str-name) |
| 864 | file-types (cdr file-types)) | 865 | (progn |
| 865 | (if (stringp str-name) | 866 | (define-key load-as-menu-map (vector name) |
| 866 | (progn | 867 | (cons str-name |
| 867 | (define-key load-as-menu-map (vector name) | 868 | `(lambda (file) |
| 868 | (cons str-name | 869 | (interactive ,(format "FFind file (as %s): " name)) |
| 869 | `(lambda (file) | 870 | (format-find-file file ',name)))) |
| 870 | (interactive (format "FFind file (as %s): " ,name)) | 871 | (define-key insert-as-menu-map (vector name) |
| 871 | (format-find-file file ',name)))) | 872 | (cons str-name |
| 872 | (define-key insert-as-menu-map (vector name) | 873 | `(lambda (file) |
| 873 | (cons str-name | 874 | (interactive (format "FInsert file (as %s): " ,name)) |
| 874 | `(lambda (file) | 875 | (format-insert-file file ',name)))) |
| 875 | (interactive (format "FInsert file (as %s): " ,name)) | 876 | (define-key write-as-menu-map (vector name) |
| 876 | (format-insert-file file ',name)))) | 877 | (cons str-name |
| 877 | (define-key write-as-menu-map (vector name) | 878 | `(lambda (file) |
| 878 | (cons str-name | 879 | (interactive (format "FWrite file (as %s): " ,name)) |
| 879 | `(lambda (file) | 880 | (format-write-file file ',name)))) |
| 880 | (interactive (format "FWrite file (as %s): " ,name)) | 881 | (define-key translate-to-menu-map (vector name) |
| 881 | (format-write-file file ',name)))) | 882 | (cons str-name |
| 882 | (define-key translate-to-menu-map (vector name) | 883 | `(lambda () |
| 883 | (cons str-name | 884 | (interactive) |
| 884 | `(lambda () | 885 | (format-encode-buffer ',name)))) |
| 885 | (interactive) | 886 | (define-key translate-from-menu-map (vector name) |
| 886 | (format-encode-buffer ',name)))) | 887 | (cons str-name |
| 887 | (define-key translate-from-menu-map (vector name) | 888 | `(lambda () |
| 888 | (cons str-name | 889 | (interactive) |
| 889 | `(lambda () | 890 | (format-decode-buffer ',name)))))))))) |
| 890 | (interactive) | ||
| 891 | (format-decode-buffer ',name))))))))) | ||
| 892 | 891 | ||
| 893 | (provide 'iso-cvt) | 892 | (provide 'iso-cvt) |
| 894 | 893 | ||
| 895 | ;;; arch-tag: 64ae843f-ed0e-43e1-ba50-ffd581b90840 | 894 | ;; arch-tag: 64ae843f-ed0e-43e1-ba50-ffd581b90840 |
| 896 | ;;; iso-cvt.el ends here | 895 | ;;; iso-cvt.el ends here |
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 510a3c9358d..404ee5529f8 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el | |||
| @@ -1,7 +1,8 @@ | |||
| 1 | ;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*- | 1 | ;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*- |
| 2 | |||
| 3 | ;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. | ||
| 2 | ;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN. | 4 | ;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN. |
| 3 | ;; Licensed to the Free Software Foundation. | 5 | ;; Licensed to the Free Software Foundation. |
| 4 | ;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. | ||
| 5 | 6 | ||
| 6 | ;; Keywords: mule, multilingual | 7 | ;; Keywords: mule, multilingual |
| 7 | 8 | ||
| @@ -625,6 +626,175 @@ The meaning is the same as the argument ACCEPT-DEFAULT-P of the | |||
| 625 | function `select-safe-coding-system' (which see). This variable | 626 | function `select-safe-coding-system' (which see). This variable |
| 626 | overrides that argument.") | 627 | overrides that argument.") |
| 627 | 628 | ||
| 629 | (defun select-safe-coding-system-interactively (from to codings unsafe | ||
| 630 | &optional rejected default) | ||
| 631 | "Select interactively a coding system for the region FROM ... TO. | ||
| 632 | FROM can be a string, as in `write-region'. | ||
| 633 | CODINGS is the list of base coding systems known to be safe for this region, | ||
| 634 | typically obtained with `find-coding-systems-region'. | ||
| 635 | UNSAFE is a list of coding systems known to be unsafe for this region. | ||
| 636 | REJECTED is a list of coding systems which were safe but for some reason | ||
| 637 | were not recommended in the particular context. | ||
| 638 | DEFAULT is the coding system to use by default in the query." | ||
| 639 | ;; At first, if some defaults are unsafe, record at most 11 | ||
| 640 | ;; problematic characters and their positions for them by turning | ||
| 641 | ;; (CODING ...) | ||
| 642 | ;; into | ||
| 643 | ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...) | ||
| 644 | (if unsafe | ||
| 645 | (setq unsafe | ||
| 646 | (mapcar #'(lambda (coding) | ||
| 647 | (cons coding | ||
| 648 | (if (stringp from) | ||
| 649 | (mapcar #'(lambda (pos) | ||
| 650 | (cons pos (aref from pos))) | ||
| 651 | (unencodable-char-position | ||
| 652 | 0 (length from) coding | ||
| 653 | 11 from)) | ||
| 654 | (mapcar #'(lambda (pos) | ||
| 655 | (cons pos (char-after pos))) | ||
| 656 | (unencodable-char-position | ||
| 657 | from to coding 11))))) | ||
| 658 | unsafe))) | ||
| 659 | |||
| 660 | ;; Change each safe coding system to the corresponding | ||
| 661 | ;; mime-charset name if it is also a coding system. Such a name | ||
| 662 | ;; is more friendly to users. | ||
| 663 | (let ((l codings) | ||
| 664 | mime-charset) | ||
| 665 | (while l | ||
| 666 | (setq mime-charset (coding-system-get (car l) 'mime-charset)) | ||
| 667 | (if (and mime-charset (coding-system-p mime-charset)) | ||
| 668 | (setcar l mime-charset)) | ||
| 669 | (setq l (cdr l)))) | ||
| 670 | |||
| 671 | ;; Don't offer variations with locking shift, which you | ||
| 672 | ;; basically never want. | ||
| 673 | (let (l) | ||
| 674 | (dolist (elt codings (setq codings (nreverse l))) | ||
| 675 | (unless (or (eq 'coding-category-iso-7-else | ||
| 676 | (coding-system-category elt)) | ||
| 677 | (eq 'coding-category-iso-8-else | ||
| 678 | (coding-system-category elt))) | ||
| 679 | (push elt l)))) | ||
| 680 | |||
| 681 | ;; Remove raw-text, emacs-mule and no-conversion unless nothing | ||
| 682 | ;; else is available. | ||
| 683 | (setq codings | ||
| 684 | (or (delq 'raw-text | ||
| 685 | (delq 'emacs-mule | ||
| 686 | (delq 'no-conversion codings))) | ||
| 687 | '(raw-text emacs-mule no-conversion))) | ||
| 688 | |||
| 689 | (let ((window-configuration (current-window-configuration)) | ||
| 690 | (bufname (buffer-name)) | ||
| 691 | coding-system) | ||
| 692 | (save-excursion | ||
| 693 | ;; If some defaults are unsafe, make sure the offending | ||
| 694 | ;; buffer is displayed. | ||
| 695 | (when (and unsafe (not (stringp from))) | ||
| 696 | (pop-to-buffer bufname) | ||
| 697 | (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x))) | ||
| 698 | unsafe)))) | ||
| 699 | ;; Then ask users to select one from CODINGS while showing | ||
| 700 | ;; the reason why none of the defaults are not used. | ||
| 701 | (with-output-to-temp-buffer "*Warning*" | ||
| 702 | (with-current-buffer standard-output | ||
| 703 | (if (and (null rejected) (null unsafe)) | ||
| 704 | (insert "No default coding systems to try for " | ||
| 705 | (if (stringp from) | ||
| 706 | (format "string \"%s\"." from) | ||
| 707 | (format "buffer `%s'." bufname))) | ||
| 708 | (insert | ||
| 709 | "These default coding systems were tried to encode" | ||
| 710 | (if (stringp from) | ||
| 711 | (concat " \"" (if (> (length from) 10) | ||
| 712 | (concat (substring from 0 10) "...\"") | ||
| 713 | (concat from "\""))) | ||
| 714 | (format " text\nin the buffer `%s'" bufname)) | ||
| 715 | ":\n") | ||
| 716 | (let ((pos (point)) | ||
| 717 | (fill-prefix " ")) | ||
| 718 | (dolist (x (append rejected unsafe)) | ||
| 719 | (princ " ") (princ (car x))) | ||
| 720 | (insert "\n") | ||
| 721 | (fill-region-as-paragraph pos (point))) | ||
| 722 | (when rejected | ||
| 723 | (insert "These safely encodes the target text, | ||
| 724 | but it is not recommended for encoding text in this context, | ||
| 725 | e.g., for sending an email message.\n ") | ||
| 726 | (dolist (x rejected) | ||
| 727 | (princ " ") (princ x)) | ||
| 728 | (insert "\n")) | ||
| 729 | (when unsafe | ||
| 730 | (insert (if rejected "And the others" | ||
| 731 | "However, each of them") | ||
| 732 | " encountered these problematic characters:\n") | ||
| 733 | (dolist (coding unsafe) | ||
| 734 | (insert (format " %s:" (car coding))) | ||
| 735 | (let ((i 0) | ||
| 736 | (func1 | ||
| 737 | #'(lambda (bufname pos) | ||
| 738 | (when (buffer-live-p (get-buffer bufname)) | ||
| 739 | (pop-to-buffer bufname) | ||
| 740 | (goto-char pos)))) | ||
| 741 | (func2 | ||
| 742 | #'(lambda (bufname pos coding) | ||
| 743 | (when (buffer-live-p (get-buffer bufname)) | ||
| 744 | (pop-to-buffer bufname) | ||
| 745 | (if (< (point) pos) | ||
| 746 | (goto-char pos) | ||
| 747 | (forward-char 1) | ||
| 748 | (search-unencodable-char coding) | ||
| 749 | (forward-char -1)))))) | ||
| 750 | (dolist (elt (cdr coding)) | ||
| 751 | (insert " ") | ||
| 752 | (if (stringp from) | ||
| 753 | (insert (if (< i 10) (cdr elt) "...")) | ||
| 754 | (if (< i 10) | ||
| 755 | (insert-text-button | ||
| 756 | (cdr elt) | ||
| 757 | :type 'help-xref | ||
| 758 | 'help-echo | ||
| 759 | "mouse-2, RET: jump to this character" | ||
| 760 | 'help-function func1 | ||
| 761 | 'help-args (list bufname (car elt))) | ||
| 762 | (insert-text-button | ||
| 763 | "..." | ||
| 764 | :type 'help-xref | ||
| 765 | 'help-echo | ||
| 766 | "mouse-2, RET: next unencodable character" | ||
| 767 | 'help-function func2 | ||
| 768 | 'help-args (list bufname (car elt) | ||
| 769 | (car coding))))) | ||
| 770 | (setq i (1+ i)))) | ||
| 771 | (insert "\n")) | ||
| 772 | (insert "\ | ||
| 773 | The first problematic character is at point in the displayed buffer,\n" | ||
| 774 | (substitute-command-keys "\ | ||
| 775 | and \\[universal-argument] \\[what-cursor-position] will give information about it.\n")))) | ||
| 776 | (insert "\nSelect \ | ||
| 777 | one of the following safe coding systems, or edit the buffer:\n") | ||
| 778 | (let ((pos (point)) | ||
| 779 | (fill-prefix " ")) | ||
| 780 | (dolist (x codings) | ||
| 781 | (princ " ") (princ x)) | ||
| 782 | (insert "\n") | ||
| 783 | (fill-region-as-paragraph pos (point))) | ||
| 784 | (insert "Or specify any other coding system | ||
| 785 | at the risk of losing the problematic characters.\n"))) | ||
| 786 | |||
| 787 | ;; Read a coding system. | ||
| 788 | (setq coding-system | ||
| 789 | (read-coding-system | ||
| 790 | (format "Select coding system (default %s): " default) | ||
| 791 | default)) | ||
| 792 | (setq last-coding-system-specified coding-system)) | ||
| 793 | |||
| 794 | (kill-buffer "*Warning*") | ||
| 795 | (set-window-configuration window-configuration) | ||
| 796 | coding-system)) | ||
| 797 | |||
| 628 | (defun select-safe-coding-system (from to &optional default-coding-system | 798 | (defun select-safe-coding-system (from to &optional default-coding-system |
| 629 | accept-default-p file) | 799 | accept-default-p file) |
| 630 | "Ask a user to select a safe coding system from candidates. | 800 | "Ask a user to select a safe coding system from candidates. |
| @@ -721,7 +891,6 @@ and TO is ignored." | |||
| 721 | 891 | ||
| 722 | (let ((codings (find-coding-systems-region from to)) | 892 | (let ((codings (find-coding-systems-region from to)) |
| 723 | (coding-system nil) | 893 | (coding-system nil) |
| 724 | (bufname (buffer-name)) | ||
| 725 | safe rejected unsafe) | 894 | safe rejected unsafe) |
| 726 | (if (eq (car codings) 'undecided) | 895 | (if (eq (car codings) 'undecided) |
| 727 | ;; Any coding system is ok. | 896 | ;; Any coding system is ok. |
| @@ -739,172 +908,8 @@ and TO is ignored." | |||
| 739 | 908 | ||
| 740 | ;; If all the defaults failed, ask a user. | 909 | ;; If all the defaults failed, ask a user. |
| 741 | (when (not coding-system) | 910 | (when (not coding-system) |
| 742 | ;; At first, if some defaults are unsafe, record at most 11 | 911 | (setq coding-system (select-safe-coding-system-interactively |
| 743 | ;; problematic characters and their positions for them by turning | 912 | from to codings unsafe rejected (car codings)))) |
| 744 | ;; (CODING ...) | ||
| 745 | ;; into | ||
| 746 | ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...) | ||
| 747 | (if unsafe | ||
| 748 | (if (stringp from) | ||
| 749 | (setq unsafe | ||
| 750 | (mapcar #'(lambda (coding) | ||
| 751 | (cons coding | ||
| 752 | (mapcar #'(lambda (pos) | ||
| 753 | (cons pos (aref from pos))) | ||
| 754 | (unencodable-char-position | ||
| 755 | 0 (length from) coding | ||
| 756 | 11 from)))) | ||
| 757 | unsafe)) | ||
| 758 | (setq unsafe | ||
| 759 | (mapcar #'(lambda (coding) | ||
| 760 | (cons coding | ||
| 761 | (mapcar #'(lambda (pos) | ||
| 762 | (cons pos (char-after pos))) | ||
| 763 | (unencodable-char-position | ||
| 764 | from to coding 11)))) | ||
| 765 | unsafe)))) | ||
| 766 | |||
| 767 | ;; Change each safe coding system to the corresponding | ||
| 768 | ;; mime-charset name if it is also a coding system. Such a name | ||
| 769 | ;; is more friendly to users. | ||
| 770 | (let ((l codings) | ||
| 771 | mime-charset) | ||
| 772 | (while l | ||
| 773 | (setq mime-charset (coding-system-get (car l) 'mime-charset)) | ||
| 774 | (if (and mime-charset (coding-system-p mime-charset)) | ||
| 775 | (setcar l mime-charset)) | ||
| 776 | (setq l (cdr l)))) | ||
| 777 | |||
| 778 | ;; Don't offer variations with locking shift, which you | ||
| 779 | ;; basically never want. | ||
| 780 | (let (l) | ||
| 781 | (dolist (elt codings (setq codings (nreverse l))) | ||
| 782 | (unless (or (eq 'coding-category-iso-7-else | ||
| 783 | (coding-system-category elt)) | ||
| 784 | (eq 'coding-category-iso-8-else | ||
| 785 | (coding-system-category elt))) | ||
| 786 | (push elt l)))) | ||
| 787 | |||
| 788 | ;; Remove raw-text, emacs-mule and no-conversion unless nothing | ||
| 789 | ;; else is available. | ||
| 790 | (setq codings | ||
| 791 | (or (delq 'raw-text | ||
| 792 | (delq 'emacs-mule | ||
| 793 | (delq 'no-conversion codings))) | ||
| 794 | '(raw-text emacs-mule no-conversion))) | ||
| 795 | |||
| 796 | (let ((window-configuration (current-window-configuration))) | ||
| 797 | (save-excursion | ||
| 798 | ;; If some defaults are unsafe, make sure the offending | ||
| 799 | ;; buffer is displayed. | ||
| 800 | (when (and unsafe (not (stringp from))) | ||
| 801 | (pop-to-buffer bufname) | ||
| 802 | (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x))) | ||
| 803 | unsafe)))) | ||
| 804 | ;; Then ask users to select one from CODINGS while showing | ||
| 805 | ;; the reason why none of the defaults are not used. | ||
| 806 | (with-output-to-temp-buffer "*Warning*" | ||
| 807 | (save-excursion | ||
| 808 | (set-buffer standard-output) | ||
| 809 | (if (not default-coding-system) | ||
| 810 | (insert "No default coding systems to try for " | ||
| 811 | (if (stringp from) | ||
| 812 | (format "string \"%s\"." from) | ||
| 813 | (format "buffer `%s'." bufname))) | ||
| 814 | (insert | ||
| 815 | "These default coding systems were tried to encode" | ||
| 816 | (if (stringp from) | ||
| 817 | (concat " \"" (if (> (length from) 10) | ||
| 818 | (concat (substring from 0 10) "...\"") | ||
| 819 | (concat from "\""))) | ||
| 820 | (format " text\nin the buffer `%s'" bufname)) | ||
| 821 | ":\n") | ||
| 822 | (let ((pos (point)) | ||
| 823 | (fill-prefix " ")) | ||
| 824 | (mapc #'(lambda (x) (princ " ") (princ (car x))) | ||
| 825 | default-coding-system) | ||
| 826 | (insert "\n") | ||
| 827 | (fill-region-as-paragraph pos (point))) | ||
| 828 | (when rejected | ||
| 829 | (insert "These safely encodes the target text, | ||
| 830 | but it is not recommended for encoding text in this context, | ||
| 831 | e.g., for sending an email message.\n ") | ||
| 832 | (mapc #'(lambda (x) (princ " ") (princ x)) rejected) | ||
| 833 | (insert "\n")) | ||
| 834 | (when unsafe | ||
| 835 | (insert (if rejected "And the others" | ||
| 836 | "However, each of them") | ||
| 837 | " encountered these problematic characters:\n") | ||
| 838 | (mapc | ||
| 839 | #'(lambda (coding) | ||
| 840 | (insert (format " %s:" (car coding))) | ||
| 841 | (let ((i 0) | ||
| 842 | (func1 | ||
| 843 | #'(lambda (bufname pos) | ||
| 844 | (when (buffer-live-p (get-buffer bufname)) | ||
| 845 | (pop-to-buffer bufname) | ||
| 846 | (goto-char pos)))) | ||
| 847 | (func2 | ||
| 848 | #'(lambda (bufname pos coding) | ||
| 849 | (when (buffer-live-p (get-buffer bufname)) | ||
| 850 | (pop-to-buffer bufname) | ||
| 851 | (if (< (point) pos) | ||
| 852 | (goto-char pos) | ||
| 853 | (forward-char 1) | ||
| 854 | (search-unencodable-char coding) | ||
| 855 | (forward-char -1)))))) | ||
| 856 | (dolist (elt (cdr coding)) | ||
| 857 | (insert " ") | ||
| 858 | (if (stringp from) | ||
| 859 | (insert (if (< i 10) (cdr elt) "...")) | ||
| 860 | (if (< i 10) | ||
| 861 | (insert-text-button | ||
| 862 | (cdr elt) | ||
| 863 | :type 'help-xref | ||
| 864 | 'help-echo | ||
| 865 | "mouse-2, RET: jump to this character" | ||
| 866 | 'help-function func1 | ||
| 867 | 'help-args (list bufname (car elt))) | ||
| 868 | (insert-text-button | ||
| 869 | "..." | ||
| 870 | :type 'help-xref | ||
| 871 | 'help-echo | ||
| 872 | "mouse-2, RET: next unencodable character" | ||
| 873 | 'help-function func2 | ||
| 874 | 'help-args (list bufname (car elt) | ||
| 875 | (car coding))))) | ||
| 876 | (setq i (1+ i)))) | ||
| 877 | (insert "\n")) | ||
| 878 | unsafe) | ||
| 879 | (insert "\ | ||
| 880 | The first problematic character is at point in the displayed buffer,\n" | ||
| 881 | (substitute-command-keys "\ | ||
| 882 | and \\[universal-argument] \\[what-cursor-position] will give information about it.\n")))) | ||
| 883 | (insert (if safe | ||
| 884 | "\nSelect the above, or " | ||
| 885 | "\nSelect ") | ||
| 886 | "\ | ||
| 887 | one of the following safe coding systems, or edit the buffer:\n") | ||
| 888 | (let ((pos (point)) | ||
| 889 | (fill-prefix " ")) | ||
| 890 | (mapcar (function (lambda (x) (princ " ") (princ x))) | ||
| 891 | codings) | ||
| 892 | (insert "\n") | ||
| 893 | (fill-region-as-paragraph pos (point))) | ||
| 894 | (insert "Or specify any other coding system | ||
| 895 | at the risk of losing the problematic characters.\n"))) | ||
| 896 | |||
| 897 | ;; Read a coding system. | ||
| 898 | (setq default-coding-system (or (car safe) (car codings))) | ||
| 899 | (setq coding-system | ||
| 900 | (read-coding-system | ||
| 901 | (format "Select coding system (default %s): " | ||
| 902 | default-coding-system) | ||
| 903 | default-coding-system)) | ||
| 904 | (setq last-coding-system-specified coding-system)) | ||
| 905 | |||
| 906 | (kill-buffer "*Warning*") | ||
| 907 | (set-window-configuration window-configuration))) | ||
| 908 | 913 | ||
| 909 | (if (vectorp (coding-system-eol-type coding-system)) | 914 | (if (vectorp (coding-system-eol-type coding-system)) |
| 910 | (let ((eol (coding-system-eol-type buffer-file-coding-system))) | 915 | (let ((eol (coding-system-eol-type buffer-file-coding-system))) |
| @@ -2627,5 +2632,5 @@ If CODING-SYSTEM can't safely encode CHAR, return nil." | |||
| 2627 | (substring enc2 0 i2)))) | 2632 | (substring enc2 0 i2)))) |
| 2628 | 2633 | ||
| 2629 | 2634 | ||
| 2630 | ;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc | 2635 | ;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc |
| 2631 | ;;; mule-cmds.el ends here | 2636 | ;;; mule-cmds.el ends here |
diff --git a/lisp/international/mule.el b/lisp/international/mule.el index f5294fea92f..9136a257ee1 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el | |||
| @@ -2126,7 +2126,7 @@ This function is intended to be added to `auto-coding-functions'." | |||
| 2126 | (save-excursion | 2126 | (save-excursion |
| 2127 | (forward-line 10) | 2127 | (forward-line 10) |
| 2128 | (point)))) | 2128 | (point)))) |
| 2129 | (when (and (search-forward "<html>" size t) | 2129 | (when (and (search-forward "<html" size t) |
| 2130 | (re-search-forward "<meta\\s-+http-equiv=\"content-type\"\\s-+content=\"text/\\sw+;\\s-*charset=\\(.+?\\)\"" size t)) | 2130 | (re-search-forward "<meta\\s-+http-equiv=\"content-type\"\\s-+content=\"text/\\sw+;\\s-*charset=\\(.+?\\)\"" size t)) |
| 2131 | (let* ((match (match-string 1)) | 2131 | (let* ((match (match-string 1)) |
| 2132 | (sym (intern (downcase match)))) | 2132 | (sym (intern (downcase match)))) |