1 |
;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*- |
;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: utf-8 -*- |
2 |
|
|
3 |
|
;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. |
4 |
;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN. |
;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN. |
5 |
;; Licensed to the Free Software Foundation. |
;; Licensed to the Free Software Foundation. |
|
;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. |
|
6 |
|
|
7 |
;; Keywords: mule, multilingual |
;; Keywords: mule, multilingual |
8 |
|
|
626 |
function `select-safe-coding-system' (which see). This variable |
function `select-safe-coding-system' (which see). This variable |
627 |
overrides that argument.") |
overrides that argument.") |
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 |
|
|
798 |
(defun select-safe-coding-system (from to &optional default-coding-system |
(defun select-safe-coding-system (from to &optional default-coding-system |
799 |
accept-default-p file) |
accept-default-p file) |
800 |
"Ask a user to select a safe coding system from candidates. |
"Ask a user to select a safe coding system from candidates. |
891 |
|
|
892 |
(let ((codings (find-coding-systems-region from to)) |
(let ((codings (find-coding-systems-region from to)) |
893 |
(coding-system nil) |
(coding-system nil) |
|
(bufname (buffer-name)) |
|
894 |
safe rejected unsafe) |
safe rejected unsafe) |
895 |
(if (eq (car codings) 'undecided) |
(if (eq (car codings) 'undecided) |
896 |
;; Any coding system is ok. |
;; Any coding system is ok. |
908 |
|
|
909 |
;; If all the defaults failed, ask a user. |
;; If all the defaults failed, ask a user. |
910 |
(when (not coding-system) |
(when (not coding-system) |
911 |
;; At first, if some defaults are unsafe, record at most 11 |
(setq coding-system (select-safe-coding-system-interactively |
912 |
;; problematic characters and their positions for them by turning |
from to codings unsafe rejected (car codings)))) |
|
;; (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))) |
|
913 |
|
|
914 |
(if (vectorp (coding-system-eol-type coding-system)) |
(if (vectorp (coding-system-eol-type coding-system)) |
915 |
(let ((eol (coding-system-eol-type buffer-file-coding-system))) |
(let ((eol (coding-system-eol-type buffer-file-coding-system))) |
1889 |
?3)) |
?3)) |
1890 |
;; We suppress these setting for the moment because the |
;; We suppress these setting for the moment because the |
1891 |
;; above assumption is wrong. |
;; above assumption is wrong. |
1892 |
;; (aset standard-display-table ?' [?$,1ry(B]) |
;; (aset standard-display-table ?' [?’]) |
1893 |
;; (aset standard-display-table ?` [?$,1rx(B]) |
;; (aset standard-display-table ?` [?‘]) |
1894 |
;; The fonts don't have the relevant bug. |
;; The fonts don't have the relevant bug. |
1895 |
(aset standard-display-table 160 nil) |
(aset standard-display-table 160 nil) |
1896 |
(aset standard-display-table (make-char 'latin-iso8859-1 160) |
(aset standard-display-table (make-char 'latin-iso8859-1 160) |
2571 |
(substring enc2 0 i2)))) |
(substring enc2 0 i2)))) |
2572 |
|
|
2573 |
|
|
2574 |
;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc |
;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc |
2575 |
;;; mule-cmds.el ends here |
;;; mule-cmds.el ends here |