/[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.197 by rms, Tue Jul 23 19:14:36 2002 UTC revision 1.198 by fx, Wed Jul 24 22:20:49 2002 UTC
# Line 269  wrong, use this command again to toggle Line 269  wrong, use this command again to toggle
269                       cmd (key-binding keyseq t))                       cmd (key-binding keyseq t))
270                 (not (eq cmd 'universal-argument-other-key)))                 (not (eq cmd 'universal-argument-other-key)))
271          (let ((current-prefix-arg prefix-arg)          (let ((current-prefix-arg prefix-arg)
272                ;; Have to bind `last-command-char' here so that                ;; Have to bind `last-command-char' here so that
273                ;; `digit-argument', for isntance, can compute the                ;; `digit-argument', for isntance, can compute the
274                ;; prefix arg.                ;; prefix arg.
275                (last-command-char (aref keyseq 0)))                (last-command-char (aref keyseq 0)))
# Line 297  This sets the following coding systems: Line 297  This sets the following coding systems:
297    o coding system of a newly created buffer    o coding system of a newly created buffer
298    o default coding system for subprocess I/O    o default coding system for subprocess I/O
299  This also sets the following values:  This also sets the following values:
300    o default value used as file-name-coding-system for converting file names.    o default value used as `file-name-coding-system' for converting file names.
301    o default value for the command `set-terminal-coding-system' (not on MSDOS)    o default value for the command `set-terminal-coding-system' (not on MSDOS)
302    o default value for the command `set-keyboard-coding-system'."    o default value for the command `set-keyboard-coding-system'."
303    (check-coding-system coding-system)    (check-coding-system coding-system)
# Line 426  non-nil, it is used to sort CODINGS in t Line 426  non-nil, it is used to sort CODINGS in t
426    
427  (defun find-coding-systems-region (from to)  (defun find-coding-systems-region (from to)
428    "Return a list of proper coding systems to encode a text between FROM and TO.    "Return a list of proper coding systems to encode a text between FROM and TO.
429    If FROM is a string, find coding systems in that instead of the buffer.
430  All coding systems in the list can safely encode any multibyte characters  All coding systems in the list can safely encode any multibyte characters
431  in the text.  in the text.
432    
# Line 552  proper one is suggested as the default. Line 553  proper one is suggested as the default.
553  The list of `buffer-file-coding-system' of the current buffer and the  The list of `buffer-file-coding-system' of the current buffer and the
554  most preferred coding system (if it corresponds to a MIME charset) is  most preferred coding system (if it corresponds to a MIME charset) is
555  treated as the default coding system list.  Among them, the first one  treated as the default coding system list.  Among them, the first one
556  that safely encodes the text is silently selected and returned without  that safely encodes the text is normally selected silently and
557  any user interaction.  See also the command `prefer-coding-system'.  returned without any user interaction.  See also the command
558    `prefer-coding-system'.
559    
560    However, the user is queried if the chosen coding system is
561    inconsistent with what would be selected by `set-auto-coding' from
562    coding cookies &c. if the contents of the region were read from a
563    file.  (That could lead to data corruption in a file subsequently
564    re-visited and edited.)
565    
566  Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a  Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
567  list of coding systems to be prepended to the default coding system  list of coding systems to be prepended to the default coding system
# Line 653  and TO is ignored." Line 661  and TO is ignored."
661        ;; Make sure the offending buffer is displayed.        ;; Make sure the offending buffer is displayed.
662        (or (stringp from)        (or (stringp from)
663            (pop-to-buffer bufname))            (pop-to-buffer bufname))
664        ;; Then ask users to select one form CODINGS.        (save-excursion
665        (unwind-protect          (goto-char (unencodable-char-position
666            (save-window-excursion                      from to (mapcar #'car default-coding-system)))
667              (with-output-to-temp-buffer "*Warning*"          ;; Then ask users to select one form CODINGS.
668                (save-excursion          (unwind-protect
669                  (set-buffer standard-output)              (save-window-excursion
670                  (if (not default-coding-system)                (with-output-to-temp-buffer "*Warning*"
671                      (insert "No default coding systems to try for "                  (save-excursion
672                              (if (stringp from)                    (set-buffer standard-output)
673                                  (format "string \"%s\"." from)                    (if (not default-coding-system)
674                                (format "buffer `%s'." bufname)))                        (insert "No default coding systems to try for "
675                    (insert                                (if (stringp from)
676                     "These default coding systems were tried to encode"                                    (format "string \"%s\"." from)
677                     (if (stringp from)                                  (format "buffer `%s'." bufname)))
678                         (concat " \"" (if (> (length from) 10)                      (insert
679                                           (concat (substring from 0 10) "...\"")                       "These default coding systems were tried to encode"
680                                         (concat from "\"")))                       (if (stringp from)
681                       (format " text\nin the buffer `%s'" bufname))                           (concat " \"" (if (> (length from) 10)
682                     ":\n")                                             (concat (substring from 0 10) "...\"")
683                                             (concat from "\"")))
684                           (format " text\nin the buffer `%s'" bufname))
685                         ":\n")
686                        (let ((pos (point))
687                              (fill-prefix "  "))
688                          (mapcar (function (lambda (x)
689                                              (princ "  ") (princ (car x))))
690                                  default-coding-system)
691                          (insert "\n")
692                          (fill-region-as-paragraph pos (point)))
693                        (if (consp coding-system)
694                            (insert (format "%s safely encodes the target text,\n"
695                                            (car coding-system))
696                                    "\
697    but it is not recommended for encoding text in this context,
698    e.g., for sending an email message.\n")
699                          (insert "\
700    However, none of them safely encodes the target text.
701    
702    The first problematic character is at point in the displayed buffer,\n"
703                                  (substitute-command-keys "\
704    and \\[universal-argument] \\[what-cursor-position] will give information about it.\n"))))
705                      (insert (if (consp coding-system)
706                                  "\nSelect the above, or "
707                                "\nSelect ")
708                              "\
709    one of the following safe coding systems, or edit the buffer:\n")
710                    (let ((pos (point))                    (let ((pos (point))
711                          (fill-prefix "  "))                          (fill-prefix "  "))
712                      (mapcar (function (lambda (x)                      (mapcar (function (lambda (x) (princ "  ") (princ x)))
713                                          (princ "  ") (princ (car x))))                              codings)
                             default-coding-system)  
714                      (insert "\n")                      (insert "\n")
715                      (fill-region-as-paragraph pos (point)))                      (fill-region-as-paragraph pos (point)))))
716                    (insert  
717                     (if (consp coding-system)                ;; Read a coding system.
718                         (concat (format "%s safely encodes the target text,\n"                (if (consp coding-system)
719                                         (car coding-system))                    (setq codings (cons (car coding-system) codings)))
720                                 "but it is not recommended for encoding text in this context,\n"                (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x)))
721                                 "e.g., for sending an email message.\n")                                           codings))
722                       "However, none of them safely encodes the target text.\n")))                       (name (completing-read
723                  (insert (if (consp coding-system)                              (format "Select coding system (default %s): "
724                              "\nSelect the above, or "                                      (car codings))
725                            "\nSelect ")                              safe-names nil t nil nil
726                          "one of the following safe coding systems:\n")                              (car (car safe-names)))))
727                  (let ((pos (point))                  (setq last-coding-system-specified (intern name)
728                        (fill-prefix "  "))                        coding-system last-coding-system-specified)))
729                    (mapcar (function (lambda (x) (princ "  ") (princ x)))            (kill-buffer "*Warning*"))))
                           codings)  
                   (insert "\n")  
                   (fill-region-as-paragraph pos (point)))))  
   
             ;; Read a coding system.  
             (if (consp coding-system)  
                 (setq codings (cons (car coding-system) codings)))  
             (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x)))  
                                        codings))  
                    (name (completing-read  
                           (format "Select coding system (default %s): "  
                                   (car codings))  
                           safe-names nil t nil nil  
                           (car (car safe-names)))))  
               (setq last-coding-system-specified (intern name)  
                     coding-system last-coding-system-specified)))  
         (kill-buffer "*Warning*")))  
