1 ;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-
3 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009 Free Software Foundation, Inc.
5 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
6 ;; 2005, 2006, 2007, 2008, 2009
7 ;; National Institute of Advanced Industrial Science and Technology (AIST)
8 ;; Registration Number H14PRO021
10 ;; National Institute of Advanced Industrial Science and Technology (AIST)
11 ;; Registration Number H13PRO009
13 ;; Keywords: mule, i18n
15 ;; This file is part of GNU Emacs.
17 ;; GNU Emacs is free software: you can redistribute it and/or modify
18 ;; it under the terms of the GNU General Public License as published by
19 ;; the Free Software Foundation, either version 3 of the License, or
20 ;; (at your option) any later version.
22 ;; GNU Emacs is distributed in the hope that it will be useful,
23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 ;; GNU General Public License for more details.
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
35 (autoload 'widget-value "wid-edit")
37 (defvar mac-system-coding-system)
39 ;;; MULE related key bindings and menus.
41 (defvar mule-keymap (make-sparse-keymap)
42 "Keymap for Mule (Multilingual environment) specific commands.")
44 ;; Keep "C-x C-m ..." for mule specific commands.
45 (define-key ctl-x-map "\C-m" mule-keymap)
47 (define-key mule-keymap "f" 'set-buffer-file-coding-system)
48 (define-key mule-keymap "r" 'revert-buffer-with-coding-system)
49 (define-key mule-keymap "F" 'set-file-name-coding-system)
50 (define-key mule-keymap "t" 'set-terminal-coding-system)
51 (define-key mule-keymap "k" 'set-keyboard-coding-system)
52 (define-key mule-keymap "p" 'set-buffer-process-coding-system)
53 (define-key mule-keymap "x" 'set-selection-coding-system)
54 (define-key mule-keymap "X" 'set-next-selection-coding-system)
55 (define-key mule-keymap "\C-\\" 'set-input-method)
56 (define-key mule-keymap "c" 'universal-coding-system-argument)
57 (define-key mule-keymap "l" 'set-language-environment)
59 (defvar mule-menu-keymap
60 (make-sparse-keymap "Mule (Multilingual Environment)")
61 "Keymap for Mule (Multilingual environment) menu specific commands.")
63 (defvar describe-language-environment-map
64 (make-sparse-keymap "Describe Language Environment"))
66 (defvar setup-language-environment-map
67 (make-sparse-keymap "Set Language Environment"))
69 (defvar set-coding-system-map
70 (make-sparse-keymap "Set Coding System"))
72 (define-key-after mule-menu-keymap [set-language-environment]
73 (list 'menu-item "Set Language Environment" setup-language-environment-map))
74 (define-key-after mule-menu-keymap [separator-mule]
77 (define-key-after mule-menu-keymap [toggle-input-method]
78 '(menu-item "Toggle Input Method" toggle-input-method)
80 (define-key-after mule-menu-keymap [set-input-method]
81 '(menu-item "Select Input Method..." set-input-method)
83 (define-key-after mule-menu-keymap [describe-input-method]
84 '(menu-item "Describe Input Method" describe-input-method))
85 (define-key-after mule-menu-keymap [separator-input-method]
88 (define-key-after mule-menu-keymap [set-various-coding-system]
89 (list 'menu-item "Set Coding Systems" set-coding-system-map
90 :enable 'default-enable-multibyte-characters))
91 (define-key-after mule-menu-keymap [view-hello-file]
92 '(menu-item "Show Multi-lingual Text" view-hello-file
93 :enable (file-readable-p
94 (expand-file-name "HELLO" data-directory))
95 :help "Display file which says HELLO in many languages")
97 (define-key-after mule-menu-keymap [separator-coding-system]
100 (define-key-after mule-menu-keymap [describe-language-environment]
101 (list 'menu-item "Describe Language Environment"
102 describe-language-environment-map
103 :help "Show multilingual settings for a specific language")
105 (define-key-after mule-menu-keymap [describe-input-method]
106 '(menu-item "Describe Input Method..." describe-input-method
107 :help "Keyboard layout for a specific input method")
109 (define-key-after mule-menu-keymap [describe-coding-system]
110 '(menu-item "Describe Coding System..." describe-coding-system)
112 (define-key-after mule-menu-keymap [list-character-sets]
113 '(menu-item "List Character Sets" list-character-sets
114 :help "Show table of available character sets"))
115 (define-key-after mule-menu-keymap [mule-diag]
116 '(menu-item "Show All of Mule Status" mule-diag
117 :help "Display multilingual environment settings")
120 (define-key-after set-coding-system-map [universal-coding-system-argument]
121 '(menu-item "For Next Command" universal-coding-system-argument
122 :help "Coding system to be used by next command")
124 (define-key-after set-coding-system-map [separator-1]
127 (define-key-after set-coding-system-map [set-buffer-file-coding-system]
128 '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
129 :help "How to encode this buffer when saved")
131 (define-key-after set-coding-system-map [revert-buffer-with-coding-system]
132 '(menu-item "For Reverting This File Now" revert-buffer-with-coding-system
133 :enable buffer-file-name
134 :help "Revisit this file immediately using specified coding system")
136 (define-key-after set-coding-system-map [set-file-name-coding-system]
137 '(menu-item "For File Name" set-file-name-coding-system
138 :help "How to decode/encode file names")
140 (define-key-after set-coding-system-map [separator-2]
144 (define-key-after set-coding-system-map [set-keyboard-coding-system]
145 '(menu-item "For Keyboard" set-keyboard-coding-system
146 :help "How to decode keyboard input")
148 (define-key-after set-coding-system-map [set-terminal-coding-system]
149 '(menu-item "For Terminal" set-terminal-coding-system
150 :enable (null (memq initial-window-system '(x w32 ns)))
151 :help "How to encode terminal output")
153 (define-key-after set-coding-system-map [separator-3]
156 (define-key-after set-coding-system-map [set-selection-coding-system]
157 '(menu-item "For X Selections/Clipboard" set-selection-coding-system
158 :visible (display-selections-p)
159 :help "How to en/decode data to/from selection/clipboard")
161 (define-key-after set-coding-system-map [set-next-selection-coding-system]
162 '(menu-item "For Next X Selection" set-next-selection-coding-system
163 :visible (display-selections-p)
164 :help "How to en/decode next selection/clipboard operation")
166 (define-key-after set-coding-system-map [set-buffer-process-coding-system]
167 '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
168 :visible (fboundp 'start-process)
169 :enable (get-buffer-process (current-buffer))
170 :help "How to en/decode I/O from/to subprocess connected to this buffer")
174 (define-key setup-language-environment-map
175 [Default] '(menu-item "Default" setup-specified-language-environment))
177 (define-key describe-language-environment-map
178 [Default] '(menu-item "Default" describe-specified-language-support))
180 ;; This should be a single character key binding because users use it
181 ;; very frequently while editing multilingual text. Now we can use
182 ;; only two such keys: "\C-\\" and "\C-^", but the latter is not
183 ;; convenient because it requires shifting on most keyboards. An
184 ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit'
185 ;; but it won't be used that frequently.
186 (define-key global-map "\C-\\" 'toggle-input-method)
188 ;; This is no good because people often type Shift-SPC
189 ;; meaning to type SPC. -- rms.
190 ;; ;; Here's an alternative key binding for X users (Shift-SPACE).
191 ;; (define-key global-map [?\S- ] 'toggle-input-method)
193 ;;; Mule related hyperlinks.
194 (defconst help-xref-mule-regexp-template
195 (purecopy (concat "\\(\\<\\("
196 "\\(coding system\\)\\|"
197 "\\(input method\\)\\|"
198 "\\(character set\\)\\|"
201 ;; Note starting with word-syntax character:
202 "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")))
204 (defun coding-system-change-eol-conversion (coding-system eol-type)
205 "Return a coding system which differs from CODING-SYSTEM in EOL conversion.
206 The returned coding system converts end-of-line by EOL-TYPE
207 but text as the same way as CODING-SYSTEM.
208 EOL-TYPE should be `unix', `dos', `mac', or nil.
209 If EOL-TYPE is nil, the returned coding system detects
210 how end-of-line is formatted automatically while decoding.
212 EOL-TYPE can be specified by an integer 0, 1, or 2.
213 They means `unix', `dos', and `mac' respectively."
214 (if (symbolp eol-type)
215 (setq eol-type (cond ((eq eol-type 'unix) 0)
216 ((eq eol-type 'dos) 1)
217 ((eq eol-type 'mac) 2)
219 ;; We call `coding-system-base' before `coding-system-eol-type',
220 ;; because the coding-system may not be initialized until then.
221 (let* ((base (coding-system-base coding-system))
222 (orig-eol-type (coding-system-eol-type coding-system)))
223 (cond ((vectorp orig-eol-type)
226 (aref orig-eol-type eol-type)))
229 ((= eol-type orig-eol-type)
231 ((progn (setq orig-eol-type (coding-system-eol-type base))
232 (vectorp orig-eol-type))
233 (aref orig-eol-type eol-type)))))
235 (defun coding-system-change-text-conversion (coding-system coding)
236 "Return a coding system which differs from CODING-SYSTEM in text conversion.
237 The returned coding system converts text by CODING
238 but end-of-line as the same way as CODING-SYSTEM.
239 If CODING is nil, the returned coding system detects
240 how text is formatted automatically while decoding."
241 (let ((eol-type (coding-system-eol-type coding-system)))
242 (coding-system-change-eol-conversion
243 (if coding coding 'undecided)
244 (if (numberp eol-type) (aref [unix dos mac] eol-type)))))
246 ;; Canonicalize the coding system name NAME by removing some prefixes
247 ;; and delimiter characters. Support function of
248 ;; coding-system-from-name.
249 (defun canonicalize-coding-system-name (name)
250 (if (string-match "^iso[-_ ]?[0-9]" name)
251 ;; "iso-8859-1" -> "8859-1", "iso-2022-jp" ->"2022-jp"
252 (setq name (substring name (1- (match-end 0)))))
253 (let ((idx (string-match "[-_ /]" name)))
254 ;; Delete "-", "_", " ", "/" but do distinguish "16-be" and "16be".
257 (eq (string-match "16-[lb]e$" name (- idx 2))
259 (setq idx (string-match "[-_ /]" name (match-end 0)))
260 (setq name (concat (substring name 0 idx) (substring name (1+ idx)))
261 idx (string-match "[-_ /]" name idx))))
264 (defun coding-system-from-name (name)
265 "Return a coding system whose name matches with NAME (string or symbol)."
267 (if (stringp name) (setq sym (intern name))
268 (setq sym name name (symbol-name name)))
269 (if (coding-system-p sym)
272 (if (string-match "-\\(unix\\|dos\\|mac\\)$" name)
273 (prog1 (intern (match-string 1 name))
274 (setq name (substring name 0 (match-beginning 0)))))))
275 (setq name (canonicalize-coding-system-name (downcase name)))
277 (dolist (elt (coding-system-list))
278 (if (string= (canonicalize-coding-system-name (symbol-name elt))
280 (throw 'tag (if eol-type (coding-system-change-eol-conversion
284 (defun toggle-enable-multibyte-characters (&optional arg)
285 "Change whether this buffer uses multibyte characters.
286 With ARG, use multibyte characters if the ARG is positive.
288 Note that this command does not convert the byte contents of
289 the buffer; it only changes the way those bytes are interpreted.
290 In general, therefore, this command *changes* the sequence of
291 characters that the current buffer contains.
293 We suggest you avoid using this command unless you know what you are
294 doing. If you use it by mistake, and the buffer is now displayed
295 wrong, use this command again to toggle back to the right mode."
298 (if (null arg) (null enable-multibyte-characters)
299 (> (prefix-numeric-value arg) 0))))
300 (set-buffer-multibyte new-flag))
301 (force-mode-line-update))
303 (defun view-hello-file ()
304 "Display the HELLO file, which lists many languages and characters."
306 ;; We have to decode the file in any environment.
307 (let ((default-enable-multibyte-characters t)
308 (coding-system-for-read 'iso-2022-7bit))
309 (view-file (expand-file-name "HELLO" data-directory))))
311 (defun universal-coding-system-argument (coding-system)
312 "Execute an I/O command using the specified coding system."
314 (let ((default (and buffer-file-coding-system
315 (not (eq (coding-system-type buffer-file-coding-system)
317 buffer-file-coding-system)))
318 (list (read-coding-system
320 (format "Coding system for following command (default %s): " default)
321 "Coding system for following command: ")
323 (let* ((keyseq (read-key-sequence
324 (format "Command to execute with %s:" coding-system)))
325 (cmd (key-binding keyseq))
327 ;; read-key-sequence ignores quit, so make an explicit check.
328 ;; Like many places, this assumes quit == C-g, but it need not be.
329 (if (equal last-input-event ?\C-g)
331 (when (memq cmd '(universal-argument digit-argument))
332 (call-interactively cmd)
334 ;; Process keys bound in `universal-argument-map'.
336 (setq keyseq (read-key-sequence nil t)
337 cmd (key-binding keyseq t))
338 (not (eq cmd 'universal-argument-other-key)))
339 (let ((current-prefix-arg prefix-arg)
340 ;; Have to bind `last-command-event' here so that
341 ;; `digit-argument', for instance, can compute the
343 (last-command-event (aref keyseq 0)))
344 (call-interactively cmd)))
346 ;; This is the final call to `universal-argument-other-key', which
347 ;; set's the final `prefix-arg.
348 (let ((current-prefix-arg prefix-arg))
349 (call-interactively cmd))
351 ;; Read the command to execute with the given prefix arg.
352 (setq prefix prefix-arg
353 keyseq (read-key-sequence nil t)
354 cmd (key-binding keyseq)))
356 (let ((coding-system-for-read coding-system)
357 (coding-system-for-write coding-system)
358 (coding-system-require-warning t)
359 (current-prefix-arg prefix))
361 (call-interactively cmd))))
363 (defun set-default-coding-systems (coding-system)
364 "Set default value of various coding systems to CODING-SYSTEM.
365 This sets the following coding systems:
366 o coding system of a newly created buffer
367 o default coding system for subprocess I/O
368 This also sets the following values:
369 o default value used as `file-name-coding-system' for converting file names
370 if CODING-SYSTEM is ASCII-compatible
371 o default value for the command `set-terminal-coding-system'
372 o default value for the command `set-keyboard-coding-system'
373 if CODING-SYSTEM is ASCII-compatible"
374 (check-coding-system coding-system)
375 (setq-default buffer-file-coding-system coding-system)
376 (if (fboundp 'ucs-set-table-for-input)
377 (dolist (buffer (buffer-list))
378 (or (local-variable-p 'buffer-file-coding-system buffer)
379 (ucs-set-table-for-input buffer))))
381 (if (eq system-type 'darwin)
382 ;; The file-name coding system on Darwin systems is always utf-8.
383 (setq default-file-name-coding-system 'utf-8)
384 (if (and default-enable-multibyte-characters
385 (or (not coding-system)
386 (coding-system-get coding-system 'ascii-compatible-p)))
387 (setq default-file-name-coding-system coding-system)))
388 (setq default-terminal-coding-system coding-system)
389 (setq default-keyboard-coding-system coding-system)
390 ;; Preserve eol-type from existing default-process-coding-systems.
391 ;; On non-unix-like systems in particular, these may have been set
392 ;; carefully by the user, or by the startup code, to deal with the
393 ;; users shell appropriately, so should not be altered by changing
394 ;; language environment.
396 (coding-system-change-text-conversion
397 (car default-process-coding-system) coding-system))
399 (coding-system-change-text-conversion
400 (cdr default-process-coding-system) coding-system)))
401 (setq default-process-coding-system
402 (cons output-coding input-coding))))
404 (defun prefer-coding-system (coding-system)
405 "Add CODING-SYSTEM at the front of the priority list for automatic detection.
406 This also sets the following coding systems:
407 o coding system of a newly created buffer
408 o default coding system for subprocess I/O
409 This also sets the following values:
410 o default value used as `file-name-coding-system' for converting file names
411 o default value for the command `set-terminal-coding-system'
412 o default value for the command `set-keyboard-coding-system'
414 If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
415 systems set by this function will use that type of EOL conversion.
417 A coding system that requires automatic detection of text+encoding
418 \(e.g. undecided, unix) can't be preferred."
419 (interactive "zPrefer coding system: ")
420 (if (not (and coding-system (coding-system-p coding-system)))
421 (error "Invalid coding system `%s'" coding-system))
422 (if (memq (coding-system-type coding-system) '(raw-text undecided))
423 (error "Can't prefer the coding system `%s'" coding-system))
424 (let ((base (coding-system-base coding-system))
425 (eol-type (coding-system-eol-type coding-system)))
426 (set-coding-system-priority base)
428 (or (eq base coding-system)
429 (message "Highest priority is set to %s (base of %s)"
430 base coding-system)))
431 ;; If they asked for specific EOL conversion, honor that.
432 (if (memq eol-type '(0 1 2))
434 (coding-system-change-eol-conversion base eol-type)))
435 (set-default-coding-systems base)))
437 (defvar sort-coding-systems-predicate nil
438 "If non-nil, a predicate function to sort coding systems.
440 It is called with two coding systems, and should return t if the first
441 one is \"less\" than the second.
443 The function `sort-coding-systems' use it.")
445 (defun sort-coding-systems (codings)
446 "Sort coding system list CODINGS by a priority of each coding system.
447 Return the sorted list. CODINGS is modified by side effects.
449 If a coding system is most preferred, it has the highest priority.
450 Otherwise, coding systems that correspond to MIME charsets have
451 higher priorities. Among them, a coding system included in the
452 `coding-system' key of the current language environment has higher
453 priority. See also the documentation of `language-info-alist'.
455 If the variable `sort-coding-systems-predicate' (which see) is
456 non-nil, it is used to sort CODINGS instead."
457 (if sort-coding-systems-predicate
458 (sort codings sort-coding-systems-predicate)
459 (let* ((from-priority (coding-system-priority-list))
460 (most-preferred (car from-priority))
461 (lang-preferred (get-language-info current-language-environment
465 (let ((base (coding-system-base x)))
466 ;; We calculate the priority number 0..255 by
467 ;; using the 8 bits PMMLCEII as this:
468 ;; P: 1 if most preferred.
469 ;; MM: greater than 0 if mime-charset.
470 ;; L: 1 if one of the current lang. env.'s codings.
471 ;; C: 1 if one of codings listed in the category list.
472 ;; E: 1 if not XXX-with-esc
473 ;; II: if iso-2022 based, 0..3, else 1.
475 (lsh (if (eq base most-preferred) 1 0) 7)
477 (let ((mime (coding-system-get base :mime-charset)))
478 ;; Prefer coding systems corresponding to a
481 ;; Lower utf-16 priority so that we
482 ;; normally prefer utf-8 to it, and put
483 ;; x-ctext below that.
484 (cond ((string-match-p "utf-16"
487 ((string-match-p "^x-" (symbol-name mime))
492 (lsh (if (memq base lang-preferred) 1 0) 4)
493 (lsh (if (memq base from-priority) 1 0) 3)
494 (lsh (if (string-match-p "-with-esc\\'"
497 (if (eq (coding-system-type base) 'iso-2022)
498 (let ((category (coding-system-category base)))
499 ;; For ISO based coding systems, prefer
500 ;; one that doesn't use designation nor
501 ;; locking/single shifting.
503 ((or (eq category 'coding-category-iso-8-1)
504 (eq category 'coding-category-iso-8-2))
506 ((or (eq category 'coding-category-iso-7-tight)
507 (eq category 'coding-category-iso-7))
513 (sort codings (function (lambda (x y)
514 (> (funcall func x) (funcall func y))))))))
516 (defun find-coding-systems-region (from to)
517 "Return a list of proper coding systems to encode a text between FROM and TO.
519 If FROM is a string, find coding systems in that instead of the buffer.
520 All coding systems in the list can safely encode any multibyte characters
523 If the text contains no multibyte characters, return a list of a single
524 element `undecided'."
525 (let ((codings (find-coding-systems-region-internal from to)))
527 ;; The text contains only ASCII characters. Any coding
530 ;; We need copy-sequence because sorting will alter the argument.
531 (sort-coding-systems (copy-sequence codings)))))
533 (defun find-coding-systems-string (string)
534 "Return a list of proper coding systems to encode STRING.
535 All coding systems in the list can safely encode any multibyte characters
538 If STRING contains no multibyte characters, return a list of a single
539 element `undecided'."
540 (find-coding-systems-region string nil))
542 (defun find-coding-systems-for-charsets (charsets)
543 "Return a list of proper coding systems to encode characters of CHARSETS.
544 CHARSETS is a list of character sets.
546 This only finds coding systems of type `charset', whose
547 `:charset-list' property includes all of CHARSETS (plus `ascii' for
548 ASCII-compatible coding systems). It was used in older versions of
549 Emacs, but is unlikely to be what you really want now."
550 ;; Deal with aliases.
551 (setq charsets (mapcar (lambda (c)
552 (get-charset-property c :name))
554 (cond ((or (null charsets)
555 (and (= (length charsets) 1)
556 (eq 'ascii (car charsets))))
558 ((or (memq 'eight-bit-control charsets)
559 (memq 'eight-bit-graphic charsets))
560 '(raw-text utf-8-emacs))
563 (dolist (cs (coding-system-list t))
564 (let ((cs-charsets (and (eq (coding-system-type cs) 'charset)
565 (coding-system-charset-list cs)))
567 (if (coding-system-get cs :ascii-compatible-p)
568 (add-to-list 'cs-charsets 'ascii))
572 (unless (memq (pop charsets) cs-charsets)
576 (nreverse codings)))))
578 (defun find-multibyte-characters (from to &optional maxcount excludes)
579 "Find multibyte characters in the region specified by FROM and TO.
580 If FROM is a string, find multibyte characters in the string.
581 The return value is an alist of the following format:
582 ((CHARSET COUNT CHAR ...) ...)
584 CHARSET is a character set,
585 COUNT is a number of characters,
586 CHARs are the characters found from the character set.
587 Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
588 Optional 4th arg EXCLUDES is a list of character sets to be ignored."
592 (if (multibyte-string-p from)
594 (while (setq idx (string-match-p "[^\000-\177]" from idx))
595 (setq char (aref from idx)
596 charset (char-charset char))
597 (unless (memq charset excludes)
598 (let ((slot (assq charset chars)))
600 (if (not (memq char (nthcdr 2 slot)))
601 (let ((count (nth 1 slot)))
602 (setcar (cdr slot) (1+ count))
603 (if (or (not maxcount) (< count maxcount))
604 (nconc slot (list char)))))
605 (setq chars (cons (list charset 1 char) chars)))))
606 (setq idx (1+ idx)))))
607 (if enable-multibyte-characters
610 (while (re-search-forward "[^\000-\177]" to t)
611 (setq char (preceding-char)
612 charset (char-charset char))
613 (unless (memq charset excludes)
614 (let ((slot (assq charset chars)))
616 (if (not (member char (nthcdr 2 slot)))
617 (let ((count (nth 1 slot)))
618 (setcar (cdr slot) (1+ count))
619 (if (or (not maxcount) (< count maxcount))
620 (nconc slot (list char)))))
621 (setq chars (cons (list charset 1 char) chars)))))))))
624 (defun search-unencodable-char (coding-system)
625 "Search forward from point for a character that is not encodable.
626 It asks which coding system to check.
627 If such a character is found, set point after that character.
628 Otherwise, don't move point.
630 When called from a program, the value is the position of the unencodable
631 character found, or nil if all characters are encodable."
633 (list (let ((default (or buffer-file-coding-system 'us-ascii)))
635 (format "Coding-system (default %s): " default)
637 (let ((pos (unencodable-char-position (point) (point-max) coding-system)))
640 (message "All following characters are encodable by %s" coding-system))
643 (defvar last-coding-system-specified nil
644 "Most recent coding system explicitly specified by the user when asked.
645 This variable is set whenever Emacs asks the user which coding system
646 to use in order to write a file. If you set it to nil explicitly,
647 then call `write-region', then afterward this variable will be non-nil
648 only if the user was explicitly asked and specified a coding system.")
650 (defvar select-safe-coding-system-accept-default-p nil
651 "If non-nil, a function to control the behavior of coding system selection.
652 The meaning is the same as the argument ACCEPT-DEFAULT-P of the
653 function `select-safe-coding-system' (which see). This variable
654 overrides that argument.")
656 (defun select-safe-coding-system-interactively (from to codings unsafe
657 &optional rejected default)
658 "Select interactively a coding system for the region FROM ... TO.
659 FROM can be a string, as in `write-region'.
660 CODINGS is the list of base coding systems known to be safe for this region,
661 typically obtained with `find-coding-systems-region'.
662 UNSAFE is a list of coding systems known to be unsafe for this region.
663 REJECTED is a list of coding systems which were safe but for some reason
664 were not recommended in the particular context.
665 DEFAULT is the coding system to use by default in the query."
666 ;; At first, if some defaults are unsafe, record at most 11
667 ;; problematic characters and their positions for them by turning
670 ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
673 (mapcar #'(lambda (coding)
676 (mapcar #'(lambda (pos)
677 (cons pos (aref from pos)))
678 (unencodable-char-position
679 0 (length from) coding
681 (mapcar #'(lambda (pos)
682 (cons pos (char-after pos)))
683 (unencodable-char-position
684 from to coding 11)))))
687 ;; Change each safe coding system to the corresponding
688 ;; mime-charset name if it is also a coding system. Such a name
689 ;; is more friendly to users.
693 (setq mime-charset (coding-system-get (car l) :mime-charset))
694 (if (and mime-charset (coding-system-p mime-charset)
695 (coding-system-equal (car l) mime-charset))
696 (setcar l mime-charset))
699 ;; Don't offer variations with locking shift, which you
700 ;; basically never want.
702 (dolist (elt codings (setq codings (nreverse l)))
703 (unless (or (eq 'coding-category-iso-7-else
704 (coding-system-category elt))
705 (eq 'coding-category-iso-8-else
706 (coding-system-category elt)))
709 ;; Remove raw-text, emacs-mule and no-conversion unless nothing
710 ;; else is available.
714 (delq 'no-conversion codings)))
715 '(raw-text emacs-mule no-conversion)))
717 (let ((window-configuration (current-window-configuration))
718 (bufname (buffer-name))
721 ;; If some defaults are unsafe, make sure the offending
722 ;; buffer is displayed.
723 (when (and unsafe (not (stringp from)))
724 (pop-to-buffer bufname)
725 (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
727 ;; Then ask users to select one from CODINGS while showing
728 ;; the reason why none of the defaults are not used.
729 (with-output-to-temp-buffer "*Warning*"
730 (with-current-buffer standard-output
731 (if (and (null rejected) (null unsafe))
732 (insert "No default coding systems to try for "
734 (format "string \"%s\"." from)
735 (format "buffer `%s'." bufname)))
737 "These default coding systems were tried to encode"
739 (concat " \"" (if (> (length from) 10)
740 (concat (substring from 0 10) "...\"")
742 (format " text\nin the buffer `%s'" bufname))
746 (dolist (x (append rejected unsafe))
747 (princ " ") (princ x))
749 (fill-region-as-paragraph pos (point)))
751 (insert "These safely encode the text in the buffer,
752 but are not recommended for encoding text in this context,
753 e.g., for sending an email message.\n ")
755 (princ " ") (princ x))
758 (insert (if rejected "The other coding systems"
759 "However, each of them")
760 " encountered characters it couldn't encode:\n")
761 (dolist (coding unsafe)
762 (insert (format " %s cannot encode these:" (car coding)))
765 #'(lambda (bufname pos)
766 (when (buffer-live-p (get-buffer bufname))
767 (pop-to-buffer bufname)
770 #'(lambda (bufname pos coding)
771 (when (buffer-live-p (get-buffer bufname))
772 (pop-to-buffer bufname)
776 (search-unencodable-char coding)
777 (forward-char -1))))))
778 (dolist (elt (cdr coding))
781 (insert (if (< i 10) (cdr elt) "..."))
788 "mouse-2, RET: jump to this character"
790 'help-args (list bufname (car elt)))
796 "mouse-2, RET: next unencodable character"
798 'help-args (list bufname (car elt)
802 (insert (substitute-command-keys "\
804 Click on a character (or switch to this window by `\\[other-window]'\n\
805 and select the characters by RET) to jump to the place it appears,\n\
806 where `\\[universal-argument] \\[what-cursor-position]' will give information about it.\n"))))
807 (insert (substitute-command-keys "\nSelect \
808 one of the safe coding systems listed below,\n\
809 or cancel the writing with \\[keyboard-quit] and edit the buffer\n\
810 to remove or modify the problematic characters,\n\
811 or specify any other coding system (and risk losing\n\
812 the problematic characters).\n\n"))
816 (princ " ") (princ x))
818 (fill-region-as-paragraph pos (point)))))
820 ;; Read a coding system.
823 (format "Select coding system (default %s): " default)
825 (setq last-coding-system-specified coding-system))
827 (kill-buffer "*Warning*")
828 (set-window-configuration window-configuration)
831 (defun select-safe-coding-system (from to &optional default-coding-system
832 accept-default-p file)
833 "Ask a user to select a safe coding system from candidates.
834 The candidates of coding systems which can safely encode a text
835 between FROM and TO are shown in a popup window. Among them, the most
836 proper one is suggested as the default.
838 The list of `buffer-file-coding-system' of the current buffer, the
839 `default-buffer-file-coding-system', and the most preferred coding
840 system (if it corresponds to a MIME charset) is treated as the
841 default coding system list. Among them, the first one that safely
842 encodes the text is normally selected silently and returned without
843 any user interaction. See also the command `prefer-coding-system'.
845 However, the user is queried if the chosen coding system is
846 inconsistent with what would be selected by `find-auto-coding' from
847 coding cookies &c. if the contents of the region were read from a
848 file. (That could lead to data corruption in a file subsequently
849 re-visited and edited.)
851 Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
852 list of coding systems to be prepended to the default coding system
853 list. However, if DEFAULT-CODING-SYSTEM is a list and the first
854 element is t, the cdr part is used as the default coding system list,
855 i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
856 and the most preferred coding system are not used.
858 Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to
859 determine the acceptability of the silently selected coding system.
860 It is called with that coding system, and should return nil if it
861 should not be silently selected and thus user interaction is required.
863 Optional 5th arg FILE is the file name to use for this purpose.
864 That is different from `buffer-file-name' when handling `write-region'
867 The variable `select-safe-coding-system-accept-default-p', if non-nil,
868 overrides ACCEPT-DEFAULT-P.
870 Kludgy feature: if FROM is a string, the string is the target text,
872 (if (and default-coding-system
873 (not (listp default-coding-system)))
874 (setq default-coding-system (list default-coding-system)))
876 (let ((no-other-defaults nil)
878 (unless (or (stringp from) find-file-literally)
879 ;; Find an auto-coding that is specified for the the current
880 ;; buffer and file from the region FROM and TO.
885 (setq auto-cs (find-auto-coding (or file buffer-file-name "")
888 (if (coding-system-p (car auto-cs))
889 (setq auto-cs (car auto-cs))
893 Invalid coding system `%s' is specified
894 for the current buffer/file by the %s.
895 It is highly recommended to fix it before writing to a file."
897 (if (eq (cdr auto-cs) :coding) ":coding tag"
898 (format "variable `%s'" (cdr auto-cs))))
900 (or (yes-or-no-p "Really proceed with writing? ")
901 (error "Save aborted"))
902 (setq auto-cs nil))))))
904 (if (eq (car default-coding-system) t)
905 (setq no-other-defaults t
906 default-coding-system (cdr default-coding-system)))
908 ;; Change elements of the list to (coding . base-coding).
909 (setq default-coding-system
910 (mapcar (function (lambda (x) (cons x (coding-system-base x))))
911 default-coding-system))
913 (if (and auto-cs (not no-other-defaults))
914 ;; If the file has a coding cookie, try to use it before anything
915 ;; else (i.e. before default-coding-system which will typically come
916 ;; from file-coding-system-alist).
917 (let ((base (coding-system-base auto-cs)))
918 (or (memq base '(nil undecided))
919 (rassq base default-coding-system)
920 (push (cons auto-cs base) default-coding-system))))
922 (unless no-other-defaults
923 ;; If buffer-file-coding-system is not nil nor undecided, append it
925 (if buffer-file-coding-system
926 (let ((base (coding-system-base buffer-file-coding-system)))
927 (or (eq base 'undecided)
928 (rassq base default-coding-system)
929 (setq default-coding-system
930 (append default-coding-system
931 (list (cons buffer-file-coding-system base)))))))
933 (unless (and buffer-file-coding-system-explicit
934 (cdr buffer-file-coding-system-explicit))
935 ;; If default-buffer-file-coding-system is not nil nor undecided,
936 ;; append it to the defaults.
937 (if default-buffer-file-coding-system
938 (let ((base (coding-system-base default-buffer-file-coding-system)))
939 (or (eq base 'undecided)
940 (rassq base default-coding-system)
941 (setq default-coding-system
942 (append default-coding-system
943 (list (cons default-buffer-file-coding-system
946 ;; If the most preferred coding system has the property mime-charset,
947 ;; append it to the defaults.
948 (let ((preferred (coding-system-priority-list t))
950 (and (coding-system-p preferred)
951 (setq base (coding-system-base preferred))
952 (coding-system-get preferred :mime-charset)
953 (not (rassq base default-coding-system))
954 (setq default-coding-system
955 (append default-coding-system
956 (list (cons preferred base))))))))
958 (if select-safe-coding-system-accept-default-p
959 (setq accept-default-p select-safe-coding-system-accept-default-p))
961 ;; Decide the eol-type from the top of the default codings,
962 ;; buffer-file-coding-system, or
963 ;; default-buffer-file-coding-system.
964 (if default-coding-system
965 (let ((default-eol-type (coding-system-eol-type
966 (caar default-coding-system))))
967 (if (and (vectorp default-eol-type) buffer-file-coding-system)
968 (setq default-eol-type (coding-system-eol-type
969 buffer-file-coding-system)))
970 (if (and (vectorp default-eol-type) default-buffer-file-coding-system)
971 (setq default-eol-type (coding-system-eol-type
972 default-buffer-file-coding-system)))
973 (if (and default-eol-type (not (vectorp default-eol-type)))
974 (dolist (elt default-coding-system)
975 (setcar elt (coding-system-change-eol-conversion
976 (car elt) default-eol-type))))))
978 (let ((codings (find-coding-systems-region from to))
980 (tick (if (not (stringp from)) (buffer-chars-modified-tick)))
981 safe rejected unsafe)
982 (if (eq (car codings) 'undecided)
983 ;; Any coding system is ok.
984 (setq coding-system (caar default-coding-system))
985 ;; Reverse the list so that elements are accumulated in safe,
986 ;; rejected, and unsafe in the correct order.
987 (setq default-coding-system (nreverse default-coding-system))
989 ;; Classify the defaults into safe, rejected, and unsafe.
990 (dolist (elt default-coding-system)
991 (if (or (eq (car codings) 'undecided)
992 (memq (cdr elt) codings))
993 (if (and (functionp accept-default-p)
994 (not (funcall accept-default-p (cdr elt))))
995 (push (car elt) rejected)
996 (push (car elt) safe))
997 (push (car elt) unsafe)))
999 (setq coding-system (car safe))))
1001 ;; If all the defaults failed, ask a user.
1002 (when (not coding-system)
1003 (setq coding-system (select-safe-coding-system-interactively
1004 from to codings unsafe rejected (car codings))))
1006 ;; Check we're not inconsistent with what `coding:' spec &c would
1007 ;; give when file is re-read.
1008 ;; But don't do this if we explicitly ignored the cookie
1009 ;; by using `find-file-literally'.
1013 (memq (coding-system-type coding-system) '(0 5)))))
1014 ;; Merge coding-system and auto-cs as far as possible.
1015 (if (not coding-system)
1016 (setq coding-system auto-cs)
1018 (setq auto-cs coding-system)
1019 (let ((eol-type-1 (coding-system-eol-type coding-system))
1020 (eol-type-2 (coding-system-eol-type auto-cs)))
1021 (if (eq (coding-system-base coding-system) 'undecided)
1022 (setq coding-system (coding-system-change-text-conversion
1023 coding-system auto-cs))
1024 (if (eq (coding-system-base auto-cs) 'undecided)
1025 (setq auto-cs (coding-system-change-text-conversion
1026 auto-cs coding-system))))
1027 (if (vectorp eol-type-1)
1028 (or (vectorp eol-type-2)
1029 (setq coding-system (coding-system-change-eol-conversion
1030 coding-system eol-type-2)))
1031 (if (vectorp eol-type-2)
1032 (setq auto-cs (coding-system-change-eol-conversion
1033 auto-cs eol-type-1)))))))
1036 ;; Don't barf if writing a compressed file, say.
1037 ;; This check perhaps isn't ideal, but is probably
1038 ;; the best thing to do.
1039 (not (auto-coding-alist-lookup (or file buffer-file-name "")))
1040 (not (coding-system-equal coding-system auto-cs)))
1041 (unless (yes-or-no-p
1042 (format "Selected encoding %s disagrees with \
1043 %s specified by file contents. Really save (else edit coding cookies \
1044 and try again)? " coding-system auto-cs))
1045 (error "Save aborted"))))
1046 (when (and tick (/= tick (buffer-chars-modified-tick)))
1047 (error "Cancelled because the buffer was modified"))
1050 (setq select-safe-coding-system-function 'select-safe-coding-system)
1052 (defun select-message-coding-system ()
1053 "Return a coding system to encode the outgoing message of the current buffer.
1054 It at first tries the first coding system found in these variables
1056 (1) local value of `buffer-file-coding-system'
1057 (2) value of `sendmail-coding-system'
1058 (3) value of `default-sendmail-coding-system'
1059 (4) value of `default-buffer-file-coding-system'
1060 If the found coding system can't encode the current buffer,
1061 or none of them are bound to a coding system,
1062 it asks the user to select a proper coding system."
1063 (let ((coding (or (and (local-variable-p 'buffer-file-coding-system)
1064 buffer-file-coding-system)
1065 sendmail-coding-system
1066 default-sendmail-coding-system
1067 default-buffer-file-coding-system)))
1068 (if (eq coding 'no-conversion)
1069 ;; We should never use no-conversion for outgoing mail.
1071 (if (fboundp select-safe-coding-system-function)
1072 (funcall select-safe-coding-system-function
1073 (point-min) (point-max) coding
1074 (function (lambda (x) (coding-system-get x :mime-charset))))
1077 ;;; Language support stuff.
1079 (defvar language-info-alist nil
1080 "Alist of language environment definitions.
1081 Each element looks like:
1082 (LANGUAGE-NAME . ((KEY . INFO) ...))
1083 where LANGUAGE-NAME is a string, the name of the language environment,
1084 KEY is a symbol denoting the kind of information, and
1085 INFO is the data associated with KEY.
1086 Meaningful values for KEY include
1088 documentation value is documentation of what this language environment
1089 is meant for, and how to use it.
1090 charset value is a list of the character sets mainly used
1091 by this language environment.
1092 sample-text value is an expression which is evalled to generate
1093 a line of text written using characters appropriate
1094 for this language environment.
1095 setup-function value is a function to call to switch to this
1096 language environment.
1097 exit-function value is a function to call to leave this
1098 language environment.
1099 coding-system value is a list of coding systems that are good for
1100 saving text written in this language environment.
1101 This list serves as suggestions to the user;
1102 in effect, as a kind of documentation.
1103 coding-priority value is a list of coding systems for this language
1104 environment, in order of decreasing priority.
1105 This is used to set up the coding system priority
1106 list when you switch to this language environment.
1107 nonascii-translation
1108 value is a charset of dimension one to use for
1109 converting a unibyte character to multibyte
1111 input-method value is a default input method for this language
1113 features value is a list of features requested in this
1114 language environment.
1115 ctext-non-standard-encodings
1116 value is a list of non-standard encoding names used
1117 in extended segments of CTEXT. See the variable
1118 `ctext-non-standard-encodings' for more detail.
1120 The following keys take effect only when multibyte characters are
1121 globally disabled, i.e. the value of `default-enable-multibyte-characters'
1124 unibyte-display value is a coding system to encode characters for
1125 the terminal. Characters in the range of 160 to
1126 255 display not as octal escapes, but as non-ASCII
1127 characters in this language environment.")
1129 (defun get-language-info (lang-env key)
1130 "Return information listed under KEY for language environment LANG-ENV.
1131 KEY is a symbol denoting the kind of information.
1132 For a list of useful values for KEY and their meanings,
1133 see `language-info-alist'."
1134 (if (symbolp lang-env)
1135 (setq lang-env (symbol-name lang-env)))
1136 (let ((lang-slot (assoc-string lang-env language-info-alist t)))
1138 (cdr (assq key (cdr lang-slot))))))
1140 (defun set-language-info (lang-env key info)
1141 "Modify part of the definition of language environment LANG-ENV.
1142 Specifically, this stores the information INFO under KEY
1143 in the definition of this language environment.
1144 KEY is a symbol denoting the kind of information.
1145 INFO is the value for that information.
1147 For a list of useful values for KEY and their meanings,
1148 see `language-info-alist'."
1149 (if (symbolp lang-env)
1150 (setq lang-env (symbol-name lang-env)))
1151 (set-language-info-internal lang-env key info)
1152 (if (equal lang-env current-language-environment)
1153 (cond ((eq key 'coding-priority)
1154 (set-language-environment-coding-systems lang-env)
1155 (set-language-environment-charset lang-env))
1156 ((eq key 'input-method)
1157 (set-language-environment-input-method lang-env))
1158 ((eq key 'nonascii-translation)
1159 (set-language-environment-nonascii-translation lang-env))
1161 (set-language-environment-charset lang-env))
1162 ((and (not default-enable-multibyte-characters)
1163 (or (eq key 'unibyte-syntax) (eq key 'unibyte-display)))
1164 (set-language-environment-unibyte lang-env)))))
1166 (defun set-language-info-internal (lang-env key info)
1168 Arguments are the same as `set-language-info'."
1169 (let (lang-slot key-slot)
1170 (setq lang-slot (assoc lang-env language-info-alist))
1171 (if (null lang-slot) ; If no slot for the language, add it.
1172 (setq lang-slot (list lang-env)
1173 language-info-alist (cons lang-slot language-info-alist)))
1174 (setq key-slot (assq key lang-slot))
1175 (if (null key-slot) ; If no slot for the key, add it.
1177 (setq key-slot (list key))
1178 (setcdr lang-slot (cons key-slot (cdr lang-slot)))))
1179 (setcdr key-slot (purecopy info))
1180 ;; Update the custom-type of `current-language-environment'.
1181 (put 'current-language-environment 'custom-type
1182 (cons 'choice (mapcar
1185 (sort (mapcar 'car language-info-alist) 'string<))))))
1187 (defun set-language-info-alist (lang-env alist &optional parents)
1188 "Store ALIST as the definition of language environment LANG-ENV.
1189 ALIST is an alist of KEY and INFO values. See the documentation of
1190 `language-info-alist' for the meanings of KEY and INFO.
1192 Optional arg PARENTS is a list of parent menu names; it specifies
1193 where to put this language environment in the
1194 Describe Language Environment and Set Language Environment menus.
1195 For example, (\"European\") means to put this language environment
1196 in the European submenu in each of those two menus."
1197 (if (symbolp lang-env)
1198 (setq lang-env (symbol-name lang-env)))
1199 (let ((describe-map describe-language-environment-map)
1200 (setup-map setup-language-environment-map))
1203 map parent-symbol parent prompt)
1205 (if (symbolp (setq parent-symbol (car l)))
1206 (setq parent (symbol-name parent))
1207 (setq parent parent-symbol parent-symbol (intern parent)))
1208 (setq map (lookup-key describe-map (vector parent-symbol)))
1209 ;; This prompt string is for define-prefix-command, so
1210 ;; that the map it creates will be suitable for a menu.
1211 (or map (setq prompt (format "%s Environment" parent)))
1214 (setq map (intern (format "describe-%s-environment-map"
1215 (downcase parent))))
1216 (define-prefix-command map nil prompt)
1217 (define-key-after describe-map (vector parent-symbol)
1218 (cons parent map) t)))
1219 (setq describe-map (symbol-value map))
1220 (setq map (lookup-key setup-map (vector parent-symbol)))
1223 (setq map (intern (format "setup-%s-environment-map"
1224 (downcase parent))))
1225 (define-prefix-command map nil prompt)
1226 (define-key-after setup-map (vector parent-symbol)
1227 (cons parent map) t)))
1228 (setq setup-map (symbol-value map))
1231 ;; Set up menu items for this language env.
1232 (let ((doc (assq 'documentation alist)))
1234 (define-key-after describe-map (vector (intern lang-env))
1235 (cons lang-env 'describe-specified-language-support) t)))
1236 (define-key-after setup-map (vector (intern lang-env))
1237 (cons lang-env 'setup-specified-language-environment) t)
1240 (set-language-info-internal lang-env (car elt) (cdr elt)))
1242 (if (equal lang-env current-language-environment)
1243 (set-language-environment lang-env))))
1245 (defun read-language-name (key prompt &optional default)
1246 "Read a language environment name which has information for KEY.
1247 If KEY is nil, read any language environment.
1248 Prompt with PROMPT. DEFAULT is the default choice of language environment.
1249 This returns a language environment name as a string."
1250 (let* ((completion-ignore-case t)
1251 (name (completing-read prompt
1254 (function (lambda (elm) (and (listp elm) (assq key elm)))))
1255 t nil nil default)))
1256 (if (and (> (length name) 0)
1258 (get-language-info name key)))
1261 ;;; Multilingual input methods.
1263 "LEIM: Libraries of Emacs Input Methods."
1266 (defconst leim-list-file-name "leim-list.el"
1267 "Name of LEIM list file.
1268 This file contains a list of libraries of Emacs input methods (LEIM)
1269 in the format of Lisp expression for registering each input method.
1270 Emacs loads this file at startup time.")
1272 (defvar leim-list-header (format
1273 ";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
1275 ;; This file is automatically generated.
1277 ;; This file contains a list of LEIM (Library of Emacs Input Method)
1278 ;; methods in the same directory as this file. Loading this file
1279 ;; registers all the input methods in Emacs.
1281 ;; Each entry has the form:
1282 ;; (register-input-method
1283 ;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC
1284 ;; TITLE DESCRIPTION
1286 ;; See the function `register-input-method' for the meanings of the arguments.
1288 ;; If this directory is included in `load-path', Emacs automatically
1289 ;; loads this file at startup time.
1292 leim-list-file-name)
1293 "Header to be inserted in LEIM list file.")
1295 (defvar leim-list-entry-regexp "^(register-input-method"
1296 "Regexp matching head of each entry in LEIM list file.
1297 See also the variable `leim-list-header'.")
1299 (defvar update-leim-list-functions
1300 '(quail-update-leim-list-file)
1301 "List of functions to call to update LEIM list file.
1302 Each function is called with one arg, LEIM directory name.")
1304 (defun update-leim-list-file (&rest dirs)
1305 "Update LEIM list file in directories DIRS."
1306 (dolist (function update-leim-list-functions)
1307 (apply function dirs)))
1309 (defvar current-input-method nil
1310 "The current input method for multilingual text.
1311 If nil, that means no input method is activated now.")
1312 (make-variable-buffer-local 'current-input-method)
1313 (put 'current-input-method 'permanent-local t)
1315 (defvar current-input-method-title nil
1316 "Title string of the current input method shown in mode line.")
1317 (make-variable-buffer-local 'current-input-method-title)
1318 (put 'current-input-method-title 'permanent-local t)
1320 (defcustom default-input-method nil
1321 "Default input method for multilingual text (a string).
1322 This is the input method activated automatically by the command
1323 `toggle-input-method' (\\[toggle-input-method])."
1324 :link '(custom-manual "(emacs)Input Methods")
1326 :type '(choice (const nil) (string
1327 :completion-ignore-case t
1328 :complete-function widget-string-complete
1329 :completion-alist input-method-alist
1330 :prompt-history input-method-history))
1331 :set-after '(current-language-environment))
1333 (put 'input-method-function 'permanent-local t)
1335 (defvar input-method-history nil
1336 "History list of input methods read from the minibuffer.
1338 Maximum length of the history list is determined by the value
1339 of `history-length', which see.")
1340 (make-variable-buffer-local 'input-method-history)
1341 (put 'input-method-history 'permanent-local t)
1343 (defvar inactivate-current-input-method-function nil
1344 "Function to call for inactivating the current input method.
1345 Every input method should set this to an appropriate value when activated.
1346 This function is called with no argument.
1348 This function should never change the value of `current-input-method'.
1349 It is set to nil by the function `inactivate-input-method'.")
1350 (make-variable-buffer-local 'inactivate-current-input-method-function)
1351 (put 'inactivate-current-input-method-function 'permanent-local t)
1353 (defvar describe-current-input-method-function nil
1354 "Function to call for describing the current input method.
1355 This function is called with no argument.")
1356 (make-variable-buffer-local 'describe-current-input-method-function)
1357 (put 'describe-current-input-method-function 'permanent-local t)
1359 (defvar input-method-alist nil
1360 "Alist of input method names vs how to use them.
1361 Each element has the form:
1362 (INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...)
1363 See the function `register-input-method' for the meanings of the elements.")
1365 (defun register-input-method (input-method lang-env &rest args)
1366 "Register INPUT-METHOD as an input method for language environment LANG-ENV.
1368 INPUT-METHOD and LANG-ENV are symbols or strings.
1369 ACTIVATE-FUNC is a function to call to activate this method.
1370 TITLE is a string to show in the mode line when this method is active.
1371 DESCRIPTION is a string describing this method and what it is good for.
1372 The ARGS, if any, are passed as arguments to ACTIVATE-FUNC.
1373 All told, the arguments to ACTIVATE-FUNC are INPUT-METHOD and the ARGS.
1375 This function is mainly used in the file \"leim-list.el\" which is
1376 created at Emacs build time, registering all Quail input methods
1377 contained in the Emacs distribution.
1379 In case you want to register a new Quail input method by yourself, be
1380 careful to use the same input method title as given in the third
1381 parameter of `quail-define-package'. (If the values are different, the
1382 string specified in this function takes precedence.)
1384 The commands `describe-input-method' and `list-input-methods' need
1385 these duplicated values to show some information about input methods
1386 without loading the relevant Quail packages.
1387 \n(fn INPUT-METHOD LANG-ENV ACTIVATE-FUNC TITLE DESCRIPTION &rest ARGS)"
1388 (if (symbolp lang-env)
1389 (setq lang-env (symbol-name lang-env)))
1390 (if (symbolp input-method)
1391 (setq input-method (symbol-name input-method)))
1392 (let ((info (cons lang-env args))
1393 (slot (assoc input-method input-method-alist)))
1396 (setq slot (cons input-method info))
1397 (setq input-method-alist (cons slot input-method-alist)))))
1399 (defun read-input-method-name (prompt &optional default inhibit-null)
1400 "Read a name of input method from a minibuffer prompting with PROMPT.
1401 If DEFAULT is non-nil, use that as the default,
1402 and substitute it into PROMPT at the first `%s'.
1403 If INHIBIT-NULL is non-nil, null input signals an error.
1405 The return value is a string."
1407 (setq prompt (format prompt default)))
1408 (let* ((completion-ignore-case t)
1409 ;; As it is quite normal to change input method in the
1410 ;; minibuffer, we must enable it even if
1411 ;; enable-recursive-minibuffers is currently nil.
1412 (enable-recursive-minibuffers t)
1413 ;; This binding is necessary because input-method-history is
1415 (input-method (completing-read prompt input-method-alist
1416 nil t nil 'input-method-history
1418 (if (and input-method (symbolp input-method))
1419 (setq input-method (symbol-name input-method)))
1420 (if (> (length input-method) 0)
1423 (error "No valid input method is specified")))))
1425 (defun activate-input-method (input-method)
1426 "Switch to input method INPUT-METHOD for the current buffer.
1427 If some other input method is already active, turn it off first.
1428 If INPUT-METHOD is nil, deactivate any current input method."
1429 (if (and input-method (symbolp input-method))
1430 (setq input-method (symbol-name input-method)))
1431 (if (and current-input-method
1432 (not (string= current-input-method input-method)))
1433 (inactivate-input-method))
1434 (unless (or current-input-method (null input-method))
1435 (let ((slot (assoc input-method input-method-alist)))
1437 (error "Can't activate input method `%s'" input-method))
1438 (setq current-input-method-title nil)
1439 (let ((func (nth 2 slot)))
1440 (if (functionp func)
1441 (apply (nth 2 slot) input-method (nthcdr 5 slot))
1442 (if (and (consp func) (symbolp (car func)) (symbolp (cdr func)))
1444 (require (cdr func))
1445 (apply (car func) input-method (nthcdr 5 slot)))
1446 (error "Can't activate input method `%s'" input-method))))
1447 (setq current-input-method input-method)
1448 (or (stringp current-input-method-title)
1449 (setq current-input-method-title (nth 3 slot)))
1451 (run-hooks 'input-method-activate-hook)
1452 (force-mode-line-update)))))
1454 (defun inactivate-input-method ()
1455 "Turn off the current input method."
1456 (when current-input-method
1457 (if input-method-history
1458 (unless (string= current-input-method (car input-method-history))
1459 (setq input-method-history
1460 (cons current-input-method
1461 (delete current-input-method input-method-history))))
1462 (setq input-method-history (list current-input-method)))
1465 (setq input-method-function nil
1466 current-input-method-title nil)
1467 (funcall inactivate-current-input-method-function))
1469 (run-hooks 'input-method-inactivate-hook)
1470 (setq current-input-method nil)
1471 (force-mode-line-update)))))
1473 (defun set-input-method (input-method &optional interactive)
1474 "Select and activate input method INPUT-METHOD for the current buffer.
1475 This also sets the default input method to the one you specify.
1476 If INPUT-METHOD is nil, this function turns off the input method, and
1477 also causes you to be prompted for a name of an input method the next
1478 time you invoke \\[toggle-input-method].
1479 When called interactively, the optional arg INTERACTIVE is non-nil,
1480 which marks the variable `default-input-method' as set for Custom buffers.
1482 To deactivate the input method interactively, use \\[toggle-input-method].
1483 To deactivate it programmatically, use `inactivate-input-method'."
1485 (let* ((default (or (car input-method-history) default-input-method)))
1486 (list (read-input-method-name
1487 (if default "Select input method (default %s): " "Select input method: ")
1490 (activate-input-method input-method)
1491 (setq default-input-method input-method)
1493 (customize-mark-as-set 'default-input-method))
1494 default-input-method)
1496 (defvar toggle-input-method-active nil
1497 "Non-nil inside `toggle-input-method'.")
1499 (defun toggle-input-method (&optional arg interactive)
1500 "Enable or disable multilingual text input method for the current buffer.
1501 Only one input method can be enabled at any time in a given buffer.
1503 The normal action is to enable an input method if none was enabled,
1504 and disable the current one otherwise. Which input method to enable
1505 can be determined in various ways--either the one most recently used,
1506 or the one specified by `default-input-method', or as a last resort
1507 by reading the name of an input method in the minibuffer.
1509 With a prefix argument ARG, read an input method name with the minibuffer
1510 and enable that one. The default is the most recent input method specified
1511 \(not including the currently active input method, if any).
1513 When called interactively, the optional argument INTERACTIVE is non-nil,
1514 which marks the variable `default-input-method' as set for Custom buffers."
1516 (interactive "P\np")
1517 (if toggle-input-method-active
1518 (error "Recursive use of `toggle-input-method'"))
1519 (if (and current-input-method (not arg))
1520 (inactivate-input-method)
1521 (let ((toggle-input-method-active t)
1522 (default (or (car input-method-history) default-input-method)))
1523 (if (and arg default (equal current-input-method default)
1524 (> (length input-method-history) 1))
1525 (setq default (nth 1 input-method-history)))
1526 (activate-input-method
1527 (if (or arg (not default))
1529 (read-input-method-name
1530 (if default "Input method (default %s): " "Input method: " )
1533 (unless default-input-method
1535 (setq default-input-method current-input-method)
1537 (customize-mark-as-set 'default-input-method)))))))
1539 (autoload 'help-buffer "help-mode")
1541 (defun describe-input-method (input-method)
1542 "Describe input method INPUT-METHOD."
1544 (list (read-input-method-name
1545 "Describe input method (default current choice): ")))
1546 (if (and input-method (symbolp input-method))
1547 (setq input-method (symbol-name input-method)))
1548 (help-setup-xref (list #'describe-input-method
1549 (or input-method current-input-method))
1552 (if (null input-method)
1553 (describe-current-input-method)
1554 (let ((current current-input-method))
1558 (activate-input-method input-method)
1559 (describe-current-input-method))
1560 (activate-input-method current))
1562 (activate-input-method current)
1563 (help-setup-xref (list #'describe-input-method input-method)
1565 (with-output-to-temp-buffer (help-buffer)
1566 (let ((elt (assoc input-method input-method-alist)))
1568 "Input method: %s (`%s' in mode line) for %s\n %s\n"
1569 input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
1571 (defun describe-current-input-method ()
1572 "Describe the input method currently in use.
1573 This is a subroutine for `describe-input-method'."
1574 (if current-input-method
1575 (if (and (symbolp describe-current-input-method-function)
1576 (fboundp describe-current-input-method-function))
1577 (funcall describe-current-input-method-function)
1578 (message "No way to describe the current input method `%s'"
1579 current-input-method)
1581 (error "No input method is activated now")))
1583 (defun read-multilingual-string (prompt &optional initial-input input-method)
1584 "Read a multilingual string from minibuffer, prompting with string PROMPT.
1585 The input method selected last time is activated in minibuffer.
1586 If optional second argument INITIAL-INPUT is non-nil, insert it in the
1587 minibuffer initially.
1588 Optional 3rd argument INPUT-METHOD specifies the input method to be activated
1589 instead of the one selected last time. It is a symbol or a string."
1592 current-input-method
1593 default-input-method
1594 (read-input-method-name "Input method: " nil t)))
1595 (if (and input-method (symbolp input-method))
1596 (setq input-method (symbol-name input-method)))
1597 (let ((prev-input-method current-input-method))
1600 (activate-input-method input-method)
1601 (read-string prompt initial-input nil nil t))
1602 (activate-input-method prev-input-method))))
1604 ;; Variables to control behavior of input methods. All input methods
1605 ;; should react to these variables.
1607 (defcustom input-method-verbose-flag 'default
1608 "A flag to control extra guidance given by input methods.
1609 The value should be nil, t, `complex-only', or `default'.
1611 The extra guidance is done by showing list of available keys in echo
1612 area. When you use the input method in the minibuffer, the guidance
1613 is shown at the bottom short window (split from the existing window).
1615 If the value is t, extra guidance is always given, if the value is
1616 nil, extra guidance is always suppressed.
1618 If the value is `complex-only', only complex input methods such as
1619 `chinese-py' and `japanese' give extra guidance.
1621 If the value is `default', complex input methods always give extra
1622 guidance, but simple input methods give it only when you are not in
1625 See also the variable `input-method-highlight-flag'."
1626 :type '(choice (const :tag "Always" t) (const :tag "Never" nil)
1627 (const complex-only) (const default))
1630 (defcustom input-method-highlight-flag t
1631 "If this flag is non-nil, input methods highlight partially-entered text.
1632 For instance, while you are in the middle of a Quail input method sequence,
1633 the text inserted so far is temporarily underlined.
1634 The underlining goes away when you finish or abort the input method sequence.
1635 See also the variable `input-method-verbose-flag'."
1639 (defcustom input-method-activate-hook nil
1640 "Normal hook run just after an input method is activated.
1642 The variable `current-input-method' keeps the input method name
1647 (defcustom input-method-inactivate-hook nil
1648 "Normal hook run just after an input method is inactivated.
1650 The variable `current-input-method' still keeps the input method name
1655 (defcustom input-method-after-insert-chunk-hook nil
1656 "Normal hook run just after an input method insert some chunk of text."
1660 (defvar input-method-exit-on-first-char nil
1661 "This flag controls when an input method returns.
1662 Usually, the input method does not return while there's a possibility
1663 that it may find a different translation if a user types another key.
1664 But, if this flag is non-nil, the input method returns as soon as the
1665 current key sequence gets long enough to have some valid translation.")
1667 (defcustom input-method-use-echo-area nil
1668 "This flag controls how an input method shows an intermediate key sequence.
1669 Usually, the input method inserts the intermediate key sequence,
1670 or candidate translations corresponding to the sequence,
1671 at point in the current buffer.
1672 But, if this flag is non-nil, it displays them in echo area instead."
1676 (defvar input-method-exit-on-invalid-key nil
1677 "This flag controls the behavior of an input method on invalid key input.
1678 Usually, when a user types a key which doesn't start any character
1679 handled by the input method, the key is handled by turning off the
1680 input method temporarily. After that key, the input method is re-enabled.
1681 But, if this flag is non-nil, the input method is never back on.")
1684 (defcustom set-language-environment-hook nil
1685 "Normal hook run after some language environment is set.
1687 When you set some hook function here, that effect usually should not
1688 be inherited to another language environment. So, you had better set
1689 another function in `exit-language-environment-hook' (which see) to
1694 (defcustom exit-language-environment-hook nil
1695 "Normal hook run after exiting from some language environment.
1696 When this hook is run, the variable `current-language-environment'
1697 is still bound to the language environment being exited.
1699 This hook is mainly used for canceling the effect of
1700 `set-language-environment-hook' (which see)."
1704 (put 'setup-specified-language-environment 'apropos-inhibit t)
1706 (defun setup-specified-language-environment ()
1707 "Switch to a specified language environment."
1709 (let (language-name)
1710 (if (and (symbolp last-command-event)
1711 (or (not (eq last-command-event 'Default))
1712 (setq last-command-event 'English))
1713 (setq language-name (symbol-name last-command-event)))
1715 (set-language-environment language-name)
1716 (customize-mark-as-set 'current-language-environment))
1717 (error "Bogus calling sequence"))))
1719 (defcustom current-language-environment "English"
1720 "The last language environment specified with `set-language-environment'.
1721 This variable should be set only with \\[customize], which is equivalent
1722 to using the function `set-language-environment'."
1723 :link '(custom-manual "(emacs)Language Environments")
1724 :set (lambda (symbol value) (set-language-environment value))
1726 (or (car-safe (assoc-string
1727 (if (symbolp current-language-environment)
1728 (symbol-name current-language-environment)
1729 current-language-environment)
1730 language-info-alist t))
1732 ;; custom type will be updated with `set-language-info'.
1733 :type (if language-info-alist
1734 (cons 'choice (mapcar
1737 (sort (mapcar 'car language-info-alist) 'string<)))
1739 :initialize 'custom-initialize-default
1742 (defun reset-language-environment ()
1743 "Reset multilingual environment of Emacs to the default status.
1745 The default status is as follows:
1747 The default value of `buffer-file-coding-system' is nil.
1748 The default coding system for process I/O is nil.
1749 The default value for the command `set-terminal-coding-system' is nil.
1750 The default value for the command `set-keyboard-coding-system' is nil.
1752 The order of priorities of coding systems are as follows:
1761 ;; This function formerly set default-enable-multibyte-characters to t,
1762 ;; but that is incorrect. It should not alter the unibyte/multibyte choice.
1764 (set-coding-system-priority
1773 (set-default-coding-systems nil)
1774 (setq default-sendmail-coding-system 'iso-latin-1)
1775 ;; On Darwin systems, this should be utf-8, but when this file is loaded
1776 ;; utf-8 is not yet defined, so we set it in set-locale-environment instead.
1777 (setq default-file-name-coding-system 'iso-latin-1)
1778 ;; Preserve eol-type from existing default-process-coding-systems.
1779 ;; On non-unix-like systems in particular, these may have been set
1780 ;; carefully by the user, or by the startup code, to deal with the
1781 ;; users shell appropriately, so should not be altered by changing
1782 ;; language environment.
1783 (let ((output-coding
1784 ;; When bootstrapping, coding-systems are not defined yet, so
1785 ;; we need to catch the error from check-coding-system.
1787 (coding-system-change-text-conversion
1788 (car default-process-coding-system) 'undecided)
1789 (coding-system-error 'undecided)))
1792 (coding-system-change-text-conversion
1793 (cdr default-process-coding-system) 'iso-latin-1)
1794 (coding-system-error 'iso-latin-1))))
1795 (setq default-process-coding-system
1796 (cons output-coding input-coding)))
1798 ;; Put the highest priority to the charset iso-8859-1 to prefer the
1799 ;; registry iso8859-1 over iso8859-2 in font selection. It also
1800 ;; makes unibyte-display-via-language-environment to use iso-8859-1
1801 ;; as the unibyte charset.
1802 (set-charset-priority 'iso-8859-1)
1804 ;; Don't alter the terminal and keyboard coding systems here.
1805 ;; The terminal still supports the same coding system
1806 ;; that it supported a minute ago.
1807 ;; (set-terminal-coding-system-internal nil)
1808 ;; (set-keyboard-coding-system-internal nil)
1810 ;; Back in Emacs-20, it was necessary to provide some fallback implicit
1811 ;; conversion, because almost no packages handled coding-system issues.
1812 ;; Nowadays it'd just paper over bugs.
1813 ;; (set-unibyte-charset 'iso-8859-1)
1816 (reset-language-environment)
1818 (defun set-display-table-and-terminal-coding-system (language-name &optional coding-system display)
1819 "Set up the display table and terminal coding system for LANGUAGE-NAME."
1820 (let ((coding (get-language-info language-name 'unibyte-display)))
1822 (or (not coding-system)
1823 (coding-system-equal coding coding-system)))
1824 (standard-display-european-internal)
1825 ;; The following 2 lines undo the 8-bit display that we set up
1826 ;; in standard-display-european-internal, which see. This is in
1827 ;; case the user has used standard-display-european earlier in
1829 (when standard-display-table
1831 (aset standard-display-table (+ i 128) nil))))
1832 (set-terminal-coding-system (or coding-system coding) display)))
1834 (defun set-language-environment (language-name)
1835 "Set up multi-lingual environment for using LANGUAGE-NAME.
1836 This sets the coding system priority and the default input method
1837 and sometimes other things. LANGUAGE-NAME should be a string
1838 which is the name of a language environment. For example, \"Latin-1\"
1839 specifies the character set for the major languages of Western Europe."
1840 (interactive (list (read-language-name
1842 "Set language environment (default English): ")))
1844 (if (symbolp language-name)
1845 (setq language-name (symbol-name language-name)))
1846 (setq language-name "English"))
1847 (let ((slot (assoc-string language-name language-info-alist t)))
1849 (error "Language environment not defined: %S" language-name))
1850 (setq language-name (car slot)))
1851 (if current-language-environment
1852 (let ((func (get-language-info current-language-environment
1854 (run-hooks 'exit-language-environment-hook)
1855 (if (functionp func) (funcall func))))
1857 (reset-language-environment)
1858 ;; The features might set up coding systems.
1859 (let ((required-features (get-language-info language-name 'features)))
1860 (while required-features
1861 (require (car required-features))
1862 (setq required-features (cdr required-features))))
1864 (setq current-language-environment language-name)
1866 (set-language-environment-coding-systems language-name)
1867 (set-language-environment-input-method language-name)
1868 (set-language-environment-nonascii-translation language-name)
1869 (set-language-environment-charset language-name)
1870 ;; Unibyte setups if necessary.
1871 (unless default-enable-multibyte-characters
1872 (set-language-environment-unibyte language-name))
1874 (let ((func (get-language-info language-name 'setup-function)))
1875 (if (functionp func)
1878 (setq current-iso639-language
1879 (or (get-language-info language-name 'iso639-language)
1880 current-iso639-language))
1882 (run-hooks 'set-language-environment-hook)
1883 (force-mode-line-update t))
1885 (define-widget 'charset 'symbol
1888 :complete-function (lambda ()
1890 (lisp-complete-symbol 'charsetp))
1891 :completion-ignore-case t
1893 :validate (lambda (widget)
1894 (unless (charsetp (widget-value widget))
1895 (widget-put widget :error (format "Invalid charset: %S"
1896 (widget-value widget)))
1898 :prompt-history 'charset-history)
1900 (defcustom language-info-custom-alist nil
1901 "Customizations of language environment parameters.
1902 Value is an alist with elements like those of `language-info-alist'.
1903 These are used to set values in `language-info-alist' which replace
1904 the defaults. A typical use is replacing the default input method for
1905 the environment. Use \\[describe-language-environment] to find the environment's settings.
1907 This option is intended for use at startup. Removing items doesn't
1908 remove them from the language info until you next restart Emacs.
1910 Setting this variable directly does not take effect.
1911 See `set-language-info-alist' for use in programs."
1915 (custom-set-default s v)
1916 ;; Can't do this before language environments are set up.
1918 ;; modify language-info-alist
1920 (set-language-info-alist (car elt) (cdr elt)))
1921 ;; re-set the environment in case its parameters changed
1922 (set-language-environment current-language-environment)))
1924 :key-type (string :tag "Language environment"
1925 :completion-ignore-case t
1926 :complete-function widget-string-complete
1927 :completion-alist language-info-alist)
1929 (alist :key-type symbol
1930 :options ((documentation string)
1931 (charset (repeat charset))
1932 (sample-text string)
1933 (setup-function function)
1934 (exit-function function)
1935 (coding-system (repeat coding-system))
1936 (coding-priority (repeat coding-system))
1937 (nonascii-translation charset)
1940 :completion-ignore-case t
1941 :complete-function widget-string-complete
1942 :completion-alist input-method-alist
1943 :prompt-history input-method-history))
1944 (features (repeat symbol))
1945 (unibyte-display coding-system)))))
1947 (declare-function x-server-vendor "xfns.c" (&optional terminal))
1948 (declare-function x-server-version "xfns.c" (&optional terminal))
1950 (defun standard-display-european-internal ()
1951 ;; Actually set up direct output of non-ASCII characters.
1952 (standard-display-8bit (if (eq window-system 'pc) 128 160) 255)
1953 ;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with
1954 ;; the native font, and codes 160 and 146 stand for something very
1956 (or (and (eq window-system 'pc) (not default-enable-multibyte-characters))
1958 ;; Most X fonts used to do the wrong thing for latin-1 code 160.
1959 (unless (and (eq window-system 'x)
1960 ;; XFree86 4 has fixed the fonts.
1961 (string= "The XFree86 Project, Inc" (x-server-vendor))
1962 (> (aref (number-to-string (nth 2 (x-server-version))) 0)
1964 ;; Make non-line-break space display as a plain space.
1965 (aset standard-display-table 160 [32]))
1966 ;; Most Windows programs send out apostrophes as \222. Most X fonts
1967 ;; don't contain a character at that position. Map it to the ASCII
1968 ;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
1969 ;; U+2019, normally from the windows-1252 character set. XFree 4
1970 ;; fonts probably have the appropriate glyph at this position,
1971 ;; so they could use standard-display-8bit. It's better to use a
1972 ;; proper windows-1252 coding system. --fx]
1973 (aset standard-display-table 146 [39]))))
1975 (defun set-language-environment-coding-systems (language-name)
1976 "Do various coding system setups for language environment LANGUAGE-NAME."
1977 (let* ((priority (get-language-info language-name 'coding-priority))
1978 (default-coding (car priority))
1979 ;; If default-buffer-file-coding-system is nil, don't use
1980 ;; coding-system-eol-type, because it treats nil as
1981 ;; `no-conversion'. default-buffer-file-coding-system is set
1982 ;; to nil by reset-language-environment, and in that case we
1983 ;; want to have here the native EOL type for each platform.
1984 ;; FIXME: there should be a common code that runs both on
1985 ;; startup and here to set the default EOL type correctly.
1986 ;; Right now, DOS/Windows platforms set this on dos-w32.el,
1987 ;; which works only as long as the order of loading files at
1988 ;; dump time and calling functions at startup is not modified
1989 ;; significantly, i.e. as long as this function is called
1990 ;; _after_ default-buffer-file-coding-system was set by
1993 (if (null default-buffer-file-coding-system)
1994 (cond ((memq system-type '(windows-nt ms-dos)) 1)
1995 ((eq system-type 'macos) 2)
1997 (coding-system-eol-type default-buffer-file-coding-system))))
1999 (set-default-coding-systems
2000 (if (memq eol-type '(0 1 2 unix dos mac))
2001 (coding-system-change-eol-conversion default-coding eol-type)
2003 (setq default-sendmail-coding-system default-coding)
2004 (apply 'set-coding-system-priority priority))))
2006 (defun set-language-environment-input-method (language-name)
2007 "Do various input method setups for language environment LANGUAGE-NAME."
2008 (let ((input-method (get-language-info language-name 'input-method)))
2010 (setq default-input-method input-method)
2011 (if input-method-history
2012 (setq input-method-history
2014 (delete input-method input-method-history)))))))
2016 (defun set-language-environment-nonascii-translation (language-name)
2017 "Do unibyte/multibyte translation setup for language environment LANGUAGE-NAME."
2018 ;; Note: For DOS, we assumed that the charset cpXXX is already
2020 (let ((nonascii (get-language-info language-name 'nonascii-translation)))
2021 (if (eq window-system 'pc)
2022 (setq nonascii (intern (format "cp%d" dos-codepage))))
2023 (or (and (charsetp nonascii)
2024 (get-charset-property nonascii :ascii-compatible-p))
2025 (setq nonascii 'iso-8859-1))
2026 ;; Back in Emacs-20, it was necessary to provide some fallback implicit
2027 ;; conversion, because almost no packages handled coding-system issues.
2028 ;; Nowadays it'd just paper over bugs.
2029 ;; (set-unibyte-charset nonascii)
2032 (defun set-language-environment-charset (language-name)
2033 "Do various charset setups for language environment LANGUAGE-NAME."
2034 ;; Put higher priorities to such charsets that are supported by the
2035 ;; coding systems of higher priorities in this environment.
2036 (let ((charsets (get-language-info language-name 'charset)))
2037 (dolist (coding (get-language-info language-name 'coding-priority))
2038 (let ((list (coding-system-charset-list coding)))
2040 (setq charsets (append charsets list)))))
2042 (apply 'set-charset-priority charsets))))
2044 (defun set-language-environment-unibyte (language-name)
2045 "Do various unibyte-mode setups for language environment LANGUAGE-NAME."
2046 (set-display-table-and-terminal-coding-system language-name))
2048 (defsubst princ-list (&rest args)
2049 "Print all arguments with `princ', then print \"\\n\"."
2050 (while args (princ (car args)) (setq args (cdr args)))
2053 (put 'describe-specified-language-support 'apropos-inhibit t)
2055 ;; Print language-specific information such as input methods,
2056 ;; charsets, and coding systems. This function is intended to be
2057 ;; called from the menu:
2058 ;; [menu-bar mule describe-language-environment LANGUAGE]
2059 ;; and should not run it by `M-x describe-current-input-method-function'.
2060 (defun describe-specified-language-support ()
2061 "Describe how Emacs supports the specified language environment."
2063 (let (language-name)
2064 (if (not (and (symbolp last-command-event)
2065 (or (not (eq last-command-event 'Default))
2066 (setq last-command-event 'English))
2067 (setq language-name (symbol-name last-command-event))))
2068 (error "Bogus calling sequence"))
2069 (describe-language-environment language-name)))
2071 (defun describe-language-environment (language-name)
2072 "Describe how Emacs supports language environment LANGUAGE-NAME."
2074 (list (read-language-name
2076 "Describe language environment (default current choice): ")))
2077 (if (null language-name)
2078 (setq language-name current-language-environment))
2079 (if (or (null language-name)
2080 (null (get-language-info language-name 'documentation)))
2081 (error "No documentation for the specified language"))
2082 (if (symbolp language-name)
2083 (setq language-name (symbol-name language-name)))
2084 (dolist (feature (get-language-info language-name 'features))
2086 (let ((doc (get-language-info language-name 'documentation)))
2087 (help-setup-xref (list #'describe-language-environment language-name)
2089 (with-output-to-temp-buffer (help-buffer)
2091 (set-buffer standard-output)
2092 (insert language-name " language environment\n\n")
2094 (insert doc "\n\n"))
2096 (let ((str (eval (get-language-info language-name 'sample-text))))
2098 (insert "Sample text:\n "
2099 (replace-regexp-in-string "\n" "\n " str)
2102 (let ((input-method (get-language-info language-name 'input-method))
2103 (l (copy-sequence input-method-alist))
2105 (when (and input-method
2106 (setq input-method (assoc input-method l)))
2107 (insert "Input methods (default " (car input-method) ")\n")
2108 (setq l (cons input-method (delete input-method l))
2111 (when (or (eq input-method elt)
2112 (eq t (compare-strings language-name nil nil
2113 (nth 1 elt) nil nil t)))
2115 (insert "Input methods:\n")
2117 (insert " " (car elt))
2118 (search-backward (car elt))
2119 (help-xref-button 0 'help-input-method (car elt))
2120 (goto-char (point-max))
2122 (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
2123 "\" in mode line)\n")))
2126 (insert "Character sets:\n")
2127 (let ((l (get-language-info language-name 'charset)))
2129 (insert " nothing specific to " language-name "\n")
2131 (insert " " (symbol-name (car l)))
2132 (search-backward (symbol-name (car l)))
2133 (help-xref-button 0 'help-character-set (car l))
2134 (goto-char (point-max))
2135 (insert ": " (charset-description (car l)) "\n")
2138 (insert "Coding systems:\n")
2139 (let ((l (get-language-info language-name 'coding-system)))
2141 (insert " nothing specific to " language-name "\n")
2143 (insert " " (symbol-name (car l)))
2144 (search-backward (symbol-name (car l)))
2145 (help-xref-button 0 'help-coding-system (car l))
2146 (goto-char (point-max))
2148 (coding-system-mnemonic (car l))
2149 "' in mode line):\n\t"
2150 (coding-system-doc-string (car l))
2152 (let ((aliases (coding-system-aliases (car l))))
2154 (insert "\t(alias:")
2156 (insert " " (symbol-name (car aliases)))
2157 (setq aliases (cdr aliases)))
2159 (setq l (cdr l)))))))))
2163 (defvar locale-translation-file-name nil
2164 "File name for the system's file of locale-name aliases, or nil if none.")
2166 ;; The following definitions might as well be marked as constants and
2167 ;; purecopied, since they're normally used on startup, and probably
2168 ;; should reflect the facilities of the base Emacs.
2169 (defconst locale-language-names
2172 ;; Locale names of the form LANGUAGE[_TERRITORY][.CODESET][@MODIFIER]
2173 ;; as specified in the Single Unix Spec, Version 2.
2174 ;; LANGUAGE is a language code taken from ISO 639:1988 (E/F)
2175 ;; with additions from ISO 639/RA Newsletter No.1/1989;
2176 ;; see Internet RFC 2165 (1997-06) and
2177 ;; http://www.evertype.com/standards/iso639/iso639-en.html
2178 ;; TERRITORY is a country code taken from ISO 3166
2179 ;; http://www.din.de/gremien/nas/nabd/iso3166ma/codlstp1/en_listp1.html.
2180 ;; CODESET and MODIFIER are implementation-dependent.
2182 ;; jasonr comments: MS Windows uses three letter codes for
2183 ;; languages instead of the two letter ISO codes that POSIX
2184 ;; uses. In most cases the first two letters are the same, so
2185 ;; most of the regexps in locale-language-names work. Japanese
2186 ;; and Chinese are exceptions, which are listed in the
2187 ;; non-standard section at the bottom of locale-language-names.
2189 ("aa_DJ" . "Latin-1") ; Afar
2192 ("af" . "Latin-1") ; Afrikaans
2193 ("am" "Ethiopic" utf-8) ; Amharic
2194 ("an" . "Latin-9") ; Aragonese
2195 ; ar Arabic glibc uses 8859-6
2198 ("az" . "UTF-8") ; Azerbaijani
2200 ("be" "Belarusian" cp1251) ; Belarusian [Byelorussian until early 1990s]
2201 ("bg" "Bulgarian" cp1251) ; Bulgarian
2204 ("bn" . "UTF-8") ; Bengali, Bangla
2206 ("br" . "Latin-1") ; Breton
2207 ("bs" . "Latin-2") ; Bosnian
2208 ("byn" . "UTF-8") ; Bilin; Blin
2209 ("ca" . "Latin-1") ; Catalan
2211 ("cs" "Czech" iso-8859-2)
2212 ("cy" "Welsh" iso-8859-14)
2213 ("da" . "Latin-1") ; Danish
2214 ("de" "German" iso-8859-1)
2217 ("el" "Greek" iso-8859-7)
2218 ;; Users who specify "en" explicitly typically want Latin-1, not ASCII.
2219 ;; That's actually what the GNU locales define, modulo things like
2221 ("en_IN" "English" utf-8) ; glibc uses utf-8 for English in India
2222 ("en" "English" iso-8859-1) ; English
2223 ("eo" . "Esperanto") ; Esperanto
2224 ("es" "Spanish" iso-8859-1)
2225 ("et" . "Latin-1") ; Estonian
2226 ("eu" . "Latin-1") ; Basque
2227 ("fa" . "UTF-8") ; Persian
2228 ("fi" . "Latin-1") ; Finnish
2229 ("fj" . "Latin-1") ; Fiji
2230 ("fo" . "Latin-1") ; Faroese
2231 ("fr" "French" iso-8859-1) ; French
2232 ("fy" . "Latin-1") ; Frisian
2233 ("ga" . "Latin-1") ; Irish Gaelic (new orthography)
2234 ("gd" . "Latin-9") ; Scots Gaelic
2235 ("gez" "Ethiopic" utf-8) ; Geez
2236 ("gl" . "Latin-1") ; Gallegan; Galician
2238 ("gu" . "UTF-8") ; Gujarati
2239 ("gv" . "Latin-1") ; Manx Gaelic
2241 ("he" "Hebrew" iso-8859-8)
2242 ("hi" "Devanagari" utf-8) ; Hindi
2243 ("hr" "Croatian" iso-8859-2) ; Croatian
2244 ("hu" . "Latin-2") ; Hungarian
2247 ("id" . "Latin-1") ; Indonesian
2250 ("is" . "Latin-1") ; Icelandic
2251 ("it" "Italian" iso-8859-1) ; Italian
2253 ("iw" "Hebrew" iso-8859-8)
2254 ("ja" "Japanese" euc-jp)
2256 ("ka" "Georgian" georgian-ps) ; Georgian
2258 ("kl" . "Latin-1") ; Greenlandic
2260 ("kn" "Kannada" utf-8)
2261 ("ko" "Korean" euc-kr)
2264 ("kw" . "Latin-1") ; Cornish
2266 ("la" . "Latin-1") ; Latin
2267 ("lb" . "Latin-1") ; Luxemburgish
2268 ("lg" . "Laint-6") ; Ganda
2270 ("lo" "Lao" utf-8) ; Laothian
2271 ("lt" "Lithuanian" iso-8859-13)
2272 ("lv" . "Latvian") ; Latvian, Lettish
2274 ("mi" . "Latin-7") ; Maori
2275 ("mk" "Cyrillic-ISO" iso-8859-5) ; Macedonian
2276 ("ml" "Malayalam" utf-8)
2277 ("mn" . "UTF-8") ; Mongolian
2279 ("mr" "Devanagari" utf-8) ; Marathi
2280 ("ms" . "Latin-1") ; Malay
2281 ("mt" . "Latin-3") ; Maltese
2284 ("nb" . "Latin-1") ; Norwegian
2285 ("ne" "Devanagari" utf-8) ; Nepali
2286 ("nl" "Dutch" iso-8859-1)
2287 ("no" . "Latin-1") ; Norwegian
2288 ("oc" . "Latin-1") ; Occitan
2289 ("om_ET" . "UTF-8") ; (Afan) Oromo
2290 ("om" . "Latin-1") ; (Afan) Oromo
2292 ("pa" . "UTF-8") ; Punjabi
2293 ("pl" . "Latin-2") ; Polish
2295 ("pt" . "Latin-1") ; Portuguese
2297 ("rm" . "Latin-1") ; Rhaeto-Romanic
2299 ("ro" "Romanian" iso-8859-2)
2300 ("ru_RU" "Russian" iso-8859-5)
2301 ("ru_UA" "Russian" koi8-u)
2303 ("sa" . "Devanagari") ; Sanskrit
2305 ("se" . "UTF-8") ; Northern Sami
2307 ("sh" . "Latin-2") ; Serbo-Croatian
2309 ("sid" . "UTF-8") ; Sidamo
2310 ("sk" "Slovak" iso-8859-2)
2311 ("sl" "Slovenian" iso-8859-2)
2314 ("so_ET" "UTF-8") ; Somali
2315 ("so" "Latin-1") ; Somali
2316 ("sq" . "Latin-1") ; Albanian
2317 ("sr" . "Latin-2") ; Serbian (Latin alphabet)
2319 ("st" . "Latin-1") ; Sesotho
2321 ("sv" "Swedish" iso-8859-1) ; Swedish
2322 ("sw" . "Latin-1") ; Swahili
2323 ("ta" "Tamil" utf-8)
2324 ("te" . "UTF-8") ; Telugu
2325 ("tg" "Tajik" koi8-t)
2326 ("th" "Thai" tis-620)
2327 ("ti" "Ethiopic" utf-8) ; Tigrinya
2328 ("tig_ER" . "UTF-8") ; Tigre
2330 ("tl" . "Latin-1") ; Tagalog
2333 ("tr" "Turkish" iso-8859-9)
2335 ("tt" . "UTF-8") ; Tatar
2338 ("uk" "Ukrainian" koi8-u)
2339 ("ur" . "UTF-8") ; Urdu
2340 ("uz_UZ@cyrillic" . "UTF-8"); Uzbek
2341 ("uz" . "Latin-1") ; Uzbek
2342 ("vi" "Vietnamese" utf-8)
2344 ("wa" . "Latin-1") ; Walloon
2346 ("xh" . "Latin-1") ; Xhosa
2347 ("yi" . "Windows-1255") ; Yiddish
2350 ("zh_HK" . "Chinese-Big5")
2351 ; zh_HK/BIG5-HKSCS \
2352 ("zh_TW" . "Chinese-Big5")
2353 ("zh_CN.GB2312" "Chinese-GB")
2354 ("zh_CN.GBK" "Chinese-GBK")
2355 ("zh_CN.GB18030" "Chinese-GB18030")
2356 ("zh_CN.UTF-8" . "Chinese-GBK")
2357 ("zh_CN" . "Chinese-GB")
2358 ("zh" . "Chinese-GB")
2359 ("zu" . "Latin-1") ; Zulu
2361 ;; ISO standard locales
2363 ("posix$" . "ASCII")
2365 ;; The "IPA" Emacs language environment does not correspond
2366 ;; to any ISO 639 code, so let it stand for itself.
2369 ;; Nonstandard or obsolete language codes
2370 ("cz" . "Czech") ; e.g. Solaris 2.6
2371 ("ee" . "Latin-4") ; Estonian, e.g. X11R6.4
2372 ("iw" . "Hebrew") ; e.g. X11R6.4
2373 ("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4
2374 ("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6
2375 ("jp" . "Japanese") ; e.g. MS Windows
2376 ("chs" . "Chinese-GBK") ; MS Windows Chinese Simplified
2377 ("cht" . "Chinese-BIG5") ; MS Windows Chinese Traditional
2378 ("gbz" . "UTF-8") ; MS Windows Dari Persian
2379 ("div" . "UTF-8") ; MS Windows Divehi (Maldives)
2380 ("wee" . "Latin-2") ; MS Windows Lower Sorbian
2381 ("wen" . "Latin-2") ; MS Windows Upper Sorbian
2383 "Alist of locale regexps vs the corresponding languages and coding systems.
2384 Each element has this form:
2385 \(LOCALE-REGEXP LANG-ENV CODING-SYSTEM)
2386 The first element whose LOCALE-REGEXP matches the start of a
2387 downcased locale specifies the LANG-ENV \(language environment)
2388 and CODING-SYSTEM corresponding to that locale. If there is no
2389 appropriate language environment, the element may have this form:
2390 \(LOCALE-REGEXP . LANG-ENV)
2391 In this case, LANG-ENV is one of generic language environments for an
2392 specific encoding such as \"Latin-1\" and \"UTF-8\".")
2394 (defconst locale-charset-language-names
2396 '((".*8859[-_]?1\\>" . "Latin-1")
2397 (".*8859[-_]?2\\>" . "Latin-2")
2398 (".*8859[-_]?3\\>" . "Latin-3")
2399 (".*8859[-_]?4\\>" . "Latin-4")
2400 (".*8859[-_]?9\\>" . "Latin-5")
2401 (".*8859[-_]?14\\>" . "Latin-8")
2402 (".*8859[-_]?15\\>" . "Latin-9")
2403 (".*utf\\(?:-?8\\)?\\>" . "UTF-8")
2404 ;; utf-8@euro exists, so put this last. (@euro really specifies
2405 ;; the currency, rather than the charset.)
2406 (".*@euro\\>" . "Latin-9")))
2407 "List of pairs of locale regexps and charset language names.
2408 The first element whose locale regexp matches the start of a downcased locale
2409 specifies the language name whose charset corresponds to that locale.
2410 This language name is used if the locale is not listed in
2411 `locale-language-names'.")
2413 (defconst locale-preferred-coding-systems
2415 '((".*8859[-_]?1\\>" . iso-8859-1)
2416 (".*8859[-_]?2\\>" . iso-8859-2)
2417 (".*8859[-_]?3\\>" . iso-8859-3)
2418 (".*8859[-_]?4\\>" . iso-8859-4)
2419 (".*8859[-_]?9\\>" . iso-8859-9)
2420 (".*8859[-_]?14\\>" . iso-8859-14)
2421 (".*8859[-_]?15\\>" . iso-8859-15)
2422 (".*utf\\(?:-?8\\)?" . utf-8)
2423 ;; utf-8@euro exists, so put this after utf-8. (@euro really
2424 ;; specifies the currency, rather than the charset.)
2425 (".*@euro" . iso-8859-15)
2426 ("koi8-?r" . koi8-r)
2427 ("koi8-?u" . koi8-u)
2429 ("big5[-_]?hkscs" . big5-hkscs)
2431 ("euc-?tw" . euc-tw)
2432 ("euc-?cn" . euc-cn)
2435 ("gb18030" . gb18030)
2436 ("ja.*[._]euc" . japanese-iso-8bit)
2437 ("ja.*[._]jis7" . iso-2022-jp)
2438 ("ja.*[._]pck" . japanese-shift-jis)
2439 ("ja.*[._]sjis" . japanese-shift-jis)
2440 ("jpn" . japanese-shift-jis) ; MS-Windows uses this.
2442 "List of pairs of locale regexps and preferred coding systems.
2443 The first element whose locale regexp matches the start of a downcased locale
2444 specifies the coding system to prefer when using that locale.
2445 This coding system is used if the locale specifies a specific charset.")
2447 (defun locale-name-match (key alist)
2448 "Search for KEY in ALIST, which should be a list of regexp-value pairs.
2449 Return the value corresponding to the first regexp that matches the
2450 start of KEY, or nil if there is no match."
2452 (while (and alist (not element))
2453 (if (string-match-p (concat "\\`\\(?:" (car (car alist)) "\\)") key)
2454 (setq element (car alist)))
2455 (setq alist (cdr alist)))
2458 (defun locale-charset-match-p (charset1 charset2)
2459 "Whether charset names (strings) CHARSET1 and CHARSET2 are equivalent.
2460 Matching is done ignoring case and any hyphens and underscores in the
2461 names. E.g. `ISO_8859-1' and `iso88591' both match `iso-8859-1'."
2462 (setq charset1 (replace-regexp-in-string "[-_]" "" charset1))
2463 (setq charset2 (replace-regexp-in-string "[-_]" "" charset2))
2464 (eq t (compare-strings charset1 nil nil charset2 nil nil t)))
2466 (defvar locale-charset-alist nil
2467 "Coding system alist keyed on locale-style charset name.
2468 Used by `locale-charset-to-coding-system'.")
2470 (defun locale-charset-to-coding-system (charset)
2471 "Find coding system corresponding to CHARSET.
2472 CHARSET is any sort of non-Emacs charset name, such as might be used
2473 in a locale codeset, or elsewhere. It is matched to a coding system
2474 first by case-insensitive lookup in `locale-charset-alist'. Then
2475 matches are looked for in the coding system list, treating case and
2476 the characters `-' and `_' as insignificant. The coding system base
2477 is returned. Thus, for instance, if charset \"ISO8859-2\",
2478 `iso-latin-2' is returned."
2479 (or (car (assoc-string charset locale-charset-alist t))
2480 (let ((cs coding-system-alist)
2482 (while (and (not c) cs)
2483 (if (locale-charset-match-p charset (caar cs))
2484 (setq c (intern (caar cs)))
2486 (if c (coding-system-base c)))))
2488 ;; Fixme: This ought to deal with the territory part of the locale
2489 ;; too, for setting things such as calendar holidays, ps-print paper
2490 ;; size, spelling dictionary.
2492 (defun locale-translate (locale)
2493 "Expand LOCALE according to `locale-translation-file-name', if possible.
2494 For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."
2495 (if locale-translation-file-name
2497 (set-buffer-multibyte nil)
2498 (insert-file-contents locale-translation-file-name)
2499 (if (re-search-forward
2500 (concat "^" (regexp-quote locale) ":?[ \t]+") nil t)
2501 (buffer-substring (point) (line-end-position))
2505 (defun set-locale-environment (&optional locale-name frame)
2506 "Set up multi-lingual environment for using LOCALE-NAME.
2507 This sets the language environment, the coding system priority,
2508 the default input method and sometimes other things.
2510 LOCALE-NAME should be a string which is the name of a locale supported
2511 by the system. Often it is of the form xx_XX.CODE, where xx is a
2512 language, XX is a country, and CODE specifies a character set and
2513 coding system. For example, the locale name \"ja_JP.EUC\" might name
2514 a locale for Japanese in Japan using the `japanese-iso-8bit'
2515 coding-system. The name may also have a modifier suffix, e.g. `@euro'
2518 If LOCALE-NAME is nil, its value is taken from the environment
2519 variables LC_ALL, LC_CTYPE and LANG (the first one that is set).
2521 The locale names supported by your system can typically be found in a
2522 directory named `/usr/share/locale' or `/usr/lib/locale'. LOCALE-NAME
2523 will be translated according to the table specified by
2524 `locale-translation-file-name'.
2526 If FRAME is non-nil, only set the keyboard coding system and the
2527 terminal coding system for the terminal of that frame, and don't
2528 touch session-global parameters like the language environment.
2530 See also `locale-charset-language-names', `locale-language-names',
2531 `locale-preferred-coding-systems' and `locale-coding-system'."
2532 (interactive "sSet environment for locale: ")
2534 ;; Do this at runtime for the sake of binaries possibly transported
2535 ;; to a system without X.
2536 (setq locale-translation-file-name
2538 '("/usr/share/X11/locale/locale.alias" ; e.g. X11R7
2539 "/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
2540 "/usr/X11R6/lib/X11/locale/locale.alias" ; XFree86, e.g. RedHat 4.2
2541 "/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6
2543 ;; The following name appears after the X-related names above,
2544 ;; since the X-related names are what X actually uses.
2545 "/usr/share/locale/locale.alias" ; GNU/Linux sans X
2547 (while (and files (not (file-exists-p (car files))))
2548 (setq files (cdr files)))
2551 (let ((locale locale-name))
2554 ;; Use the first of these three environment variables
2555 ;; that has a nonempty value.
2556 (let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
2558 (= 0 (length locale))) ; nil or empty string
2559 (setq locale (getenv (pop vars) frame)))))
2562 (setq locale (locale-translate locale))
2564 ;; Leave the system locales alone if the caller did not specify
2565 ;; an explicit locale name, as their defaults are set from
2566 ;; LC_MESSAGES and LC_TIME, not LC_CTYPE, and the user might not
2567 ;; want to set them to the same value as LC_CTYPE.
2569 (setq system-messages-locale locale)
2570 (setq system-time-locale locale))
2572 (if (string-match "^[a-z][a-z]" locale)
2573 (setq current-iso639-language (intern (match-string 0 locale)))))
2576 (or system-messages-locale
2577 (let ((msglocale (getenv "LC_MESSAGES" frame)))
2578 (if (zerop (length msglocale))
2580 (locale-translate msglocale)))))
2583 (setq locale (downcase locale))
2585 (let ((language-name
2586 (locale-name-match locale locale-language-names))
2587 (charset-language-name
2588 (locale-name-match locale locale-charset-language-names))
2589 (default-eol-type (coding-system-eol-type
2590 default-buffer-file-coding-system))
2592 (or (locale-name-match locale locale-preferred-coding-systems)
2594 (if (string-match "\\.\\([^@]+\\)" locale)
2595 (locale-charset-to-coding-system
2596 (match-string 1 locale)))))))
2598 (if (consp language-name)
2599 ;; locale-language-names specify both lang-env and coding.
2600 ;; But, what specified in locale-preferred-coding-systems
2601 ;; has higher priority.
2602 (setq coding-system (or coding-system
2603 (nth 1 language-name))
2604 language-name (car language-name))
2605 ;; Otherwise, if locale is not listed in locale-language-names,
2606 ;; use what listed in locale-charset-language-names.
2607 (if (not language-name)
2608 (setq language-name charset-language-name)))
2610 ;; If a specific EOL conversion was specified in the default
2611 ;; buffer-file-coding-system, preserve it in the coding system
2612 ;; we will be using from now on.
2613 (if (and (memq default-eol-type '(0 1 2 unix dos mac))
2615 (coding-system-p coding-system))
2616 (setq coding-system (coding-system-change-eol-conversion
2617 coding-system default-eol-type)))
2621 ;; Set up for this character set. This is now the right way
2622 ;; to do it for both unibyte and multibyte modes.
2624 (set-language-environment language-name))
2626 ;; If default-enable-multibyte-characters is nil,
2627 ;; we are using single-byte characters,
2628 ;; so the display table and terminal coding system are irrelevant.
2629 (when default-enable-multibyte-characters
2630 (set-display-table-and-terminal-coding-system
2631 language-name coding-system frame))
2633 ;; Set the `keyboard-coding-system' if appropriate (tty
2634 ;; only). At least X and MS Windows can generate
2635 ;; multilingual input.
2636 ;; XXX This was disabled unless `window-system', but that
2637 ;; leads to buggy behavior when a tty frame is opened
2638 ;; later. Setting the keyboard coding system has no adverse
2639 ;; effect on X, so let's do it anyway. -- Lorentey
2640 (let ((kcs (or coding-system
2641 (car (get-language-info language-name
2643 (if kcs (set-keyboard-coding-system kcs frame)))
2646 (setq locale-coding-system
2647 (car (get-language-info language-name 'coding-priority)))))
2649 (when (and (not frame)
2651 (not (coding-system-equal coding-system
2652 locale-coding-system)))
2653 (prefer-coding-system coding-system)
2654 ;; Fixme: perhaps prefer-coding-system should set this too.
2655 ;; But it's not the time to do such a fundamental change.
2656 (setq default-sendmail-coding-system coding-system)
2657 (setq locale-coding-system coding-system))))
2659 ;; On Windows, override locale-coding-system,
2660 ;; default-file-name-coding-system, keyboard-coding-system,
2661 ;; terminal-coding-system with system codepage.
2662 (when (boundp 'w32-ansi-code-page)
2663 (let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
2664 (when (coding-system-p code-page-coding)
2665 (unless frame (setq locale-coding-system code-page-coding))
2666 (set-keyboard-coding-system code-page-coding frame)
2667 (set-terminal-coding-system code-page-coding frame)
2668 ;; Set default-file-name-coding-system last, so that Emacs
2669 ;; doesn't try to use cpNNNN when it defines keyboard and
2670 ;; terminal encoding. That's because the above two lines
2671 ;; will want to load code-pages.el, where cpNNNN are
2672 ;; defined; if default-file-name-coding-system were set to
2673 ;; cpNNNN while these two lines run, Emacs will want to use
2674 ;; it for encoding the file name it wants to load. And that
2675 ;; will fail, since cpNNNN is not yet usable until
2676 ;; code-pages.el finishes loading.
2677 (setq default-file-name-coding-system code-page-coding))))
2679 (when (eq system-type 'darwin)
2680 ;; On Darwin, file names are always encoded in utf-8, no matter
2682 (setq default-file-name-coding-system 'utf-8)
2683 ;; Mac OS X's Terminal.app by default uses utf-8 regardless of
2685 (when (and (null window-system)
2686 (equal (getenv "TERM_PROGRAM" frame) "Apple_Terminal"))
2687 (set-terminal-coding-system 'utf-8)
2688 (set-keyboard-coding-system 'utf-8)))
2690 ;; Default to A4 paper if we're not in a C, POSIX or US locale.
2691 ;; (See comments in Flocale_info.)
2693 (let ((locale locale)
2694 (paper (locale-info 'paper)))
2696 ;; This will always be null at the time of writing.
2698 ((equal paper '(216 279))
2699 (setq ps-paper-type 'letter))
2700 ((equal paper '(210 297))
2701 (setq ps-paper-type 'a4)))
2702 (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
2703 (while (and vars (= 0 (length locale)))
2704 (setq locale (getenv (pop vars) frame))))
2706 ;; As of glibc 2.2.5, these are the only US Letter locales,
2707 ;; and the rest are A4.
2709 (or (locale-name-match locale '(("c$" . letter)
2714 ("enu$" . letter) ; Windows
2721 ;;; Character property
2723 ;; Each element has the form (PROP . TABLE).
2724 ;; PROP is a symbol representing a character property.
2725 ;; TABLE is a char-table containing the property value for each character.
2726 ;; TABLE may be a name of file to load to build a char-table.
2727 ;; Don't modify this variable directly but use `define-char-code-property'.
2729 (defvar char-code-property-alist nil
2730 "Alist of character property name vs char-table containing property values.
2731 Internal use only.")
2733 (put 'char-code-property-table 'char-table-extra-slots 5)
2735 (defun define-char-code-property (name table &optional docstring)
2736 "Define NAME as a character code property given by TABLE.
2737 TABLE is a char-table of purpose `char-code-property-table' with
2740 2nd: Function to call to get a property value of a character.
2741 It is called with three arguments CHAR, VAL, and TABLE, where
2742 CHAR is a character, VAL is the value of (aref TABLE CHAR).
2743 3rd: Function to call to put a property value of a character.
2744 It is called with the same arguments as above.
2745 4th: Function to call to get a description string of a property value.
2746 It is called with one argument VALUE, a property value.
2747 5th: Data used by the above functions.
2749 TABLE may be a name of file to load to build a char-table. The
2750 file should contain a call of `define-char-code-property' with a
2751 char-table of the above format as the argument TABLE.
2753 TABLE may also be nil, in which case no property value is pre-assigned.
2755 Optional 3rd argument DOCSTRING is a documentation string of the property.
2757 See also the documentation of `get-char-code-property' and
2758 `put-char-code-property'."
2760 (error "Not a symbol: %s" name))
2761 (if (char-table-p table)
2762 (or (and (eq (char-table-subtype table) 'char-code-property-table)
2763 (eq (char-table-extra-slot table 0) name))
2764 (error "Invalid char-table: %s" table))
2766 (error "Not a char-table nor a file name: %s" table)))
2767 (let ((slot (assq name char-code-property-alist)))
2770 (setq char-code-property-alist
2771 (cons (cons name table) char-code-property-alist))))
2772 (put name 'char-code-property-documentation docstring))
2774 (defvar char-code-property-table
2775 (make-char-table 'char-code-property-table)
2776 "Char-table containing a property list of each character code.
2777 This table is used for properties not listed in `char-code-property-alist'.
2778 See also the documentation of `get-char-code-property' and
2779 `put-char-code-property'.")
2781 (defun get-char-code-property (char propname)
2782 "Return the value of CHAR's PROPNAME property."
2783 (let ((slot (assq propname char-code-property-alist)))
2785 (let (table value func)
2786 (if (stringp (cdr slot))
2787 (load (cdr slot) nil t))
2788 (setq table (cdr slot)
2789 value (aref table char)
2790 func (char-table-extra-slot table 1))
2791 (if (functionp func)
2792 (setq value (funcall func char value table)))
2794 (plist-get (aref char-code-property-table char) propname))))
2796 (defun put-char-code-property (char propname value)
2797 "Store CHAR's PROPNAME property with VALUE.
2798 It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
2799 (let ((slot (assq propname char-code-property-alist)))
2802 (if (stringp (cdr slot))
2803 (load (cdr slot) nil t))
2804 (setq table (cdr slot)
2805 func (char-table-extra-slot table 2))
2806 (if (functionp func)
2807 (funcall func char value table)
2808 (aset table char value)))
2809 (let* ((plist (aref char-code-property-table char))
2810 (x (plist-put plist propname value)))
2812 (aset char-code-property-table char x))))
2815 (defun char-code-property-description (prop value)
2816 "Return a description string of character property PROP's value VALUE.
2817 If there's no description string for VALUE, return nil."
2818 (let ((slot (assq prop char-code-property-alist)))
2821 (if (stringp (cdr slot))
2822 (load (cdr slot) nil t))
2823 (setq table (cdr slot)
2824 func (char-table-extra-slot table 3))
2825 (if (functionp func)
2826 (funcall func value))))))
2829 ;; Pretty description of encoded string
2831 ;; Alist of ISO 2022 control code vs the corresponding mnemonic string.
2832 (defvar iso-2022-control-alist
2840 (defun encoded-string-description (str coding-system)
2841 "Return a pretty description of STR that is encoded by CODING-SYSTEM."
2842 (setq str (string-as-unibyte str))
2844 (if (and coding-system (eq (coding-system-type coding-system) 'iso-2022))
2845 ;; Try to get a pretty description for ISO 2022 escape sequences.
2846 (function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
2847 (format "#x%02X" x))))
2848 (function (lambda (x) (format "#x%02X" x))))
2851 (defun encode-coding-char (char coding-system &optional charset)
2852 "Encode CHAR by CODING-SYSTEM and return the resulting string.
2853 If CODING-SYSTEM can't safely encode CHAR, return nil.
2854 The 3rd optional argument CHARSET, if non-nil, is a charset preferred
2856 (let* ((str1 (string-as-multibyte (string char)))
2857 (str2 (string-as-multibyte (string char char)))
2858 (found (find-coding-systems-string str1))
2860 (if (and (consp found)
2861 (eq (car found) 'undecided))
2863 (when (memq (coding-system-base coding-system) found)
2864 ;; We must find the encoded string of CHAR. But, just encoding
2865 ;; CHAR will put extra control sequences (usually to designate
2866 ;; ASCII charset) at the tail if type of CODING is ISO 2022.
2867 ;; To exclude such tailing bytes, we at first encode one-char
2868 ;; string and two-char string, then check how many bytes at the
2869 ;; tail of both encoded strings are the same.
2872 (put-text-property 0 1 'charset charset str1)
2873 (put-text-property 0 2 'charset charset str2))
2874 (setq enc1 (encode-coding-string str1 coding-system)
2876 enc2 (encode-coding-string str2 coding-system)
2878 (while (and (> i1 0) (= (aref enc1 (1- i1)) (aref enc2 (1- i2))))
2879 (setq i1 (1- i1) i2 (1- i2)))
2881 ;; Now (substring enc1 i1) and (substring enc2 i2) are the same,
2882 ;; and they are the extra control sequences at the tail to
2884 (substring enc2 0 i2)))))
2886 ;; Backwards compatibility. These might be better with :init-value t,
2887 ;; but that breaks loadup.
2888 (define-minor-mode unify-8859-on-encoding-mode
2892 (define-minor-mode unify-8859-on-decoding-mode
2897 (defvar nonascii-insert-offset 0 "This variable is obsolete.")
2898 (defvar nonascii-translation-table nil "This variable is obsolete.")
2900 (defvar ucs-names nil
2901 "Alist of cached (CHAR-NAME . CHAR-CODE) pairs.")
2904 "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'."
2908 (dotimes-with-progress-reporter (c #xEFFFF)
2909 "Loading Unicode character names..."
2911 (and (>= c #x3400 ) (<= c #x4dbf )) ; CJK Ideograph Extension A
2912 (and (>= c #x4e00 ) (<= c #x9fff )) ; CJK Ideograph
2913 (and (>= c #xd800 ) (<= c #xfaff )) ; Private/Surrogate
2914 (and (>= c #x20000) (<= c #x2ffff)) ; CJK Ideograph Extension B
2916 (if (setq name (get-char-code-property c 'name))
2917 (setq names (cons (cons name c) names)))
2918 (if (setq name (get-char-code-property c 'old-name))
2919 (setq names (cons (cons name c) names)))))
2922 (defvar ucs-completions (lazy-completion-table ucs-completions ucs-names)
2923 "Lazy completion table for completing on Unicode character names.")
2924 (put 'ucs-completions 'risky-local-variable t)
2926 (defun read-char-by-name (prompt)
2927 "Read a character by its Unicode name or hex number string.
2928 Display PROMPT and read a string that represents a character by its
2929 Unicode property `name' or `old-name'. You can type a few of first
2930 letters of the Unicode name and use completion. This function also
2931 accepts a hexadecimal number of Unicode code point or a number in
2932 hash notation, e.g. #o21430 for octal, #x2318 for hex, or #10r8984
2933 for decimal. Returns a character as a number."
2934 (let* ((completion-ignore-case t)
2935 (input (completing-read prompt ucs-completions)))
2937 ((string-match-p "^[0-9a-fA-F]+$" input)
2938 (string-to-number input 16))
2939 ((string-match-p "^#" input)
2942 (cdr (assoc-string input (ucs-names) t))))))
2944 (defun ucs-insert (arg)
2945 "Insert a character of the given Unicode code point.
2946 Interactively, prompts for a Unicode character name or a hex number
2947 using `read-char-by-name'."
2948 (interactive (list (read-char-by-name "Unicode (name or hex): ")))
2950 (setq arg (string-to-number arg 16)))
2952 ((not (integerp arg))
2953 (error "Not a Unicode character code: %S" arg))
2954 ((or (< arg 0) (> arg #x10FFFF))
2955 (error "Not a Unicode character code: 0x%X" arg)))
2956 (insert-and-inherit arg))
2958 (define-key ctl-x-map "8\r" 'ucs-insert)
2960 ;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
2961 ;;; mule-cmds.el ends here