/[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.194 by rms, Mon Jun 3 22:55:26 2002 UTC revision 1.194.2.1 by miles, Fri Apr 4 06:20:22 2003 UTC
# Line 1  Line 1 
1  ;;; mule-cmds.el --- commands for mulitilingual environment  ;;; mule-cmds.el --- commands for mulitilingual environment
   
2  ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.  ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
3  ;; Licensed to the Free Software Foundation.  ;; Licensed to the Free Software Foundation.
4  ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
5    
6  ;; Keywords: mule, multilingual  ;; Keywords: mule, multilingual
7    
# Line 38  Line 37 
37  (define-key ctl-x-map "\C-m" mule-keymap)  (define-key ctl-x-map "\C-m" mule-keymap)
38    
39  (define-key mule-keymap "f" 'set-buffer-file-coding-system)  (define-key mule-keymap "f" 'set-buffer-file-coding-system)
40    (define-key mule-keymap "r" 'revert-buffer-with-coding-system)
41    (define-key mule-keymap "F" 'set-file-name-coding-system)
42  (define-key mule-keymap "t" 'set-terminal-coding-system)  (define-key mule-keymap "t" 'set-terminal-coding-system)
43  (define-key mule-keymap "k" 'set-keyboard-coding-system)  (define-key mule-keymap "k" 'set-keyboard-coding-system)
44  (define-key mule-keymap "p" 'set-buffer-process-coding-system)  (define-key mule-keymap "p" 'set-buffer-process-coding-system)
# Line 113  Line 114 
114                :help "Display multilingual environment settings")                :help "Display multilingual environment settings")
115    t)    t)
116    
 (define-key-after set-coding-system-map [set-buffer-file-coding-system]  
   '(menu-item "For Saving this Buffer" set-buffer-file-coding-system  
               :help "How to encode this buffer on disk")  
   t)  
