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 |
|
|
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) |
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 |
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 |
|
|
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))) |
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) |
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)))) |
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) |
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 |
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 |
|
|
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)))) |
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. |
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 |
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. |
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)) |
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) |
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))) |
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) |
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 |
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 |
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 |
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. |
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." |
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 |
|
|
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 |
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))))))) |
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)) |
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 |
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. |
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 |
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 |
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))) |
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)) |
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 |
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 |
|
|
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
|
|
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 |
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. |
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 |
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 |
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 |
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 |
|
|
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 |
|
|