/[emacs]/emacs/lisp/international/mule-cmds.el
ViewVC logotype

Diff of /emacs/lisp/international/mule-cmds.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.258 by rms, Thu Nov 4 10:10:35 2004 UTC revision 1.259 by monnier, Mon Nov 8 23:03:30 2004 UTC
# Line 1  Line 1 
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    
# Line 625  The meaning is the same as the argument Line 626  The meaning is the same as the argument
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.
# Line 721  and TO is ignored." Line 891  and TO is ignored."
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.
# Line 739  and TO is ignored." Line 908  and TO is ignored."
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)))
# Line 1884  specifies the character set for the majo Line 1889  specifies the character set for the majo
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)
# Line 2566  If CODING-SYSTEM can't safely encode CHA Line 2571  If CODING-SYSTEM can't safely encode CHA
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

Legend:
Removed from v.1.258  
changed lines
  Added in v.1.259

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26