117  (define-key-after set-coding-system-map [universal-coding-system-argument]  (define-key-after set-coding-system-map [universal-coding-system-argument]
118    '(menu-item "For Next Command" universal-coding-system-argument    '(menu-item "For Next Command" universal-coding-system-argument
119                :help "Coding system to be used by next command")                :help "Coding system to be used by next command")
120    t)    t)
121  (define-key-after set-coding-system-map [set-terminal-coding-system]  (define-key-after set-coding-system-map [separator-1]
122    '(menu-item "For Terminal" set-terminal-coding-system    '("--")
123                :enable (null (memq window-system '(x w32 mac)))    t)
124                :help "How to encode terminal output")  (define-key-after set-coding-system-map [set-buffer-file-coding-system]
125      '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
126                  :help "How to encode this buffer when saved")
127      t)
128    (define-key-after set-coding-system-map [revert-buffer-with-coding-system]
129      '(menu-item "For Reverting This File Now" revert-buffer-with-coding-system
130                  :enable buffer-file-name
131                  :help "Revisit this file immediately using specified coding system")
132      t)
133    (define-key-after set-coding-system-map [set-file-name-coding-system]
134      '(menu-item "For File Name" set-file-name-coding-system
135                  :help "How to decode/encode file names")
136      t)
137    (define-key-after set-coding-system-map [separator-2]
138      '("--")
139    t)    t)
140    
141  (define-key-after set-coding-system-map [set-keyboard-coding-system]  (define-key-after set-coding-system-map [set-keyboard-coding-system]
142    '(menu-item "For Keyboard" set-keyboard-coding-system    '(menu-item "For Keyboard" set-keyboard-coding-system
143                :help "How to decode keyboard input")                :help "How to decode keyboard input")
144    t)    t)
145  (define-key-after set-coding-system-map [set-buffer-process-coding-system]  (define-key-after set-coding-system-map [set-terminal-coding-system]
146    '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system    '(menu-item "For Terminal" set-terminal-coding-system
147                :visible (fboundp 'start-process)                :enable (null (memq window-system '(x w32 mac)))
148                :enable (get-buffer-process (current-buffer))                :help "How to encode terminal output")
149                :help "How to en/decode I/O from/to subprocess connected to this buffer")    t)
150    (define-key-after set-coding-system-map [separator-3]
151      '("--")
152    t)    t)
153  (define-key-after set-coding-system-map [set-selection-coding-system]  (define-key-after set-coding-system-map [set-selection-coding-system]
154    '(menu-item "For X Selections/Clipboard" set-selection-coding-system    '(menu-item "For X Selections/Clipboard" set-selection-coding-system
# Line 146  Line 160 
160                :visible (display-selections-p)                :visible (display-selections-p)
161                :help "How to en/decode next selection/clipboard operation")                :help "How to en/decode next selection/clipboard operation")
162    t)    t)
163    (define-key-after set-coding-system-map [set-buffer-process-coding-system]
164      '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
165                  :visible (fboundp 'start-process)
166                  :enable (get-buffer-process (current-buffer))
167                  :help "How to en/decode I/O from/to subprocess connected to this buffer")
168      t)
169    
170    
171  (define-key setup-language-environment-map  (define-key setup-language-environment-map
172    [Default] '(menu-item "Default" setup-specified-language-environment))    [Default] '(menu-item "Default" setup-specified-language-environment))
173    
# Line 241  wrong, use this command again to toggle Line 263  wrong, use this command again to toggle
263    ;; We have to decode the file in any environment.    ;; We have to decode the file in any environment.
264    (let ((default-enable-multibyte-characters t)    (let ((default-enable-multibyte-characters t)
265          (coding-system-for-read 'iso-2022-7bit))          (coding-system-for-read 'iso-2022-7bit))
266      (find-file-read-only (expand-file-name "HELLO" data-directory))))      (view-file (expand-file-name "HELLO" data-directory))))
267    
268  (defun universal-coding-system-argument ()  (defun universal-coding-system-argument (coding-system)
269    "Execute an I/O command using the specified coding system."    "Execute an I/O command using the specified coding system."
270    (interactive)    (interactive
271    (let* ((default (and buffer-file-coding-system     (let ((default (and buffer-file-coding-system
272                         (not (eq (coding-system-type buffer-file-coding-system)                         (not (eq (coding-system-type buffer-file-coding-system)
273                                  t))                                  t))
274                         buffer-file-coding-system))                         buffer-file-coding-system)))
275           (coding-system (read-coding-system       (list (read-coding-system
276                           (if default              (if default
277                               (format "Coding system for following command (default, %s): " default)                  (format "Coding system for following command (default, %s): " default)
278                             "Coding system for following command: ")                "Coding system for following command: ")
279                           default))              default))))
280           (keyseq (read-key-sequence    (let* ((keyseq (read-key-sequence
281                    (format "Command to execute with %s:" coding-system)))                    (format "Command to execute with %s:" coding-system)))
282           (cmd (key-binding keyseq))           (cmd (key-binding keyseq))
283           prefix)           prefix)
284    
285      (when (eq cmd 'universal-argument)      (when (eq cmd 'universal-argument)
286        (call-interactively cmd)        (call-interactively cmd)
287          
288        ;; Process keys bound in `universal-argument-map'.        ;; Process keys bound in `universal-argument-map'.
289        (while (progn        (while (progn
290                 (setq keyseq (read-key-sequence nil t)                 (setq keyseq (read-key-sequence nil t)
291                       cmd (key-binding keyseq t))                       cmd (key-binding keyseq t))
292                 (not (eq cmd 'universal-argument-other-key)))                 (not (eq cmd 'universal-argument-other-key)))
293          (let ((current-prefix-arg prefix-arg)          (let ((current-prefix-arg prefix-arg)
294                ;; Have to bind `last-command-char' here so that                ;; Have to bind `last-command-char' here so that
295                ;; `digit-argument', for isntance, can compute the                ;; `digit-argument', for isntance, can compute the
296                ;; prefix arg.                ;; prefix arg.
297                (last-command-char (aref keyseq 0)))                (last-command-char (aref keyseq 0)))
# Line 279  wrong, use this command again to toggle Line 301  wrong, use this command again to toggle
301        ;; set's the final `prefix-arg.        ;; set's the final `prefix-arg.
302        (let ((current-prefix-arg prefix-arg))        (let ((current-prefix-arg prefix-arg))
303          (call-interactively cmd))          (call-interactively cmd))
304            
305        ;; Read the command to execute with the given prefix arg.        ;; Read the command to execute with the given prefix arg.
306        (setq prefix prefix-arg        (setq prefix prefix-arg
307              keyseq (read-key-sequence nil t)              keyseq (read-key-sequence nil t)
# Line 287  wrong, use this command again to toggle Line 309  wrong, use this command again to toggle
309    
310      (let ((coding-system-for-read coding-system)      (let ((coding-system-for-read coding-system)
311            (coding-system-for-write coding-system)            (coding-system-for-write coding-system)
312              (coding-system-require-warning t)
313            (current-prefix-arg prefix))            (current-prefix-arg prefix))
314        (message "")        (message "")
315        (call-interactively cmd))))        (call-interactively cmd))))
# Line 297  This sets the following coding systems: Line 320  This sets the following coding systems:
320    o coding system of a newly created buffer    o coding system of a newly created buffer
321    o default coding system for subprocess I/O    o default coding system for subprocess I/O
322  This also sets the following values:  This also sets the following values:
323    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.
324    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)
325    o default value for the command `set-keyboard-coding-system'."    o default value for the command `set-keyboard-coding-system'."
326    (check-coding-system coding-system)    (check-coding-system coding-system)
# Line 401  non-nil, it is used to sort CODINGS in t Line 424  non-nil, it is used to sort CODINGS in t
424                      (let ((base (coding-system-base x)))                      (let ((base (coding-system-base x)))
425                        (+ (if (eq base most-preferred) 64 0)                        (+ (if (eq base most-preferred) 64 0)
426                           (let ((mime (coding-system-get base 'mime-charset)))                           (let ((mime (coding-system-get base 'mime-charset)))
427                               ;; Prefer coding systems corresponding to a
428                               ;; MIME charset.
429                             (if mime                             (if mime
430                                 (if (string-match "^x-" (symbol-name mime))                                 ;; Lower utf-16 priority so that we
431                                     16 32)                                 ;; normally prefer utf-8 to it, and put
432                                   ;; x-ctext below that.
433                                   (cond ((or (eq base 'mule-utf-16-le)
434                                              (eq base 'mule-utf-16-be))
435                                          16)
436                                         ((string-match "^x-" (symbol-name mime))
437                                          8)
438                                         (t 32))
439                               0))                               0))
440                           (if (memq base lang-preferred) 8 0)                           (if (memq base lang-preferred) 8 0)
441                           (if (string-match "-with-esc$" (symbol-name base))                           (if (string-match "-with-esc\\'" (symbol-name base))
442                               0 4)                               0 4)
443                           (if (eq (coding-system-type base) 2)                           (if (eq (coding-system-type base) 2)
444                               ;; For ISO based coding systems, prefer                               ;; For ISO based coding systems, prefer
# Line 426  non-nil, it is used to sort CODINGS in t Line 458  non-nil, it is used to sort CODINGS in t
458    
459  (defun find-coding-systems-region (from to)  (defun find-coding-systems-region (from to)
460    "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.
461    If FROM is a string, find coding systems in that instead of the buffer.
462  All coding systems in the list can safely encode any multibyte characters  All coding systems in the list can safely encode any multibyte characters
463  in the text.  in the text.
464    
# Line 450  element `undecided'." Line 483  element `undecided'."
483    
484  (defun find-coding-systems-for-charsets (charsets)  (defun find-coding-systems-for-charsets (charsets)
485    "Return a list of proper coding systems to encode characters of CHARSETS.    "Return a list of proper coding systems to encode characters of CHARSETS.
486  CHARSETS is a list of character sets."  CHARSETS is a list of character sets.
487    It actually checks at most the first 96 characters of each charset.
488    So, if a charset of dimension two is included in CHARSETS, the value may
489    contain a coding system that can't encode all characters of the charset."
490    (cond ((or (null charsets)    (cond ((or (null charsets)
491               (and (= (length charsets) 1)               (and (= (length charsets) 1)
492                    (eq 'ascii (car charsets))))                    (eq 'ascii (car charsets))))
# Line 460  CHARSETS is a list of character sets." Line 496  CHARSETS is a list of character sets."
496           '(raw-text emacs-mule))           '(raw-text emacs-mule))
497          (t          (t
498           (let ((codings t)           (let ((codings t)
499                 charset l ll)                 charset l str)
500             (while (and codings charsets)             (while (and codings charsets)
501               (setq charset (car charsets) charsets (cdr charsets))               (setq charset (car charsets) charsets (cdr charsets))
502               (unless (eq charset 'ascii)               (unless (eq charset 'ascii)
503                 (setq l (aref char-coding-system-table (make-char charset)))                 (setq str (make-string 96 32))
504                   (if (= (charset-dimension charset) 1)
505                       (if (= (charset-chars charset) 96)
506                           (dotimes (i 96)
507                             (aset str i (make-char charset (+ i 32))))
508                         (dotimes (i 94)
509                           (aset str i (make-char charset (+ i 33)))))
510                     (if (= (charset-chars charset) 96)
511                         (dotimes (i 96)
512                           (aset str i (make-char charset 32 (+ i 32))))
513                       (dotimes (i 94)
514                         (aset str i (make-char charset 33 (+ i 33))))))
515                   (setq l (find-coding-systems-string str))
516                 (if (eq codings t)                 (if (eq codings t)
517                     (setq codings l)                     (setq codings l)
518                   (let ((ll nil))                   (let ((ll nil))
519                     (while codings                     (dolist (elt codings)
520                       (if (memq (car codings) l)                       (if (memq elt l)
521                           (setq ll (cons (car codings) ll)))                           (setq ll (cons elt ll))))
                      (setq codings (cdr codings)))  
522                     (setq codings ll)))))                     (setq codings ll)))))
523             (append codings             codings))))
                    (char-table-extra-slot char-coding-system-table 0))))))  
524    
525  (defun find-multibyte-characters (from to &optional maxcount excludes)  (defun find-multibyte-characters (from to &optional maxcount excludes)
526    "Find multibyte characters in the region specified by FROM and TO.    "Find multibyte characters in the region specified by FROM and TO.
# Line 529  For invalid characters, CHARs are actual Line 575  For invalid characters, CHARs are actual
575                    (setq chars (cons (list charset 1 char) chars))))))))                    (setq chars (cons (list charset 1 char) chars))))))))
576      (nreverse chars)))      (nreverse chars)))
577    
578    
579    (defun search-unencodable-char (coding-system)
580      "Search forward from point for a character that is not encodable.
581    It asks which coding system to check.
582    If such a character is found, set point after that character.
583    Otherwise, don't move point.
584    
585    When called from a program, the value is a position of the found character,
586    or nil if all characters are encodable."
587      (interactive
588       (list (let ((default (or buffer-file-coding-system 'us-ascii)))
589               (read-coding-system
590                (format "Coding-system (default, %s): " default)
591                default))))
592      (let ((pos (unencodable-char-position (point) (point-max) coding-system)))
593        (if pos
594            (goto-char (1+ pos))
595          (message "All following characters are encodable by %s" coding-system))
596        pos))
597    
598    
599  (defvar last-coding-system-specified nil  (defvar last-coding-system-specified nil
600    "Most recent coding system explicitly specified by the user when asked.    "Most recent coding system explicitly specified by the user when asked.
601  This variable is set whenever Emacs asks the user which coding system  This variable is set whenever Emacs asks the user which coding system
# Line 552  proper one is suggested as the default. Line 619  proper one is suggested as the default.
619  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
620  most preferred coding system (if it corresponds to a MIME charset) is  most preferred coding system (if it corresponds to a MIME charset) is
621  treated as the default coding system list.  Among them, the first one  treated as the default coding system list.  Among them, the first one
622  that safely encodes the text is silently selected and returned without  that safely encodes the text is normally selected silently and
623  any user interaction.  See also the command `prefer-coding-system'.  returned without any user interaction.  See also the command
624    `prefer-coding-system'.
625    
626    However, the user is queried if the chosen coding system is
627    inconsistent with what would be selected by `set-auto-coding' from
628    coding cookies &c. if the contents of the region were read from a
629    file.  (That could lead to data corruption in a file subsequently
630    re-visited and edited.)
631    
632  Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a  Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
633  list of coding systems to be prepended to the default coding system  list of coding systems to be prepended to the default coding system
634  list.  list.  However, if DEFAULT-CODING-SYSTEM is a list and the first
635    element is t, the cdr part is used as the defualt coding system list,
636    i.e. `buffer-file-coding-system' and the most prepended coding system
637    is not used.
638    
639  Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to  Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to
640  determine the acceptability of the silently selected coding system.  determine the acceptability of the silently selected coding system.
# Line 577  and TO is ignored." Line 654  and TO is ignored."
654             (not (listp default-coding-system)))             (not (listp default-coding-system)))
655        (setq default-coding-system (list default-coding-system)))        (setq default-coding-system (list default-coding-system)))
656    
657    ;; Change elements of the list to (coding . base-coding).    (let ((no-other-defaults nil))
658    (setq default-coding-system      (if (eq (car default-coding-system) t)
659          (mapcar (function (lambda (x) (cons x (coding-system-base x))))          (setq no-other-defaults t
660                  default-coding-system))                default-coding-system (cdr default-coding-system)))
661    
662    ;; If buffer-file-coding-system is not nil nor undecided, append it      ;; Change elements of the list to (coding . base-coding).
663    ;; to the defaults.      (setq default-coding-system
664    (if buffer-file-coding-system            (mapcar (function (lambda (x) (cons x (coding-system-base x))))
665        (let ((base (coding-system-base buffer-file-coding-system)))                    default-coding-system))
666          (or (eq base 'undecided)  
667              (assq buffer-file-coding-system default-coding-system)      (unless no-other-defaults
668              (rassq base default-coding-system)        ;; If buffer-file-coding-system is not nil nor undecided, append it
669              (setq default-coding-system        ;; to the defaults.
670                    (append default-coding-system        (if buffer-file-coding-system
671                            (list (cons buffer-file-coding-system base)))))))            (let ((base (coding-system-base buffer-file-coding-system)))
672                (or (eq base 'undecided)
673    ;; If the most preferred coding system has the property mime-charset,                  (rassq base default-coding-system)
674    ;; append it to the defaults.                  (setq default-coding-system
675    (let ((tail coding-category-list)                        (append default-coding-system
676          preferred base)                                (list (cons buffer-file-coding-system base)))))))
677      (while (and tail  
678                  (not (setq preferred (symbol-value (car tail)))))        ;; If the most preferred coding system has the property mime-charset,
679        (setq tail (cdr tail)))        ;; append it to the defaults.
680      (and (coding-system-p preferred)        (let ((tail coding-category-list)
681           (setq base (coding-system-base preferred))              preferred base)
682           (coding-system-get preferred 'mime-charset)          (while (and tail
683           (not (assq preferred default-coding-system))                      (not (setq preferred (symbol-value (car tail)))))
684           (not (rassq base default-coding-system))            (setq tail (cdr tail)))
685           (setq default-coding-system          (and (coding-system-p preferred)
686                 (append default-coding-system (list (cons preferred base))))))               (setq base (coding-system-base preferred))
687                 (coding-system-get preferred 'mime-charset)
688                 (not (rassq base default-coding-system))
689                 (setq default-coding-system
690                       (append default-coding-system
691                               (list (cons preferred base))))))))
692    
693    (if select-safe-coding-system-accept-default-p    (if select-safe-coding-system-accept-default-p
694        (setq accept-default-p select-safe-coding-system-accept-default-p))        (setq accept-default-p select-safe-coding-system-accept-default-p))
# Line 614  and TO is ignored." Line 696  and TO is ignored."
696    (let ((codings (find-coding-systems-region from to))    (let ((codings (find-coding-systems-region from to))
697          (coding-system nil)          (coding-system nil)
698          (bufname (buffer-name))          (bufname (buffer-name))
699          (l default-coding-system))          safe rejected unsafe)
700      (if (eq (car codings) 'undecided)      (if (eq (car codings) 'undecided)
701          ;; Any coding system is ok.          ;; Any coding system is ok.
702          (setq coding-system t)          (setq coding-system t)
703        ;; Try the defaults.        ;; Classify the defaults into safe, rejected, and unsafe.
704        (while (and l (not coding-system))        (dolist (elt default-coding-system)
705          (if (memq (cdr (car l)) codings)          (if (memq (cdr elt) codings)
706              (setq coding-system (car (car l)))              (if (and (functionp accept-default-p)
707            (setq l (cdr l))))                       (not (funcall accept-default-p (cdr elt))))
708        (if (and coding-system accept-default-p)                  (push (car elt) rejected)
709            (or (funcall accept-default-p coding-system)                (push (car elt) safe))
710                (setq coding-system (list coding-system)))))            (push (car elt) unsafe)))
711          (if safe
712              (setq coding-system (car (last safe)))))
713    
714      ;; If all the defaults failed, ask a user.      ;; If all the defaults failed, ask a user.
715      (when (or (not coding-system) (consp coding-system))      (when (not coding-system)
716        ;; At first, change each coding system to the corresponding        ;; At first, if some defaults are unsafe, record at most 11
717          ;; problematic characters and their positions for them by turning
718          ;;        (CODING ...)
719          ;; into
720          ;;        ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
721          (if unsafe
722              (if (stringp from)
723                  (setq unsafe
724                        (mapcar #'(lambda (coding)
725                                    (cons coding
726                                          (mapcar #'(lambda (pos)
727                                                      (cons pos (aref from pos)))
728                                                  (unencodable-char-position
729                                                   0 (length from) coding
730                                                   11 from))))
731                                unsafe))
732                (setq unsafe
733                      (mapcar #'(lambda (coding)
734                                  (cons coding
735                                        (mapcar #'(lambda (pos)
736                                                    (cons pos (char-after pos)))
737                                                (unencodable-char-position
738                                                 from to coding 11))))
739                              unsafe))))
740    
741          ;; Change each safe coding system to the corresponding
742        ;; mime-charset name if it is also a coding system.  Such a name        ;; mime-charset name if it is also a coding system.  Such a name
743        ;; is more friendly to users.        ;; is more friendly to users.
744        (let ((l codings)        (let ((l codings)
# Line 650  and TO is ignored." Line 759  and TO is ignored."
759                            (coding-system-category elt)))                            (coding-system-category elt)))
760              (push elt l))))              (push elt l))))
761    
762        ;; Make sure the offending buffer is displayed.        ;; Remove raw-text, emacs-mule and no-conversion unless nothing
763        (or (stringp from)        ;; else is available.
764            (pop-to-buffer bufname))        (setq codings
765        ;; Then ask users to select one form CODINGS.              (or (delq 'raw-text
766        (unwind-protect                        (delq 'emacs-mule
767            (save-window-excursion                              (delq 'no-conversion codings)))
768              (with-output-to-temp-buffer "*Warning*"                  '(raw-text emacs-mule no-conversion)))
769                (save-excursion  
770                  (set-buffer standard-output)        (let ((window-configuration (current-window-configuration)))
771                  (if (not default-coding-system)          (save-excursion
772                      (insert "No default coding systems to try for "            ;; If some defaults are unsafe, make sure the offending
773                              (if (stringp from)            ;; buffer is displayed.
774                                  (format "string \"%s\"." from)            (when (and unsafe (not (stringp from)))
775                                (format "buffer `%s'." bufname)))              (pop-to-buffer bufname)
776                    (insert              (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
777                     "These default coding systems were tried to encode"                                             unsafe))))
778                     (if (stringp from)            ;; Then ask users to select one from CODINGS while showing
779                         (concat " \"" (if (> (length from) 10)            ;; the reason why none of the defaults are not used.
780                                           (concat (substring from 0 10) "...\"")            (with-output-to-temp-buffer "*Warning*"
781                                         (concat from "\"")))              (save-excursion
782                       (format " text\nin the buffer `%s'" bufname))                (set-buffer standard-output)
783                     ":\n")                (if (not default-coding-system)
784                    (let ((pos (point))                    (insert "No default coding systems to try for "
785                          (fill-prefix "  "))                            (if (stringp from)
786                      (mapcar (function (lambda (x)                                (format "string \"%s\"." from)
787                                          (princ "  ") (princ (car x))))                              (format "buffer `%s'." bufname)))
788                              default-coding-system)                  (insert
789                      (insert "\n")                   "These default coding systems were tried to encode"
790                      (fill-region-as-paragraph pos (point)))                   (if (stringp from)
791                    (insert                       (concat " \"" (if (> (length from) 10)
792                     (if (consp coding-system)                                         (concat (substring from 0 10) "...\"")
793                         (concat (format "%s safely encodes the target text,\n"                                       (concat from "\"")))
794                                         (car coding-system))                     (format " text\nin the buffer `%s'" bufname))
795                                 "but it is not recommended for encoding text in this context,\n"                   ":\n")
                                "e.g., for sending an email message.\n")  
                      "However, none of them safely encodes the target text.\n")))  
                 (insert (if (consp coding-system)  
                             "\nSelect the above, or "  
                           "\nSelect ")  
                         "one of the following safe coding systems:\n")  
796                  (let ((pos (point))                  (let ((pos (point))
797                        (fill-prefix "  "))                        (fill-prefix "  "))
798                    (mapcar (function (lambda (x) (princ "  ") (princ x)))                    (mapc #'(lambda (x) (princ "  ") (princ (car x)))
799                            codings)                          default-coding-system)
800                    (insert "\n")                    (insert "\n")
801                    (fill-region-as-paragraph pos (point)))))                    (fill-region-as-paragraph pos (point)))
802                    (when rejected
803                      (insert "These safely encodes the target text,
804    but it is not recommended for encoding text in this context,
805    e.g., for sending an email message.\n ")
806                      (mapc #'(lambda (x) (princ " ") (princ x)) rejected)
807                      (insert "\n"))
808                    (when unsafe
809                      (insert (if rejected "And the others"
810                                "However, each of them")
811                              " encountered these problematic characters:\n")
812                      (mapc
813                       #'(lambda (coding)
814                           (insert (format "  %s:" (car coding)))
815                           (let ((i 0)
816                                 (func1
817                                  #'(lambda (bufname pos)
818                                      (when (buffer-live-p (get-buffer bufname))
819                                        (pop-to-buffer bufname)
820                                        (goto-char pos))))
821                                 (func2
822                                  #'(lambda (bufname pos coding)
823                                      (when (buffer-live-p (get-buffer bufname))
824                                        (pop-to-buffer bufname)
825                                        (if (< (point) pos)
826                                            (goto-char pos)
827                                          (forward-char 1)
828                                          (search-unencodable-char coding)
829                                          (forward-char -1))))))
830                             (dolist (elt (cdr coding))
831                               (insert " ")
832                               (if (stringp from)
833                                   (insert (if (< i 10) (cdr elt) "..."))
834                                 (if (< i 10)
835                                     (insert-text-button
836                                      (cdr elt)
837                                      :type 'help-xref
838                                      'help-echo
839                                      "mouse-2, RET: jump to this character"
840                                      'help-function func1
841                                      'help-args (list bufname (car elt)))
842                                   (insert-text-button
843                                    "..."
844                                    :type 'help-xref
845                                    'help-echo
846                                    "mouse-2, RET: next unencodable character"
847                                    'help-function func2
848                                    'help-args (list bufname (car elt)
849                                                     (car coding)))))
850                               (setq i (1+ i))))
851                           (insert "\n"))
852                       unsafe)
853                      (insert "\
854    The first problematic character is at point in the displayed buffer,\n"
855                              (substitute-command-keys "\
856    and \\[universal-argument] \\[what-cursor-position] will give information about it.\n"))))
857                  (insert (if safe
858                              "\nSelect the above, or "
859                            "\nSelect ")
860                          "\
861    one of the following safe coding systems, or edit the buffer:\n")
862                  (let ((pos (point))
863                        (fill-prefix "  "))
864                    (mapcar (function (lambda (x) (princ "  ") (princ x)))
865                            codings)
866                    (insert "\n")
867                    (fill-region-as-paragraph pos (point)))
868                  (insert "Or specify any other coding system
869    on your risk of losing the problematic characters.\n")))
870    
871              ;; Read a coding system.
872              (setq default-coding-system (or (car safe) (car codings)))
873              (setq coding-system
874                    (read-coding-system
875                     (format "Select coding system (default %s): "
876                             default-coding-system)
877                     default-coding-system))
878              (setq last-coding-system-specified coding-system))
879    
880              ;; Read a coding system.          (kill-buffer "*Warning*")
881              (if (consp coding-system)          (set-window-configuration window-configuration)))
                 (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*")))  
882    
883      (if (vectorp (coding-system-eol-type coding-system))      (if (vectorp (coding-system-eol-type coding-system))
884          (let ((eol (coding-system-eol-type buffer-file-coding-system)))          (let ((eol (coding-system-eol-type buffer-file-coding-system)))
# Line 721  and TO is ignored." Line 890  and TO is ignored."
890          (setq coding-system buffer-file-coding-system))          (setq coding-system buffer-file-coding-system))
891      ;; Check we're not inconsistent with what `coding:' spec &c would      ;; Check we're not inconsistent with what `coding:' spec &c would
892      ;; give when file is re-read.      ;; give when file is re-read.
893      (unless (stringp from)      ;; But don't do this if we explicitly ignored the cookie
894        ;; by using `find-file-literally'.
895        (unless (or (stringp from) find-file-literally)
896        (let ((auto-cs (save-excursion        (let ((auto-cs (save-excursion
897                         (save-restriction                         (save-restriction
898                           (widen)                           (widen)
# Line 729  and TO is ignored." Line 900  and TO is ignored."
900                           (goto-char (point-min))                           (goto-char (point-min))
901                           (set-auto-coding (or file buffer-file-name "")                           (set-auto-coding (or file buffer-file-name "")
902                                            (buffer-size))))))                                            (buffer-size))))))
903          (if (and auto-cs          (if (and auto-cs coding-system
904                     ;; Don't barf if writing a compressed file, say.
905                     ;; This check perhaps isn't ideal, but is probably
906                     ;; the best thing to do.
907                     (not (auto-coding-alist-lookup (or file buffer-file-name "")))
908                   (not (coding-system-equal (coding-system-base coding-system)                   (not (coding-system-equal (coding-system-base coding-system)
909                                             (coding-system-base auto-cs))))                                             (coding-system-base auto-cs))))
910              (unless (yes-or-no-p              (unless (yes-or-no-p
# Line 758  it asks the user to select a proper codi Line 933  it asks the user to select a proper codi
933                       default-sendmail-coding-system                       default-sendmail-coding-system
934                       default-buffer-file-coding-system)))                       default-buffer-file-coding-system)))
935      (if (eq coding 'no-conversion)      (if (eq coding 'no-conversion)
936          ;; We should never use no-conversion for outgoing mails.          ;; We should never use no-conversion for outgoing mail.
937          (setq coding nil))          (setq coding nil))
938      (if (fboundp select-safe-coding-system-function)      (if (fboundp select-safe-coding-system-function)
939          (funcall select-safe-coding-system-function          (funcall select-safe-coding-system-function
# Line 781  Meaningful values for KEY include Line 956  Meaningful values for KEY include
956                          is meant for, and how to use it.                          is meant for, and how to use it.
957    charset            value is a list of the character sets used by this    charset            value is a list of the character sets used by this
958                          language environment.                          language environment.
959    sample-text        value is one line of text,    sample-text        value is an expression which is evalled to generate
960                          written using those character sets,                          a line of text written using characters appropriate
961                          appropriate for this language environment.                          for this language environment.
962    setup-function     value is a function to call to switch to this    setup-function     value is a function to call to switch to this
963                          language environment.                          language environment.
964    exit-function      value is a function to call to leave this    exit-function      value is a function to call to leave this
# Line 852  see `language-info-alist'." Line 1027  see `language-info-alist'."
1027          (progn          (progn
1028            (setq key-slot (list key))            (setq key-slot (list key))
1029            (setcdr lang-slot (cons key-slot (cdr lang-slot)))))            (setcdr lang-slot (cons key-slot (cdr lang-slot)))))
1030      (setcdr key-slot (purecopy info))))      (setcdr key-slot (purecopy info))
1031        ;; Update the custom-type of `current-language-environment'.
1032        (put 'current-language-environment 'custom-type
1033             (cons 'choice (mapcar
1034                            (lambda (lang)
1035                              (list 'const lang))
1036                            (sort (mapcar 'car language-info-alist) 'string<))))))
1037    
1038  (defun set-language-info-alist (lang-env alist &optional parents)  (defun set-language-info-alist (lang-env alist &optional parents)
1039    "Store ALIST as the definition of language environment LANG-ENV.    "Store ALIST as the definition of language environment LANG-ENV.
# Line 860  ALIST is an alist of KEY and INFO values Line 1041  ALIST is an alist of KEY and INFO values
1041  `language-info-alist' for the meanings of KEY and INFO.  `language-info-alist' for the meanings of KEY and INFO.
1042    
1043  Optional arg PARENTS is a list of parent menu names; it specifies  Optional arg PARENTS is a list of parent menu names; it specifies
1044  where to put this language environment in the  where to put this language environment in the
1045  Describe Language Environment and Set Language Environment menus.  Describe Language Environment and Set Language Environment menus.
1046  For example, (\"European\") means to put this language environment  For example, (\"European\") means to put this language environment
1047  in the European submenu in each of those two menus."  in the European submenu in each of those two menus."
# Line 927  This returns a language environment name Line 1108  This returns a language environment name
1108          name)))          name)))
1109    
1110  ;;; Multilingual input methods.  ;;; Multilingual input methods.
1111  (defgroup leim nil  (defgroup leim nil
1112    "LEIM: Libraries of Emacs Input Methods."    "LEIM: Libraries of Emacs Input Methods."
1113    :group 'mule)    :group 'mule)
1114    
# Line 938  in the format of Lisp expression for reg Line 1119  in the format of Lisp expression for reg
1119  Emacs loads this file at startup time.")  Emacs loads this file at startup time.")
1120    
1121  (defvar leim-list-header (format  (defvar leim-list-header (format
1122  ";;; %s -- list of LEIM (Library of Emacs Input Method)  ";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: iso-2022-7bit;-*-
1123  ;;  ;;
1124  ;; This file contains a list of LEIM (Library of Emacs Input Method)  ;; This file contains a list of LEIM (Library of Emacs Input Method)
1125  ;; methods in the same directory as this file.  Loading this file  ;; methods in the same directory as this file.  Loading this file
# Line 1180  and enable that one.  The default is the Line 1361  and enable that one.  The default is the
1361                default t))                default t))
1362           default))           default))
1363        (unless default-input-method        (unless default-input-method
1364          (prog1          (prog1
1365              (setq default-input-method current-input-method)              (setq default-input-method current-input-method)
1366            (when (interactive-p)            (when (interactive-p)
1367              (customize-mark-as-set 'default-input-method)))))))              (customize-mark-as-set 'default-input-method)))))))
# Line 1205  and enable that one.  The default is the Line 1386  and enable that one.  The default is the
1386                (activate-input-method input-method)                (activate-input-method input-method)
1387                (describe-current-input-method))                (describe-current-input-method))
1388              (activate-input-method current))              (activate-input-method current))
1389          (error          (error
1390           (activate-input-method current)           (activate-input-method current)
1391           (help-setup-xref (list #'describe-input-method input-method)           (help-setup-xref (list #'describe-input-method input-method)
1392                            (interactive-p))                            (interactive-p))
# Line 1271  guidance, but simple input methods give Line 1452  guidance, but simple input methods give
1452  the minibuffer.  the minibuffer.
1453    
1454  See also the variable `input-method-highlight-flag'."  See also the variable `input-method-highlight-flag'."
1455    :type '(choice (const t) (const nil) (const complex-only) (const default))    :type '(choice (const :tag "Always" t) (const :tag "Never" nil)
1456                     (const complex-only) (const default))
1457    :group 'mule)    :group 'mule)
1458    
1459  (defcustom input-method-highlight-flag t  (defcustom input-method-highlight-flag t
# Line 1364  to using the function `set-language-envi Line 1546  to using the function `set-language-envi
1546                            current-language-environment)                            current-language-environment)
1547                          language-info-alist))                          language-info-alist))
1548               "English"))               "English"))
1549    :type (cons 'choice (mapcar (lambda (lang)    ;; custom type will be updated with `set-language-info'.
1550                                  (list 'const (car lang)))    :type (if language-info-alist
1551                                language-info-alist))              (cons 'choice (mapcar
1552                               (lambda (lang)
1553                                 (list 'const lang))
1554                               (sort (mapcar 'car language-info-alist) 'string<)))
1555              'string)
1556    :initialize 'custom-initialize-default    :initialize 'custom-initialize-default
1557    :group 'mule    :group 'mule)
   :type 'string)  
1558    
1559  (defun reset-language-environment ()  (defun reset-language-environment ()
1560    "Reset multilingual environment of Emacs to the default status.    "Reset multilingual environment of Emacs to the default status.
1561    
1562  The default status is as follows:  The default status is as follows:
1563    
1564    The default value of buffer-file-coding-system is nil.    The default value of `buffer-file-coding-system' is nil.
1565    The default coding system for process I/O is nil.    The default coding system for process I/O is nil.
1566    The default value for the command `set-terminal-coding-system' is nil.    The default value for the command `set-terminal-coding-system' is nil.
1567    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 1427  The default status is as follows: Line 1612  The default status is as follows:
1612       coding-category-iso-7       coding-category-iso-7
1613       coding-category-iso-7-else       coding-category-iso-7-else
1614       coding-category-iso-8-else       coding-category-iso-8-else
1615       coding-category-emacs-mule       coding-category-emacs-mule
1616       coding-category-raw-text       coding-category-raw-text
1617       coding-category-sjis       coding-category-sjis
1618       coding-category-big5       coding-category-big5
# Line 1441  The default status is as follows: Line 1626  The default status is as follows:
1626    
1627    (set-default-coding-systems nil)    (set-default-coding-systems nil)
1628    (setq default-sendmail-coding-system 'iso-latin-1)    (setq default-sendmail-coding-system 'iso-latin-1)
1629      (setq default-file-name-coding-system 'iso-latin-1)
1630    ;; Preserve eol-type from existing default-process-coding-systems.    ;; Preserve eol-type from existing default-process-coding-systems.
1631    ;; On non-unix-like systems in particular, these may have been set    ;; On non-unix-like systems in particular, these may have been set
1632    ;; carefully by the user, or by the startup code, to deal with the    ;; carefully by the user, or by the startup code, to deal with the
# Line 1449  The default status is as follows: Line 1635  The default status is as follows:
1635    (let ((output-coding    (let ((output-coding
1636           ;; When bootstrapping, coding-systems are not defined yet, so           ;; When bootstrapping, coding-systems are not defined yet, so
1637           ;; we need to catch the error from check-coding-system.           ;; we need to catch the error from check-coding-system.
1638           (condition-case nil           (condition-case nil
1639               (coding-system-change-text-conversion               (coding-system-change-text-conversion
1640                (car default-process-coding-system) 'undecided)                (car default-process-coding-system) 'undecided)
1641             (coding-system-error 'undecided)))             (coding-system-error 'undecided)))
# Line 1506  specifies the character set for the majo Line 1692  specifies the character set for the majo
1692                             default-buffer-file-coding-system)))                             default-buffer-file-coding-system)))
1693      (reset-language-environment)      (reset-language-environment)
1694    
1695      ;; The fetaures might set up coding systems.      ;; The features might set up coding systems.
1696      (let ((required-features (get-language-info language-name 'features)))      (let ((required-features (get-language-info language-name 'features)))
1697        (while required-features        (while required-features
1698          (require (car required-features))          (require (car required-features))
# Line 1600  specifies the character set for the majo Line 1786  specifies the character set for the majo
1786    "Do various coding system setups for language environment LANGUAGE-NAME.    "Do various coding system setups for language environment LANGUAGE-NAME.
1787    
1788  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
1789  of buffer-file-coding-system set by this function."  of `buffer-file-coding-system' set by this function."
1790    (let* ((priority (get-language-info language-name 'coding-priority))    (let* ((priority (get-language-info language-name 'coding-priority))
1791           (default-coding (car priority)))           (default-coding (car priority)))
1792      (if priority      (if priority
# Line 1616  of buffer-file-coding-system set by this Line 1802  of buffer-file-coding-system set by this
1802              (setq priority (cdr priority) categories (cdr categories)))              (setq priority (cdr priority) categories (cdr categories)))
1803            (update-coding-systems-internal)))))            (update-coding-systems-internal)))))
1804    
 ;; Print all arguments with `princ', then print "\n".  
1805  (defsubst princ-list (&rest args)  (defsubst princ-list (&rest args)
1806      "Print all arguments with `princ', then print \"\n\"."
1807    (while args (princ (car args)) (setq args (cdr args)))    (while args (princ (car args)) (setq args (cdr args)))
1808    (princ "\n"))    (princ "\n"))
1809    
# Line 1754  of buffer-file-coding-system set by this Line 1940  of buffer-file-coding-system set by this
1940      ; ay Aymara      ; ay Aymara
1941      ; az Azerbaijani      ; az Azerbaijani
1942      ; ba Bashkir      ; ba Bashkir
1943      ("be" . "Belarussian") ; Belarussian [Byelorussian]      ("be" . "Belarusian") ; Belarusian [Byelorussian until early 1990s]
1944      ("bg" . "Bulgarian") ; Bulgarian      ("bg" . "Bulgarian") ; Bulgarian
1945      ; bh Bihari      ; bh Bihari
1946      ; bi Bislama      ; bi Bislama
1947      ; bn Bengali, Bangla      ; bn Bengali, Bangla
1948      ("bo" . "Tibetan")      ("bo" . "Tibetan")
1949      ("br" . "Latin-1") ; Breton      ("br" . "Latin-1") ; Breton
1950        ("bs" . "Latin-2") ; Bosnian
1951      ("ca" . "Latin-1") ; Catalan      ("ca" . "Latin-1") ; Catalan
1952      ; co Corsican      ; co Corsican
1953      ("cs" . "Czech")      ("cs" . "Czech")
1954      ("cy" . "Latin-8") ; Welsh      ("cy" . "Welsh") ; Welsh [glibc uses Latin-8.  Did this change?]
1955      ("da" . "Latin-1") ; Danish      ("da" . "Latin-1") ; Danish
1956      ("de" . "German")      ("de" . "German")
1957      ; dz Bhutani      ; dz Bhutani
1958      ("el" . "Greek")      ("el" . "Greek")
1959      ;; Users who specify "en" explicitly typically want Latin-1, not ASCII.      ;; Users who specify "en" explicitly typically want Latin-1, not ASCII.
1960        ;; That's actually what the GNU locales define, modulo things like
1961        ;; en_IN -- fx.
1962      ("en" . "Latin-1") ; English      ("en" . "Latin-1") ; English
1963      ("eo" . "Latin-3") ; Esperanto      ("eo" . "Latin-3") ; Esperanto
1964      ("es" . "Spanish")      ("es" . "Spanish")
1965      ("et" . "Latin-4") ; Estonian      ("et" . "Latin-4") ; Estonian
1966      ("eu" . "Latin-1") ; Basque      ("eu" . "Latin-1") ; Basque
1967      ; fa Persian      ; fa Persian glibc uses utf-8
1968      ("fi" . "Latin-1") ; Finnish      ("fi" . "Latin-1") ; Finnish
1969      ; fj Fiji      ; fj Fiji
1970      ("fo" . "Latin-1") ; Faroese      ("fo" . "Latin-1") ; Faroese
# Line 1786  of buffer-file-coding-system set by this Line 1975  of buffer-file-coding-system set by this
1975      ("gl" . "Latin-1") ; Galician      ("gl" . "Latin-1") ; Galician
1976      ; gn Guarani      ; gn Guarani
1977      ; gu Gujarati      ; gu Gujarati
1978      ("gv" . "Latin-8") ; Manx Gaelic      ("gv" . "Latin-8") ; Manx Gaelic  glibc uses 8859-1
1979      ; ha Hausa      ; ha Hausa
1980      ("he" . "Hebrew")      ("he" . "Hebrew")
1981      ("hi" . "Devanagari") ; Hindi  glibc uses utf-8      ("hi" . "Devanagari") ; Hindi  glibc uses utf-8
1982      ("hr" . "Latin-2") ; Croatian      ("hr" . "Croatian") ; Croatian
1983      ("hu" . "Latin-2") ; Hungarian      ("hu" . "Latin-2") ; Hungarian
1984      ; hy Armenian      ; hy Armenian
1985      ; ia Interlingua      ; ia Interlingua
# Line 1798  of buffer-file-coding-system set by this Line 1987  of buffer-file-coding-system set by this
1987      ; ie Interlingue      ; ie Interlingue
1988      ; ik Inupiak      ; ik Inupiak
1989      ("is" . "Latin-1") ; Icelandic      ("is" . "Latin-1") ; Icelandic
1990      ("it" . "Latin-1") ; Italian      ("it" . "Italian") ; Italian
1991      ; iu Inuktitut      ; iu Inuktitut
1992      ("ja" . "Japanese")      ("ja" . "Japanese")
1993      ; jw Javanese      ; jw Javanese
# Line 1820  of buffer-file-coding-system set by this Line 2009  of buffer-file-coding-system set by this
2009      ("lv" . "Latvian") ; Latvian, Lettish      ("lv" . "Latvian") ; Latvian, Lettish
2010      ; mg Malagasy      ; mg Malagasy
2011      ("mi" . "Latin-7") ; Maori      ("mi" . "Latin-7") ; Maori
2012      ("mk" . "Latin-5") ; Macedonian      ("mk" . "Cyrillic-ISO") ; Macedonian
2013      ; ml Malayalam      ; ml Malayalam
2014      ; mn Mongolian      ; mn Mongolian
2015      ; mo Moldavian      ; mo Moldavian
# Line 1843  of buffer-file-coding-system set by this Line 2032  of buffer-file-coding-system set by this
2032      ("rm" . "Latin-1") ; Rhaeto-Romanic      ("rm" . "Latin-1") ; Rhaeto-Romanic
2033      ; rn Kirundi      ; rn Kirundi
2034      ("ro" . "Romanian")      ("ro" . "Romanian")
2035      ("ru.*[_.]koi8" . "Cyrillic-KOI8") ; Russian      ("ru.*[_.]koi8" . "Russian")
2036      ("ru" . "Latin-5") ; Russian      ("ru" . "Cyrillic-ISO") ; Russian
2037      ; rw Kinyarwanda      ; rw Kinyarwanda
2038      ("sa" . "Devanagari") ; Sanskrit      ("sa" . "Devanagari") ; Sanskrit
2039      ; sd Sindhi      ; sd Sindhi
# Line 1859  of buffer-file-coding-system set by this Line 2048  of buffer-file-coding-system set by this
2048      ; so Somali      ; so Somali
2049      ("sq" . "Latin-1") ; Albanian      ("sq" . "Latin-1") ; Albanian
2050      ("sr" . "Latin-2") ; Serbian (Latin alphabet)      ("sr" . "Latin-2") ; Serbian (Latin alphabet)
2051        ("sr_YU@cyrillic" . "Cyrillic-ISO") ; per glibc
2052      ; ss Siswati      ; ss Siswati
2053      ; st Sesotho      ; st Sesotho
2054      ; su Sundanese      ; su Sundanese
2055      ("sv" . "Latin-1") ; Swedish      ("sv" . "Swedish") ; Swedish
2056      ("sw" . "Latin-1") ; Swahili      ("sw" . "Latin-1") ; Swahili
2057      ; ta Tamil  glibc uses utf-8      ; ta Tamil  glibc uses utf-8
2058      ; te Telugu  glibc uses utf-8      ; te Telugu  glibc uses utf-8
2059      ("tg" . "Cyrillic-KOI8-T") ; Tajik      ("tg" . "Tajik")
2060      ("th" . "Thai")      ("th" . "Thai")
2061      ; ti Tigrinya      ; ti Tigrinya
2062      ; tk Turkmen      ; tk Turkmen
2063      ("tl" . "Latin-1") ; Tagalog      ("tl" . "Latin-1") ; Tagalog
2064      ; tn Setswana      ; tn Setswana
2065      ; to Tonga      ; to Tonga
2066      ("tr" . "Latin-5") ; Turkish      ("tr" . "Turkish")
2067      ; ts Tsonga      ; ts Tsonga
2068      ; tt Tatar      ; tt Tatar
2069      ; tw Twi      ; tw Twi
# Line 1883  of buffer-file-coding-system set by this Line 2073  of buffer-file-coding-system set by this
2073      ("uz" . "Latin-1") ; Uzbek      ("uz" . "Latin-1") ; Uzbek
2074      ("vi" . "Vietnamese") ;  glibc uses utf-8      ("vi" . "Vietnamese") ;  glibc uses utf-8
2075      ; vo Volapuk      ; vo Volapuk
2076        ("wa" . "Latin-1") ; Walloon
2077      ; wo Wolof      ; wo Wolof
2078      ; xh Xhosa      ; xh Xhosa
2079      ("yi" . "Windows-1255") ; Yiddish      ("yi" . "Windows-1255") ; Yiddish
# Line 1893  of buffer-file-coding-system set by this Line 2084  of buffer-file-coding-system set by this
2084      ; zh_CN.GB18030/GB18030 \      ; zh_CN.GB18030/GB18030 \
2085      ; zh_CN.GBK/GBK \      ; zh_CN.GBK/GBK \
2086      ; zh_HK/BIG5-HKSCS \      ; zh_HK/BIG5-HKSCS \
     ; zh_TW/BIG5 \  
     ; zh_TW.EUC-TW/EUC-TW \  