730    
731      (if (vectorp (coding-system-eol-type coding-system))      (if (vectorp (coding-system-eol-type coding-system))
732          (let ((eol (coding-system-eol-type buffer-file-coding-system)))          (let ((eol (coding-system-eol-type buffer-file-coding-system)))
# Line 732  and TO is ignored." Line 749  and TO is ignored."
749                           (set-auto-coding (or file buffer-file-name "")                           (set-auto-coding (or file buffer-file-name "")
750                                            (buffer-size))))))                                            (buffer-size))))))
751          (if (and auto-cs          (if (and auto-cs
752                     ;; Don't barf if writing a compressed file, say.
753                     ;; This check perhaps isn't ideal, but is probably
754                     ;; the best thing to do.
755                     (not (auto-coding-alist-lookup (or file buffer-file-name "")))
756                   (not (coding-system-equal (coding-system-base coding-system)                   (not (coding-system-equal (coding-system-base coding-system)
757                                             (coding-system-base auto-cs))))                                             (coding-system-base auto-cs))))
758              (unless (yes-or-no-p              (unless (yes-or-no-p
# Line 741  and try again)? " coding-system auto-cs) Line 762  and try again)? " coding-system auto-cs)
762                (error "Save aborted")))))                (error "Save aborted")))))
763      coding-system))      coding-system))
764    
765    (defun unencodable-char-position (start end coding-system)
766      "Return position of first un-encodable character in a region.
767    START and END specfiy the region and CODING-SYSTEM specifies the
768    encoding to check.  Return nil if CODING-SYSTEM does encode the region.
769    
770    CODING-SYSTEM may also be a list of coding systems, in which case return
771    the first position not encodable by any of them.
772    
773    This function is fairly slow."
774      ;; Use recursive calls in the binary chop below, since we're
775      ;; O(logN), and the call overhead shouldn't be a bottleneck.
776      (unless enable-multibyte-characters
777        (error "Unibyte buffer"))
778      ;; Recurse if list of coding systems.
779      (if (consp coding-system)
780          (let ((end end) res)
781            (dolist (elt coding-system (and res (>= res 0) res))
782              (let ((pos (unencodable-char-position start end elt)))
783                (if pos
784                    (setq end pos
785                          res pos)))))
786        ;; Skip ASCII initially.
787        (save-excursion
788          (goto-char start)
789          (skip-chars-forward "\000-\177" end)
790          (setq start (point))
791          (unless (= start end)
792            (setq coding-system (coding-system-base coding-system)) ; canonicalize
793            (let ((codings (find-coding-systems-region start end)))
794              (unless (or (equal codings '(undecided))
795                          (memq coding-system
796                                (find-coding-systems-region start end)))
797                ;; Binary chop.
798                (if (= start (1- end))
799                    start
800                  (or (unencodable-char-position start (/ (+ start end) 2)
801                                                 coding-system)
802                      (unencodable-char-position (/ (+ start end) 2) end
803                                                 coding-system)))))))))
804    
805  (setq select-safe-coding-system-function 'select-safe-coding-system)  (setq select-safe-coding-system-function 'select-safe-coding-system)
806    
807  (defun select-message-coding-system ()  (defun select-message-coding-system ()
# Line 760  it asks the user to select a proper codi Line 821  it asks the user to select a proper codi
821                       default-sendmail-coding-system                       default-sendmail-coding-system
822                       default-buffer-file-coding-system)))                       default-buffer-file-coding-system)))
823      (if (eq coding 'no-conversion)      (if (eq coding 'no-conversion)
824          ;; We should never use no-conversion for outgoing mails.          ;; We should never use no-conversion for outgoing mail.
825          (setq coding nil))          (setq coding nil))
826      (if (fboundp select-safe-coding-system-function)      (if (fboundp select-safe-coding-system-function)
827          (funcall select-safe-coding-system-function          (funcall select-safe-coding-system-function
# Line 783  Meaningful values for KEY include Line 844  Meaningful values for KEY include
844                          is meant for, and how to use it.                          is meant for, and how to use it.
845    charset            value is a list of the character sets used by this    charset            value is a list of the character sets used by this
846                          language environment.                          language environment.
847    sample-text        value is one line of text,    sample-text        value is an expression which is evalled to generate
848                          written using those character sets,                          a line of text written using characters appropriate
849                          appropriate for this language environment.                          for this language environment.
850    setup-function     value is a function to call to switch to this    setup-function     value is a function to call to switch to this
851                          language environment.                          language environment.
852    exit-function      value is a function to call to leave this    exit-function      value is a function to call to leave this
# Line 862  ALIST is an alist of KEY and INFO values Line 923  ALIST is an alist of KEY and INFO values
923  `language-info-alist' for the meanings of KEY and INFO.  `language-info-alist' for the meanings of KEY and INFO.
924    
925  Optional arg PARENTS is a list of parent menu names; it specifies  Optional arg PARENTS is a list of parent menu names; it specifies
926  where to put this language environment in the  where to put this language environment in the
927  Describe Language Environment and Set Language Environment menus.  Describe Language Environment and Set Language Environment menus.
928  For example, (\"European\") means to put this language environment  For example, (\"European\") means to put this language environment
929  in the European submenu in each of those two menus."  in the European submenu in each of those two menus."
# Line 929  This returns a language environment name Line 990  This returns a language environment name
990          name)))          name)))
991    
992  ;;; Multilingual input methods.  ;;; Multilingual input methods.
993  (defgroup leim nil  (defgroup leim nil
994    "LEIM: Libraries of Emacs Input Methods."    "LEIM: Libraries of Emacs Input Methods."
995    :group 'mule)    :group 'mule)
996    
# Line 940  in the format of Lisp expression for reg Line 1001  in the format of Lisp expression for reg
1001  Emacs loads this file at startup time.")  Emacs loads this file at startup time.")
1002    
1003  (defvar leim-list-header (format  (defvar leim-list-header (format
1004  ";;; %s -- list of LEIM (Library of Emacs Input Method)  ";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: iso-2022-7bit;-*-
1005  ;;  ;;
1006  ;; This file contains a list of LEIM (Library of Emacs Input Method)  ;; This file contains a list of LEIM (Library of Emacs Input Method)
1007  ;; methods in the same directory as this file.  Loading this file  ;; methods in the same directory as this file.  Loading this file
# Line 1182  and enable that one.  The default is the Line 1243  and enable that one.  The default is the
1243                default t))                default t))
1244           default))           default))
1245        (unless default-input-method        (unless default-input-method
1246          (prog1          (prog1
1247              (setq default-input-method current-input-method)              (setq default-input-method current-input-method)
1248            (when (interactive-p)            (when (interactive-p)
1249              (customize-mark-as-set 'default-input-method)))))))              (customize-mark-as-set 'default-input-method)))))))
# Line 1207  and enable that one.  The default is the Line 1268  and enable that one.  The default is the
1268                (activate-input-method input-method)                (activate-input-method input-method)
1269                (describe-current-input-method))                (describe-current-input-method))
1270              (activate-input-method current))              (activate-input-method current))
1271          (error          (error
1272           (activate-input-method current)           (activate-input-method current)
1273           (help-setup-xref (list #'describe-input-method input-method)           (help-setup-xref (list #'describe-input-method input-method)
1274                            (interactive-p))                            (interactive-p))
# Line 1273  guidance, but simple input methods give Line 1334  guidance, but simple input methods give
1334  the minibuffer.  the minibuffer.
1335    
1336  See also the variable `input-method-highlight-flag'."  See also the variable `input-method-highlight-flag'."
1337    :type '(choice (const t) (const nil) (const complex-only) (const default))    :type '(choice (const :tag "Always" t) (const :tag "Never" nil)
1338                     (const complex-only) (const default))
1339    :group 'mule)    :group 'mule)
1340    
1341  (defcustom input-method-highlight-flag t  (defcustom input-method-highlight-flag t
# Line 1378  to using the function `set-language-envi Line 1440  to using the function `set-language-envi
1440    
1441  The default status is as follows:  The default status is as follows:
1442    
1443    The default value of buffer-file-coding-system is nil.    The default value of `buffer-file-coding-system' is nil.
1444    The default coding system for process I/O is nil.    The default coding system for process I/O is nil.
1445    The default value for the command `set-terminal-coding-system' is nil.    The default value for the command `set-terminal-coding-system' is nil.
1446    The default value for the command `set-keyboard-coding-system' is nil.    The default value for the command `set-keyboard-coding-system' is nil.
# Line 1429  The default status is as follows: Line 1491  The default status is as follows:
1491       coding-category-iso-7       coding-category-iso-7
1492       coding-category-iso-7-else       coding-category-iso-7-else
1493       coding-category-iso-8-else       coding-category-iso-8-else
1494       coding-category-emacs-mule       coding-category-emacs-mule
1495       coding-category-raw-text       coding-category-raw-text
1496       coding-category-sjis       coding-category-sjis
1497       coding-category-big5       coding-category-big5
# Line 1451  The default status is as follows: Line 1513  The default status is as follows:
1513    (let ((output-coding    (let ((output-coding
1514           ;; When bootstrapping, coding-systems are not defined yet, so           ;; When bootstrapping, coding-systems are not defined yet, so
1515           ;; we need to catch the error from check-coding-system.           ;; we need to catch the error from check-coding-system.
1516           (condition-case nil           (condition-case nil
1517               (coding-system-change-text-conversion               (coding-system-change-text-conversion
1518                (car default-process-coding-system) 'undecided)                (car default-process-coding-system) 'undecided)
1519             (coding-system-error 'undecided)))             (coding-system-error 'undecided)))
# Line 1602  specifies the character set for the majo Line 1664  specifies the character set for the majo
1664    "Do various coding system setups for language environment LANGUAGE-NAME.    "Do various coding system setups for language environment LANGUAGE-NAME.
1665    
1666  The optional arg EOL-TYPE specifies the eol-type of the default value  The optional arg EOL-TYPE specifies the eol-type of the default value
1667  of buffer-file-coding-system set by this function."  of `buffer-file-coding-system' set by this function."
1668    (let* ((priority (get-language-info language-name 'coding-priority))    (let* ((priority (get-language-info language-name 'coding-priority))
1669           (default-coding (car priority)))           (default-coding (car priority)))
1670      (if priority      (if priority
# Line 1618  of buffer-file-coding-system set by this Line 1680  of buffer-file-coding-system set by this
1680              (setq priority (cdr priority) categories (cdr categories)))              (setq priority (cdr priority) categories (cdr categories)))
1681            (update-coding-systems-internal)))))            (update-coding-systems-internal)))))
1682    
 ;; Print all arguments with `princ', then print "\n".  
1683  (defsubst princ-list (&rest args)  (defsubst princ-list (&rest args)
1684      "Print all arguments with `princ', then print \"\n\"."
1685    (while args (princ (car args)) (setq args (cdr args)))    (while args (princ (car args)) (setq args (cdr args)))
1686    (princ "\n"))    (princ "\n"))
1687    
# Line 1763  of buffer-file-coding-system set by this Line 1825  of buffer-file-coding-system set by this
1825      ; bn Bengali, Bangla      ; bn Bengali, Bangla
1826      ("bo" . "Tibetan")      ("bo" . "Tibetan")
1827      ("br" . "Latin-1") ; Breton      ("br" . "Latin-1") ; Breton
1828        ("bs" . "Latin-2") ; Bosnian
1829      ("ca" . "Latin-1") ; Catalan      ("ca" . "Latin-1") ; Catalan
1830      ; co Corsican      ; co Corsican
1831      ("cs" . "Czech")      ("cs" . "Czech")
1832      ("cy" . "Latin-8") ; Welsh      ("cy" . "Welsh") ; Welsh
1833      ("da" . "Latin-1") ; Danish      ("da" . "Latin-1") ; Danish
1834      ("de" . "German")      ("de" . "German")
1835      ; dz Bhutani      ; dz Bhutani
# Line 1777  of buffer-file-coding-system set by this Line 1840  of buffer-file-coding-system set by this
1840      ("es" . "Spanish")      ("es" . "Spanish")
1841      ("et" . "Latin-4") ; Estonian      ("et" . "Latin-4") ; Estonian
1842      ("eu" . "Latin-1") ; Basque      ("eu" . "Latin-1") ; Basque
1843      ; fa Persian      ; fa Persian glibc uses utf-8
1844      ("fi" . "Latin-1") ; Finnish      ("fi" . "Latin-1") ; Finnish
1845      ; fj Fiji      ; fj Fiji
1846      ("fo" . "Latin-1") ; Faroese      ("fo" . "Latin-1") ; Faroese
# Line 1788  of buffer-file-coding-system set by this Line 1851  of buffer-file-coding-system set by this
1851      ("gl" . "Latin-1") ; Galician      ("gl" . "Latin-1") ; Galician
1852      ; gn Guarani      ; gn Guarani
1853      ; gu Gujarati      ; gu Gujarati
1854      ("gv" . "Latin-8") ; Manx Gaelic      ("gv" . "Latin-8") ; Manx Gaelic  glibc uses 8859-1
1855      ; ha Hausa      ; ha Hausa
1856      ("he" . "Hebrew")      ("he" . "Hebrew")
1857      ("hi" . "Devanagari") ; Hindi  glibc uses utf-8      ("hi" . "Devanagari") ; Hindi  glibc uses utf-8
# Line 1886  of buffer-file-coding-system set by this Line 1949  of buffer-file-coding-system set by this
1949      ("uz" . "Latin-1") ; Uzbek      ("uz" . "Latin-1") ; Uzbek
1950      ("vi" . "Vietnamese") ;  glibc uses utf-8      ("vi" . "Vietnamese") ;  glibc uses utf-8
1951      ; vo Volapuk      ; vo Volapuk
1952        ("wa" . "Latin-1") ; Walloon
1953      ; wo Wolof      ; wo Wolof
1954      ; xh Xhosa      ; xh Xhosa
1955      ("yi" . "Windows-1255") ; Yiddish      ("yi" . "Windows-1255") ; Yiddish
# Line 1991  For example, the locale name \"ja_JP.EUC Line 2055  For example, the locale name \"ja_JP.EUC
2055  for Japanese in Japan using the `japanese-iso-8bit' coding-system.  for Japanese in Japan using the `japanese-iso-8bit' coding-system.
2056    
2057  If LOCALE-NAME is nil, its value is taken from the environment  If LOCALE-NAME is nil, its value is taken from the environment
2058  variables LC_ALL, LC_CTYLE and LANG (the first one that is set).  variables LC_ALL, LC_CTYPE and LANG (the first one that is set).
2059    
2060  The locale names supported by your system can typically be found in a  The locale names supported by your system can typically be found in a
2061  directory named `/usr/share/locale' or `/usr/lib/locale'.  LOCALE-NAME  directory named `/usr/share/locale' or `/usr/lib/locale'.  LOCALE-NAME

Legend:
Removed from v.1.197  
changed lines
  Added in v.1.198

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