2087    
2088      ("zh.*[._]big5" . "Chinese-BIG5")      ("zh.*[._]big5" . "Chinese-BIG5")
2089      ("zh.*[._]gbk" . nil) ; Solaris 2.7; has gbk-0 as well as GB 2312.1980-0      ("zh.*[._]gbk" . nil) ; Solaris 2.7; has gbk-0 as well as GB 2312.1980-0
2090      ("zh_tw" . "Chinese-CNS")      ("zh_tw" . "Chinese-CNS") ; glibc uses big5
2091        ("zh_tw[._]euc-tw" . "Chinese-EUC-TW")
2092      ("zh" . "Chinese-GB")      ("zh" . "Chinese-GB")
2093      ; zu Zulu      ; zu Zulu
2094    
# Line 1914  of buffer-file-coding-system set by this Line 2104  of buffer-file-coding-system set by this
2104      ("cz" . "Czech") ; e.g. Solaris 2.6      ("cz" . "Czech") ; e.g. Solaris 2.6
2105      ("ee" . "Latin-4") ; Estonian, e.g. X11R6.4      ("ee" . "Latin-4") ; Estonian, e.g. X11R6.4
2106      ("iw" . "Hebrew") ; e.g. X11R6.4      ("iw" . "Hebrew") ; e.g. X11R6.4
2107      ("sp" . "Latin-5") ; Serbian (Cyrillic alphabet), e.g. X11R6.4      ("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4
2108      ("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6      ("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6
2109      ("jp" . "Japanese") ; e.g. MS Windows      ("jp" . "Japanese") ; e.g. MS Windows
2110      ("chs" . "Chinese-GB") ; MS Windows Chinese Simplified      ("chs" . "Chinese-GB") ; MS Windows Chinese Simplified
# Line 1934  If the language name is nil, there is no Line 2124  If the language name is nil, there is no
2124       (".*8859[-_]?9\\>" . "Latin-5")       (".*8859[-_]?9\\>" . "Latin-5")
2125       (".*8859[-_]?14\\>" . "Latin-8")       (".*8859[-_]?14\\>" . "Latin-8")
2126       (".*8859[-_]?15\\>" . "Latin-9")       (".*8859[-_]?15\\>" . "Latin-9")
2127       (".*@euro\\>" . "Latin-9")       (".*utf\\(-?8\\)\\>" . "UTF-8")
2128       (".*utf\\(-?8\\)\\>" . "UTF-8")))       ;; utf-8@euro exists, so put this last.  (@euro really specifies
2129         ;; the currency, rather than the charset.)
2130         (".*@euro\\>" . "Latin-9")))
2131    "List of pairs of locale regexps and charset language names.    "List of pairs of locale regexps and charset language names.
2132  The first element whose locale regexp matches the start of a downcased locale  The first element whose locale regexp matches the start of a downcased locale
2133  specifies the language name whose charsets corresponds to that locale.  specifies the language name whose charsets corresponds to that locale.
# Line 1954  the language name that would otherwise b Line 2146  the language name that would otherwise b
2146  The first element whose locale regexp matches the start of a downcased locale  The first element whose locale regexp matches the start of a downcased locale
2147  specifies the coding system to prefer when using that locale.")  specifies the coding system to prefer when using that locale.")
2148    
 (defconst standard-keyboard-coding-systems  
   (purecopy  
    '(iso-latin-1 iso-latin-2 iso-latin-3 iso-latin-4 iso-latin-5  
      iso-latin-6 iso-latin-7 iso-latin-8 iso-latin-9 koi8-u koi8-r))  
   "Coding systems that are commonly used for keyboards.  
 `set-locale-environment' will set the `keyboard-coding-system' if the  
 coding-system specified by the locale setting is a member of this list.")  
   
2149  (defun locale-name-match (key alist)  (defun locale-name-match (key alist)
2150    "Search for KEY in ALIST, which should be a list of regexp-value pairs.    "Search for KEY in ALIST, which should be a list of regexp-value pairs.
2151  Return the value corresponding to the first regexp that matches the  Return the value corresponding to the first regexp that matches the
# Line 1986  For example, the locale name \"ja_JP.EUC Line 2170  For example, the locale name \"ja_JP.EUC
2170  for Japanese in Japan using the `japanese-iso-8bit' coding-system.  for Japanese in Japan using the `japanese-iso-8bit' coding-system.
2171    
2172  If LOCALE-NAME is nil, its value is taken from the environment  If LOCALE-NAME is nil, its value is taken from the environment
2173  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).
2174    
2175  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
2176  directory named `/usr/share/locale' or `/usr/lib/locale'.  LOCALE-NAME  directory named `/usr/share/locale' or `/usr/lib/locale'.  LOCALE-NAME
# Line 1996  will be translated according to the tabl Line 2180  will be translated according to the tabl
2180  See also `locale-charset-language-names', `locale-language-names',  See also `locale-charset-language-names', `locale-language-names',
2181  `locale-preferred-coding-systems' and `locale-coding-system'."  `locale-preferred-coding-systems' and `locale-coding-system'."
2182    (interactive "sSet environment for locale: ")    (interactive "sSet environment for locale: ")
2183    
2184    ;; Do this at runtime for the sake of binaries possibly transported    ;; Do this at runtime for the sake of binaries possibly transported
2185    ;; to a system without X.    ;; to a system without X.
2186    (setq locale-translation-file-name    (setq locale-translation-file-name
# Line 2019  See also `locale-charset-language-names' Line 2203  See also `locale-charset-language-names'
2203        ;; Use the first of these three environment variables        ;; Use the first of these three environment variables
2204        ;; that has a nonempty value.        ;; that has a nonempty value.
2205        (let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))        (let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
2206          (while (and vars (not (setq locale (getenv (car vars)))))          (while (and vars
2207            (setq vars (cdr vars)))))                      (= 0 (length locale))) ; nil or empty string
2208              (setq locale (getenv (pop vars))))))
2209    
2210      (when locale      (when locale
2211    
# Line 2069  See also `locale-charset-language-names' Line 2254  See also `locale-charset-language-names'
2254            (when default-enable-multibyte-characters            (when default-enable-multibyte-characters
2255              (set-display-table-and-terminal-coding-system language-name))              (set-display-table-and-terminal-coding-system language-name))
2256    
2257            ;; Set the `keyboard-coding-system' if appropriate.            ;; Set the `keyboard-coding-system' if appropriate (tty
2258            (let ((kcs (or coding-system            ;; only).  At least X and MS Windows can generate
2259                           (car (get-language-info language-name            ;; multilingual input.
2260                                                   'coding-system)))))            (unless window-system
2261              (if (memq kcs standard-keyboard-coding-systems)              (let ((kcs (or coding-system
2262                  (set-keyboard-coding-system kcs)))                             (car (get-language-info language-name
2263                                                       'coding-system)))))
2264                  (if kcs (set-keyboard-coding-system kcs))))
2265    
2266            (setq locale-coding-system            (setq locale-coding-system
2267                  (car (get-language-info language-name 'coding-priority))))                  (car (get-language-info language-name 'coding-priority))))
2268    
2269          (when coding-system          (when coding-system
2270            (prefer-coding-system coding-system)            (prefer-coding-system coding-system)
2271            (setq locale-coding-system coding-system))))))            (setq locale-coding-system coding-system))))
2272    
2273        ;; Default to A4 paper if we're not in a C, POSIX or US locale.
2274        ;; (See comments in Flanginfo.)
2275        (let ((locale locale)
2276              (paper (langinfo 'paper)))
2277          (if paper
2278              ;; This will always be null at the time of writing.
2279              (cond
2280               ((equal paper '(216 279))
2281                (setq ps-paper-type 'letter))
2282               ((equal paper '(210 297))
2283                (setq ps-paper-type 'a4)))
2284            (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
2285              (while (and vars (= 0 (length locale)))
2286                (setq locale (getenv (pop vars)))))
2287            (when locale
2288              ;; As of glibc 2.2.5, these are the only US Letter locales,
2289              ;; and the rest are A4.
2290              (setq ps-paper-type
2291                    (or (locale-name-match locale '(("c$" . letter)
2292                                                    ("posix$" . letter)
2293                                                    (".._us" . letter)
2294                                                    (".._pr" . letter)
2295                                                    (".._ca" . letter)))
2296                        'a4))))))
2297      nil)
2298    
2299  ;;; Charset property  ;;; Charset property
2300    

Legend:
Removed from v.1.194  
changed lines
  Added in v.1.194.2.1

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