HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Use default-value rather than default-enable-multibyte-characters.
[bpt/emacs.git] / lisp / international / mule-cmds.el
CommitLineData
caff3c0a 1;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-
9ee5b744 2
26b3dce6 3;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
ae940284 4;; 2007, 2008, 2009 Free Software Foundation, Inc.
7976eda0 5;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
ae940284 6;; 2005, 2006, 2007, 2008, 2009
2fd125a3
KH		 7;; National Institute of Advanced Industrial Science and Technology (AIST)
8;; Registration Number H14PRO021
8f924df7 9;; Copyright (C) 2003
97941b05
KH		 10;; National Institute of Advanced Industrial Science and Technology (AIST)
11;; Registration Number H13PRO009
4ed46869 12
1f547b92 13;; Keywords: mule, i18n
4ed46869
KH		 14
15;; This file is part of GNU Emacs.
16
4936186e 17;; GNU Emacs is free software: you can redistribute it and/or modify
4ed46869 18;; it under the terms of the GNU General Public License as published by
4936186e
GM		 19;; the Free Software Foundation, either version 3 of the License, or
20;; (at your option) any later version.
4ed46869
KH		 21
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.
26
27;; You should have received a copy of the GNU General Public License
4936186e 28;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
4ed46869 29
60370d40
PJ		 30;;; Commentary:
31
4ed46869
KH		 32;;; Code:
33
26b3dce6
GM		 34(defvar dos-codepage)
35(autoload 'widget-value "wid-edit")
cda74479 36
4a91d930 37(defvar mac-system-coding-system)
4a91d930 38
4ed46869
KH		 39;;; MULE related key bindings and menus.
40
64657387
SM		 41(defvar mule-keymap
42 (let ((map (make-sparse-keymap)))
43 (define-key map "f" 'set-buffer-file-coding-system)
44 (define-key map "r" 'revert-buffer-with-coding-system)
45 (define-key map "F" 'set-file-name-coding-system)
46 (define-key map "t" 'set-terminal-coding-system)
47 (define-key map "k" 'set-keyboard-coding-system)
48 (define-key map "p" 'set-buffer-process-coding-system)
49 (define-key map "x" 'set-selection-coding-system)
50 (define-key map "X" 'set-next-selection-coding-system)
51 (define-key map "\C-\\" 'set-input-method)
52 (define-key map "c" 'universal-coding-system-argument)
53 (define-key map "l" 'set-language-environment)
54 map)
33d17698 55 "Keymap for Mule (Multilingual environment) specific commands.")
4ed46869 56
8f81f784 57;; Keep "C-x C-m ..." for mule specific commands.
0709d285 58(define-key ctl-x-map "\C-m" mule-keymap)
ef8a8c8c 59
dcad02bc 60(defvar describe-language-environment-map
64657387
SM		 61 (let ((map (make-sparse-keymap "Describe Language Environment")))
62 (define-key map
63 [Default] '(menu-item "Default" describe-specified-language-support))
64 map))
15b3e511 65
dcad02bc 66(defvar setup-language-environment-map
64657387
SM		 67 (let ((map (make-sparse-keymap "Set Language Environment")))
68 (define-key map
69 [Default] '(menu-item "Default" setup-specified-language-environment))
70 map))
15b3e511 71
dcad02bc 72(defvar set-coding-system-map
64657387
SM		 73 (let ((map (make-sparse-keymap "Set Coding System")))
74 (define-key-after map [universal-coding-system-argument]
75 '(menu-item "For Next Command" universal-coding-system-argument
76 :help "Coding system to be used by next command"))
77 (define-key-after map [separator-1] '("--"))
78 (define-key-after map [set-buffer-file-coding-system]
79 '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
80 :help "How to encode this buffer when saved"))
81 (define-key-after map [revert-buffer-with-coding-system]
82 '(menu-item "For Reverting This File Now"
83 revert-buffer-with-coding-system
84 :enable buffer-file-name
85 :help "Revisit this file immediately using specified coding system"))
86 (define-key-after map [set-file-name-coding-system]
87 '(menu-item "For File Name" set-file-name-coding-system
88 :help "How to decode/encode file names"))
89 (define-key-after map [separator-2] '("--"))
90
91 (define-key-after map [set-keyboard-coding-system]
92 '(menu-item "For Keyboard" set-keyboard-coding-system
93 :help "How to decode keyboard input"))
94 (define-key-after map [set-terminal-coding-system]
95 '(menu-item "For Terminal" set-terminal-coding-system
96 :enable (null (memq initial-window-system '(x w32 ns)))
97 :help "How to encode terminal output"))
98 (define-key-after map [separator-3] '("--"))
99
100 (define-key-after map [set-selection-coding-system]
101 '(menu-item "For X Selections/Clipboard" set-selection-coding-system
102 :visible (display-selections-p)
103 :help "How to en/decode data to/from selection/clipboard"))
104 (define-key-after map [set-next-selection-coding-system]
105 '(menu-item "For Next X Selection" set-next-selection-coding-system
106 :visible (display-selections-p)
107 :help "How to en/decode next selection/clipboard operation"))
108 (define-key-after map [set-buffer-process-coding-system]
109 '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
110 :visible (fboundp 'start-process)
111 :enable (get-buffer-process (current-buffer))
112 :help "How to en/decode I/O from/to subprocess connected to this buffer"))
113 map))
114
115(defvar mule-menu-keymap
116 (let ((map (make-sparse-keymap "Mule (Multilingual Environment)")))
117 (define-key-after map [set-language-environment]
118 `(menu-item "Set Language Environment" ,setup-language-environment-map))
119 (define-key-after map [separator-mule] '("--"))
120
121 (define-key-after map [toggle-input-method]
122 '(menu-item "Toggle Input Method" toggle-input-method))
123 (define-key-after map [set-input-method]
124 '(menu-item "Select Input Method..." set-input-method))
125 (define-key-after map [describe-input-method]
126 '(menu-item "Describe Input Method" describe-input-method))
127 (define-key-after map [separator-input-method] '("--"))
128
129 (define-key-after map [set-various-coding-system]
597e2240
GM		 130 `(menu-item "Set Coding Systems" ,set-coding-system-map
131 :enable (default-value 'enable-multibyte-characters)))
64657387
SM		 132 (define-key-after map [view-hello-file]
133 '(menu-item "Show Multi-lingual Text" view-hello-file
134 :enable (file-readable-p
135 (expand-file-name "HELLO" data-directory))
136 :help "Display file which says HELLO in many languages"))
137 (define-key-after map [separator-coding-system] '("--"))
138
139 (define-key-after map [describe-language-environment]
140 (list 'menu-item "Describe Language Environment"
141 describe-language-environment-map
142 :help "Show multilingual settings for a specific language"))
143 (define-key-after map [describe-input-method]
144 '(menu-item "Describe Input Method..." describe-input-method
145 :help "Keyboard layout for a specific input method"))
146 (define-key-after map [describe-coding-system]
147 '(menu-item "Describe Coding System..." describe-coding-system))
148 (define-key-after map [list-character-sets]
149 '(menu-item "List Character Sets" list-character-sets
150 :help "Show table of available character sets"))
151 (define-key-after map [mule-diag]
152 '(menu-item "Show All of Mule Status" mule-diag
153 :help "Display multilingual environment settings"))
154 map)
155 "Keymap for Mule (Multilingual environment) menu specific commands.")
cda74479 156
4ed46869
KH		 157;; This should be a single character key binding because users use it
158;; very frequently while editing multilingual text. Now we can use
159;; only two such keys: "\C-\\" and "\C-^", but the latter is not
160;; convenient because it requires shifting on most keyboards. An
161;; alternative is "\C-\]" which is now bound to `abort-recursive-edit'
162;; but it won't be used that frequently.
163(define-key global-map "\C-\\" 'toggle-input-method)
164
5f395df3
SM		 165;; This is no good because people often type Shift-SPC
166;; meaning to type SPC. -- rms.
167;; ;; Here's an alternative key binding for X users (Shift-SPACE).
168;; (define-key global-map [?\S- ] 'toggle-input-method)
b4fba33f 169
464cc130
KH		 170;;; Mule related hyperlinks.
171(defconst help-xref-mule-regexp-template
172 (purecopy (concat "\\(\\<\\("
173 "\\(coding system\\)\\|"
d0c40faa
KH		 174 "\\(input method\\)\\|"
175 "\\(character set\\)\\|"
176 "\\(charset\\)"
464cc130
KH		 177 "\\)\\s-+\\)?"
178 ;; Note starting with word-syntax character:
179 "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")))
180
26d87040 181(defun coding-system-change-eol-conversion (coding-system eol-type)
caff3c0a 182 "Return a coding system which differs from CODING-SYSTEM in EOL conversion.
26d87040
EZ		 183The returned coding system converts end-of-line by EOL-TYPE
184but text as the same way as CODING-SYSTEM.
185EOL-TYPE should be `unix', `dos', `mac', or nil.
186If EOL-TYPE is nil, the returned coding system detects
187how end-of-line is formatted automatically while decoding.
188
189EOL-TYPE can be specified by an integer 0, 1, or 2.
190They means `unix', `dos', and `mac' respectively."
191 (if (symbolp eol-type)
192 (setq eol-type (cond ((eq eol-type 'unix) 0)
193 ((eq eol-type 'dos) 1)
194 ((eq eol-type 'mac) 2)
195 (t eol-type))))
1d5b0c66
CY		 196 ;; We call `coding-system-base' before `coding-system-eol-type',
197 ;; because the coding-system may not be initialized until then.
198 (let* ((base (coding-system-base coding-system))
199 (orig-eol-type (coding-system-eol-type coding-system)))
200 (cond ((vectorp orig-eol-type)
201 (if (not eol-type)
202 coding-system
203 (aref orig-eol-type eol-type)))
204 ((not eol-type)
205 base)
206 ((= eol-type orig-eol-type)
207 coding-system)
208 ((progn (setq orig-eol-type (coding-system-eol-type base))
209 (vectorp orig-eol-type))
210 (aref orig-eol-type eol-type)))))
26d87040
EZ		 211
212(defun coding-system-change-text-conversion (coding-system coding)
213 "Return a coding system which differs from CODING-SYSTEM in text conversion.
214The returned coding system converts text by CODING
215but end-of-line as the same way as CODING-SYSTEM.
216If CODING is nil, the returned coding system detects
217how text is formatted automatically while decoding."
1d77e15a
JR		 218 (let ((eol-type (coding-system-eol-type coding-system)))
219 (coding-system-change-eol-conversion
220 (if coding coding 'undecided)
221 (if (numberp eol-type) (aref [unix dos mac] eol-type)))))
26d87040 222
be7ca044
KH		 223;; Canonicalize the coding system name NAME by removing some prefixes
224;; and delimiter characters. Support function of
225;; coding-system-from-name.
226(defun canonicalize-coding-system-name (name)
227 (if (string-match "^iso[-_ ]?[0-9]" name)
228 ;; "iso-8859-1" -> "8859-1", "iso-2022-jp" ->"2022-jp"
229 (setq name (substring name (1- (match-end 0)))))
230 (let ((idx (string-match "[-_ /]" name)))
231 ;; Delete "-", "_", " ", "/" but do distinguish "16-be" and "16be".
232 (while idx
233 (if (and (>= idx 2)
234 (eq (string-match "16-[lb]e$" name (- idx 2))
235 (- idx 2)))
236 (setq idx (string-match "[-_ /]" name (match-end 0)))
237 (setq name (concat (substring name 0 idx) (substring name (1+ idx)))
238 idx (string-match "[-_ /]" name idx))))
239 name))
240
241(defun coding-system-from-name (name)
242 "Return a coding system whose name matches with NAME (string or symbol)."
243 (let (sym)
244 (if (stringp name) (setq sym (intern name))
245 (setq sym name name (symbol-name name)))
246 (if (coding-system-p sym)
247 sym
248 (let ((eol-type
249 (if (string-match "-\\(unix\\|dos\\|mac\\)$" name)
250 (prog1 (intern (match-string 1 name))
251 (setq name (substring name 0 (match-beginning 0)))))))
252 (setq name (canonicalize-coding-system-name (downcase name)))
253 (catch 'tag
254 (dolist (elt (coding-system-list))
255 (if (string= (canonicalize-coding-system-name (symbol-name elt))
256 name)
257 (throw 'tag (if eol-type (coding-system-change-eol-conversion
258 elt eol-type)
259 elt)))))))))
260
4ed46869 261(defun toggle-enable-multibyte-characters (&optional arg)
6998e1a1 262 "Change whether this buffer uses multibyte characters.
49275d55 263With ARG, use multibyte characters if the ARG is positive.
6998e1a1
RS		 264
265Note that this command does not convert the byte contents of
266the buffer; it only changes the way those bytes are interpreted.
267In general, therefore, this command *changes* the sequence of
268characters that the current buffer contains.
269
caff3c0a
JB		 270We suggest you avoid using this command unless you know what you are
271doing. If you use it by mistake, and the buffer is now displayed
6998e1a1 272wrong, use this command again to toggle back to the right mode."
4ed46869 273 (interactive "P")
b7079457
RS		 274 (let ((new-flag
275 (if (null arg) (null enable-multibyte-characters)
276 (> (prefix-numeric-value arg) 0))))
277 (set-buffer-multibyte new-flag))
4ed46869
KH		 278 (force-mode-line-update))
279
280(defun view-hello-file ()
cf2fc7e9 281 "Display the HELLO file, which lists many languages and characters."
4ed46869 282 (interactive)
8f81f784
KH		 283 ;; We have to decode the file in any environment.
284 (let ((default-enable-multibyte-characters t)
95fa03b4 285 (coding-system-for-read 'iso-2022-7bit))
544dd975 286 (view-file (expand-file-name "HELLO" data-directory))))
4ed46869 287
9e9a77a6 288(defun universal-coding-system-argument (coding-system)
15b3e511 289 "Execute an I/O command using the specified coding system."
9e9a77a6
RS		 290 (interactive
291 (let ((default (and buffer-file-coding-system
34104362 292 (not (eq (coding-system-type buffer-file-coding-system)
a0d96cad 293 'undecided))
9e9a77a6
RS		 294 buffer-file-coding-system)))
295 (list (read-coding-system
296 (if default
5b76833f 297 (format "Coding system for following command (default %s): " default)
9e9a77a6
RS		 298 "Coding system for following command: ")
299 default))))
300 (let* ((keyseq (read-key-sequence
e14a8f4c 301 (format "Command to execute with %s:" coding-system)))
04363179
GM		 302 (cmd (key-binding keyseq))
303 prefix)
735c5b17
GM		 304 ;; read-key-sequence ignores quit, so make an explicit check.
305 ;; Like many places, this assumes quit == C-g, but it need not be.
1e4bd40d 306 (if (equal last-input-event ?\C-g)
735c5b17 307 (keyboard-quit))
4a304bb2 308 (when (memq cmd '(universal-argument digit-argument))
04363179 309 (call-interactively cmd)
a1506d29 310
04363179
GM		 311 ;; Process keys bound in `universal-argument-map'.
312 (while (progn
313 (setq keyseq (read-key-sequence nil t)
314 cmd (key-binding keyseq t))
315 (not (eq cmd 'universal-argument-other-key)))
316 (let ((current-prefix-arg prefix-arg)
61a846fb 317 ;; Have to bind `last-command-event' here so that
6b61353c 318 ;; `digit-argument', for instance, can compute the
04363179 319 ;; prefix arg.
61a846fb 320 (last-command-event (aref keyseq 0)))
04363179
GM		 321 (call-interactively cmd)))
322
1f547b92 323 ;; This is the final call to `universal-argument-other-key', which
04363179
GM		 324 ;; set's the final `prefix-arg.
325 (let ((current-prefix-arg prefix-arg))
326 (call-interactively cmd))
a1506d29 327
04363179
GM		 328 ;; Read the command to execute with the given prefix arg.
329 (setq prefix prefix-arg
330 keyseq (read-key-sequence nil t)
331 cmd (key-binding keyseq)))
332
15b3e511 333 (let ((coding-system-for-read coding-system)
04363179 334 (coding-system-for-write coding-system)
0e9ec609 335 (coding-system-require-warning t)
04363179 336 (current-prefix-arg prefix))
15b3e511
KH		 337 (message "")
338 (call-interactively cmd))))
339
de94d711 340(defun set-default-coding-systems (coding-system)
0c3154d2 341 "Set default value of various coding systems to CODING-SYSTEM.
387136f6 342This sets the following coding systems:
0c3154d2 343 o coding system of a newly created buffer
8efc03e1
KH		 344 o default coding system for subprocess I/O
345This also sets the following values:
d3e4babd 346 o default value used as `file-name-coding-system' for converting file names
caff3c0a 347 if CODING-SYSTEM is ASCII-compatible
d8cb7e3d 348 o default value for the command `set-terminal-coding-system'
d3e4babd 349 o default value for the command `set-keyboard-coding-system'
caff3c0a 350 if CODING-SYSTEM is ASCII-compatible"
de94d711
KH		 351 (check-coding-system coding-system)
352 (setq-default buffer-file-coding-system coding-system)
6b61353c
KH		 353 (if (fboundp 'ucs-set-table-for-input)
354 (dolist (buffer (buffer-list))
355 (or (local-variable-p 'buffer-file-coding-system buffer)
356 (ucs-set-table-for-input buffer))))
357
db9aec47 358 (if (eq system-type 'darwin)
a41118cc 359 ;; The file-name coding system on Darwin systems is always utf-8.
db9aec47 360 (setq default-file-name-coding-system 'utf-8)
597e2240 361 (if (and (default-value 'enable-multibyte-characters)
db9aec47
KH		 362 (or (not coding-system)
363 (coding-system-get coding-system 'ascii-compatible-p)))
364 (setq default-file-name-coding-system coding-system)))
970c9391 365 (setq default-terminal-coding-system coding-system)
de94d711 366 (setq default-keyboard-coding-system coding-system)
1d77e15a
JR		 367 ;; Preserve eol-type from existing default-process-coding-systems.
368 ;; On non-unix-like systems in particular, these may have been set
369 ;; carefully by the user, or by the startup code, to deal with the
370 ;; users shell appropriately, so should not be altered by changing
371 ;; language environment.
372 (let ((output-coding
373 (coding-system-change-text-conversion
374 (car default-process-coding-system) coding-system))
375 (input-coding
376 (coding-system-change-text-conversion
377 (cdr default-process-coding-system) coding-system)))
378 (setq default-process-coding-system
379 (cons output-coding input-coding))))
de94d711 380
0c3154d2
KH		 381(defun prefer-coding-system (coding-system)
382 "Add CODING-SYSTEM at the front of the priority list for automatic detection.
387136f6 383This also sets the following coding systems:
0c3154d2 384 o coding system of a newly created buffer
8efc03e1
KH		 385 o default coding system for subprocess I/O
386This also sets the following values:
caff3c0a 387 o default value used as `file-name-coding-system' for converting file names
d8cb7e3d 388 o default value for the command `set-terminal-coding-system'
03c35c83
EZ		 389 o default value for the command `set-keyboard-coding-system'
390
bd3ac67e
EZ		 391If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
392systems set by this function will use that type of EOL conversion.
393
d0d8885d
JB		 394A coding system that requires automatic detection of text+encoding
395\(e.g. undecided, unix) can't be preferred."
0c3154d2
KH		 396 (interactive "zPrefer coding system: ")
397 (if (not (and coding-system (coding-system-p coding-system)))
398 (error "Invalid coding system `%s'" coding-system))
97941b05
KH		 399 (if (memq (coding-system-type coding-system) '(raw-text undecided))
400 (error "Can't prefer the coding system `%s'" coding-system))
401 (let ((base (coding-system-base coding-system))
bd3ac67e 402 (eol-type (coding-system-eol-type coding-system)))
97941b05
KH		 403 (set-coding-system-priority base)
404 (and (interactive-p)
405 (or (eq base coding-system)
406 (message "Highest priority is set to %s (base of %s)"
407 base coding-system)))
bd3ac67e 408 ;; If they asked for specific EOL conversion, honor that.
6f9dc4fd 409 (if (memq eol-type '(0 1 2))
97941b05
KH		 410 (setq base
411 (coding-system-change-eol-conversion base eol-type)))
412 (set-default-coding-systems base)))
0c3154d2 413
b5edd1d1
KH		 414(defvar sort-coding-systems-predicate nil
415 "If non-nil, a predicate function to sort coding systems.
416
417It is called with two coding systems, and should return t if the first
418one is \"less\" than the second.
419
420The function `sort-coding-systems' use it.")
421
422(defun sort-coding-systems (codings)
423 "Sort coding system list CODINGS by a priority of each coding system.
caff3c0a 424Return the sorted list. CODINGS is modified by side effects.
b5edd1d1
KH		 425
426If a coding system is most preferred, it has the highest priority.
caff3c0a
JB		 427Otherwise, coding systems that correspond to MIME charsets have
428higher priorities. Among them, a coding system included in the
429`coding-system' key of the current language environment has higher
430priority. See also the documentation of `language-info-alist'.
b5edd1d1
KH		 431
432If the variable `sort-coding-systems-predicate' (which see) is
caff3c0a 433non-nil, it is used to sort CODINGS instead."
b5edd1d1
KH		 434 (if sort-coding-systems-predicate
435 (sort codings sort-coding-systems-predicate)
8f924df7
KH		 436 (let* ((from-priority (coding-system-priority-list))
437 (most-preferred (car from-priority))
b5edd1d1
KH		 438 (lang-preferred (get-language-info current-language-environment
439 'coding-system))
440 (func (function
441 (lambda (x)
442 (let ((base (coding-system-base x)))
da1ebad1
KH		 443 ;; We calculate the priority number 0..255 by
444 ;; using the 8 bits PMMLCEII as this:
3ecd3a56
GM		 445 ;; P: 1 if most preferred.
446 ;; MM: greater than 0 if mime-charset.
447 ;; L: 1 if one of the current lang. env.'s codings.
448 ;; C: 1 if one of codings listed in the category list.
449 ;; E: 1 if not XXX-with-esc
da1ebad1
KH		 450 ;; II: if iso-2022 based, 0..3, else 1.
451 (logior
452 (lsh (if (eq base most-preferred) 1 0) 7)
453 (lsh
8f924df7 454 (let ((mime (coding-system-get base :mime-charset)))
b439e72a
DL		 455 ;; Prefer coding systems corresponding to a
456 ;; MIME charset.
b5edd1d1 457 (if mime
b439e72a
DL		 458 ;; Lower utf-16 priority so that we
459 ;; normally prefer utf-8 to it, and put
460 ;; x-ctext below that.
d0d8885d
JB		 461 (cond ((string-match-p "utf-16"
462 (symbol-name mime))
da1ebad1 463 2)
d0d8885d 464 ((string-match-p "^x-" (symbol-name mime))
da1ebad1
KH		 465 1)
466 (t 3))
b5edd1d1 467 0))
da1ebad1
KH		 468 5)
469 (lsh (if (memq base lang-preferred) 1 0) 4)
8f924df7 470 (lsh (if (memq base from-priority) 1 0) 3)
d0d8885d
JB		 471 (lsh (if (string-match-p "-with-esc\\'"
472 (symbol-name base))
da1ebad1 473 0 1) 2)
8f924df7
KH		 474 (if (eq (coding-system-type base) 'iso-2022)
475 (let ((category (coding-system-category base)))
476 ;; For ISO based coding systems, prefer
477 ;; one that doesn't use designation nor
478 ;; locking/single shifting.
a0d96cad
KH		 479 (cond
480 ((or (eq category 'coding-category-iso-8-1)
481 (eq category 'coding-category-iso-8-2))
482 2)
483 ((or (eq category 'coding-category-iso-7-tight)
484 (eq category 'coding-category-iso-7))
485 1)
486 (t
487 0)))
488 1)
a6dfc99b 489 ))))))
b5edd1d1
KH		 490 (sort codings (function (lambda (x y)
491 (> (funcall func x) (funcall func y))))))))
54b226f7 492
3fc7dfe5 493(defun find-coding-systems-region (from to)
54b226f7 494 "Return a list of proper coding systems to encode a text between FROM and TO.
8f924df7 495
d37ef0f6 496If FROM is a string, find coding systems in that instead of the buffer.
54b226f7
KH		 497All coding systems in the list can safely encode any multibyte characters
498in the text.
499
e8dd0160 500If the text contains no multibyte characters, return a list of a single
3fc7dfe5 501element `undecided'."
b5edd1d1
KH		 502 (let ((codings (find-coding-systems-region-internal from to)))
503 (if (eq codings t)
504 ;; The text contains only ASCII characters. Any coding
505 ;; systems are safe.
506 '(undecided)
507 ;; We need copy-sequence because sorting will alter the argument.
508 (sort-coding-systems (copy-sequence codings)))))
54b226f7 509
3fc7dfe5
KH		 510(defun find-coding-systems-string (string)
511 "Return a list of proper coding systems to encode STRING.
512All coding systems in the list can safely encode any multibyte characters
513in STRING.
514
e8dd0160 515If STRING contains no multibyte characters, return a list of a single
3fc7dfe5 516element `undecided'."
b5edd1d1 517 (find-coding-systems-region string nil))
3fc7dfe5
KH		 518
519(defun find-coding-systems-for-charsets (charsets)
520 "Return a list of proper coding systems to encode characters of CHARSETS.
6053d86a 521CHARSETS is a list of character sets.
1f547b92
DL		 522
523This only finds coding systems of type `charset', whose
524`:charset-list' property includes all of CHARSETS (plus `ascii' for
d0d8885d 525ASCII-compatible coding systems). It was used in older versions of
1f547b92
DL		 526Emacs, but is unlikely to be what you really want now."
527 ;; Deal with aliases.
528 (setq charsets (mapcar (lambda (c)
529 (get-charset-property c :name))
530 charsets))
b5edd1d1
KH		 531 (cond ((or (null charsets)
532 (and (= (length charsets) 1)
533 (eq 'ascii (car charsets))))
534 '(undecided))
535 ((or (memq 'eight-bit-control charsets)
536 (memq 'eight-bit-graphic charsets))
1f547b92 537 '(raw-text utf-8-emacs))
b5edd1d1 538 (t
1f547b92
DL		 539 (let (codings)
540 (dolist (cs (coding-system-list t))
c7b4b466
DL		 541 (let ((cs-charsets (and (eq (coding-system-type cs) 'charset)
542 (coding-system-charset-list cs)))
1f547b92
DL		 543 (charsets charsets))
544 (if (coding-system-get cs :ascii-compatible-p)
545 (add-to-list 'cs-charsets 'ascii))
546 (if (catch 'ok
547 (when cs-charsets
548 (while charsets
549 (unless (memq (pop charsets) cs-charsets)
550 (throw 'ok nil)))
551 t))
552 (push cs codings))))
553 (nreverse codings)))))
54b226f7 554
51ed58ea
KH		 555(defun find-multibyte-characters (from to &optional maxcount excludes)
556 "Find multibyte characters in the region specified by FROM and TO.
557If FROM is a string, find multibyte characters in the string.
558The return value is an alist of the following format:
559 ((CHARSET COUNT CHAR ...) ...)
560where
561 CHARSET is a character set,
562 COUNT is a number of characters,
1f547b92 563 CHARs are the characters found from the character set.
51ed58ea 564Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
caff3c0a 565Optional 4th arg EXCLUDES is a list of character sets to be ignored."
51ed58ea
KH		 566 (let ((chars nil)
567 charset char)
568 (if (stringp from)
a0d96cad
KH		 569 (if (multibyte-string-p from)
570 (let ((idx 0))
d0d8885d 571 (while (setq idx (string-match-p "[^\000-\177]" from idx))
a0d96cad
KH		 572 (setq char (aref from idx)
573 charset (char-charset char))
574 (unless (memq charset excludes)
575 (let ((slot (assq charset chars)))
576 (if slot
577 (if (not (memq char (nthcdr 2 slot)))
578 (let ((count (nth 1 slot)))
579 (setcar (cdr slot) (1+ count))
580 (if (or (not maxcount) (< count maxcount))
581 (nconc slot (list char)))))
582 (setq chars (cons (list charset 1 char) chars)))))
583 (setq idx (1+ idx)))))
584 (if enable-multibyte-characters
585 (save-excursion
586 (goto-char from)
587 (while (re-search-forward "[^\000-\177]" to t)
588 (setq char (preceding-char)
589 charset (char-charset char))
590 (unless (memq charset excludes)
51ed58ea
KH		 591 (let ((slot (assq charset chars)))
592 (if slot
a0d96cad 593 (if (not (member char (nthcdr 2 slot)))
51ed58ea
KH		 594 (let ((count (nth 1 slot)))
595 (setcar (cdr slot) (1+ count))
596 (if (or (not maxcount) (< count maxcount))
597 (nconc slot (list char)))))
a0d96cad 598 (setq chars (cons (list charset 1 char) chars)))))))))
51ed58ea
KH		 599 (nreverse chars)))
600
738746ba
KH		 601(defun search-unencodable-char (coding-system)
602 "Search forward from point for a character that is not encodable.
603It asks which coding system to check.
604If such a character is found, set point after that character.
605Otherwise, don't move point.
606
caff3c0a
JB		 607When called from a program, the value is the position of the unencodable
608character found, or nil if all characters are encodable."
738746ba
KH		 609 (interactive
610 (list (let ((default (or buffer-file-coding-system 'us-ascii)))
611 (read-coding-system
5b76833f 612 (format "Coding-system (default %s): " default)
738746ba
KH		 613 default))))
614 (let ((pos (unencodable-char-position (point) (point-max) coding-system)))
615 (if pos
616 (goto-char (1+ pos))
617 (message "All following characters are encodable by %s" coding-system))
618 pos))
619
c83c4f60
RS		 620(defvar last-coding-system-specified nil
621 "Most recent coding system explicitly specified by the user when asked.
622This variable is set whenever Emacs asks the user which coding system
623to use in order to write a file. If you set it to nil explicitly,
624then call `write-region', then afterward this variable will be non-nil
625only if the user was explicitly asked and specified a coding system.")
626
b5edd1d1 627(defvar select-safe-coding-system-accept-default-p nil
fea6b736 628 "If non-nil, a function to control the behavior of coding system selection.
b5edd1d1
KH		 629The meaning is the same as the argument ACCEPT-DEFAULT-P of the
630function `select-safe-coding-system' (which see). This variable
631overrides that argument.")
632
9ee5b744
SM		 633(defun select-safe-coding-system-interactively (from to codings unsafe
634 &optional rejected default)
635 "Select interactively a coding system for the region FROM ... TO.
636FROM can be a string, as in `write-region'.
637CODINGS is the list of base coding systems known to be safe for this region,
638 typically obtained with `find-coding-systems-region'.
639UNSAFE is a list of coding systems known to be unsafe for this region.
640REJECTED is a list of coding systems which were safe but for some reason
641 were not recommended in the particular context.
642DEFAULT is the coding system to use by default in the query."
643 ;; At first, if some defaults are unsafe, record at most 11
644 ;; problematic characters and their positions for them by turning
645 ;; (CODING ...)
646 ;; into
647 ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
648 (if unsafe
649 (setq unsafe
650 (mapcar #'(lambda (coding)
651 (cons coding
652 (if (stringp from)
653 (mapcar #'(lambda (pos)
654 (cons pos (aref from pos)))
655 (unencodable-char-position
656 0 (length from) coding
657 11 from))
658 (mapcar #'(lambda (pos)
659 (cons pos (char-after pos)))
660 (unencodable-char-position
661 from to coding 11)))))
662 unsafe)))
663
664 ;; Change each safe coding system to the corresponding
665 ;; mime-charset name if it is also a coding system. Such a name
666 ;; is more friendly to users.
667 (let ((l codings)
668 mime-charset)
669 (while l
a77c22c2
KH		 670 (setq mime-charset (coding-system-get (car l) :mime-charset))
671 (if (and mime-charset (coding-system-p mime-charset)
672 (coding-system-equal (car l) mime-charset))
9ee5b744
SM		 673 (setcar l mime-charset))
674 (setq l (cdr l))))
675
676 ;; Don't offer variations with locking shift, which you
677 ;; basically never want.
678 (let (l)
679 (dolist (elt codings (setq codings (nreverse l)))
680 (unless (or (eq 'coding-category-iso-7-else
681 (coding-system-category elt))
682 (eq 'coding-category-iso-8-else
683 (coding-system-category elt)))
684 (push elt l))))
685
686 ;; Remove raw-text, emacs-mule and no-conversion unless nothing
687 ;; else is available.
688 (setq codings
689 (or (delq 'raw-text
690 (delq 'emacs-mule
691 (delq 'no-conversion codings)))
692 '(raw-text emacs-mule no-conversion)))
693
694 (let ((window-configuration (current-window-configuration))
695 (bufname (buffer-name))
696 coding-system)
697 (save-excursion
698 ;; If some defaults are unsafe, make sure the offending
699 ;; buffer is displayed.
700 (when (and unsafe (not (stringp from)))
701 (pop-to-buffer bufname)
702 (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
703 unsafe))))
704 ;; Then ask users to select one from CODINGS while showing
705 ;; the reason why none of the defaults are not used.
706 (with-output-to-temp-buffer "*Warning*"
707 (with-current-buffer standard-output
708 (if (and (null rejected) (null unsafe))
709 (insert "No default coding systems to try for "
710 (if (stringp from)
711 (format "string \"%s\"." from)
712 (format "buffer `%s'." bufname)))
713 (insert
714 "These default coding systems were tried to encode"
715 (if (stringp from)
716 (concat " \"" (if (> (length from) 10)
717 (concat (substring from 0 10) "...\"")
718 (concat from "\"")))
719 (format " text\nin the buffer `%s'" bufname))
720 ":\n")
721 (let ((pos (point))
722 (fill-prefix " "))
723 (dolist (x (append rejected unsafe))
46c04718 724 (princ " ") (princ x))
9ee5b744
SM		 725 (insert "\n")
726 (fill-region-as-paragraph pos (point)))
727 (when rejected
3fc0b26e
EZ		 728 (insert "These safely encode the text in the buffer,
729but are not recommended for encoding text in this context,
9ee5b744
SM		 730e.g., for sending an email message.\n ")
731 (dolist (x rejected)
732 (princ " ") (princ x))
733 (insert "\n"))
734 (when unsafe
3fc0b26e 735 (insert (if rejected "The other coding systems"
9ee5b744 736 "However, each of them")
3fc0b26e 737 " encountered characters it couldn't encode:\n")
9ee5b744 738 (dolist (coding unsafe)
3fc0b26e 739 (insert (format " %s cannot encode these:" (car coding)))
9ee5b744
SM		 740 (let ((i 0)
741 (func1
742 #'(lambda (bufname pos)
743 (when (buffer-live-p (get-buffer bufname))
744 (pop-to-buffer bufname)
745 (goto-char pos))))
746 (func2
747 #'(lambda (bufname pos coding)
748 (when (buffer-live-p (get-buffer bufname))
749 (pop-to-buffer bufname)
750 (if (< (point) pos)
751 (goto-char pos)
752 (forward-char 1)
753 (search-unencodable-char coding)
754 (forward-char -1))))))
755 (dolist (elt (cdr coding))
756 (insert " ")
757 (if (stringp from)
758 (insert (if (< i 10) (cdr elt) "..."))
759 (if (< i 10)
760 (insert-text-button
761 (cdr elt)
762 :type 'help-xref
4e21e5aa 763 'face 'link
9ee5b744
SM		 764 'help-echo
765 "mouse-2, RET: jump to this character"
766 'help-function func1
767 'help-args (list bufname (car elt)))
768 (insert-text-button
769 "..."
770 :type 'help-xref
4e21e5aa 771 'face 'link
9ee5b744
SM		 772 'help-echo
773 "mouse-2, RET: next unencodable character"
774 'help-function func2
775 'help-args (list bufname (car elt)
776 (car coding)))))
777 (setq i (1+ i))))
778 (insert "\n"))
333f3572 779 (insert (substitute-command-keys "\
7d03c5b1 780
333f3572
KH		 781Click on a character (or switch to this window by `\\[other-window]'\n\
782and select the characters by RET) to jump to the place it appears,\n\
3fc0b26e 783where `\\[universal-argument] \\[what-cursor-position]' will give information about it.\n"))))
7d03c5b1 784 (insert (substitute-command-keys "\nSelect \
3fc0b26e
EZ		 785one of the safe coding systems listed below,\n\
786or cancel the writing with \\[keyboard-quit] and edit the buffer\n\
787 to remove or modify the problematic characters,\n\
788or specify any other coding system (and risk losing\n\
789 the problematic characters).\n\n"))
9ee5b744
SM		 790 (let ((pos (point))
791 (fill-prefix " "))
792 (dolist (x codings)
793 (princ " ") (princ x))
794 (insert "\n")
7d03c5b1 795 (fill-region-as-paragraph pos (point)))))
9ee5b744
SM		 796
797 ;; Read a coding system.
798 (setq coding-system
799 (read-coding-system
800 (format "Select coding system (default %s): " default)
801 default))
802 (setq last-coding-system-specified coding-system))
803
804 (kill-buffer "*Warning*")
805 (set-window-configuration window-configuration)
806 coding-system))
807
b5edd1d1 808(defun select-safe-coding-system (from to &optional default-coding-system
efa2c6d7 809 accept-default-p file)
d5266ddf
KH		 810 "Ask a user to select a safe coding system from candidates.
811The candidates of coding systems which can safely encode a text
b5edd1d1
KH		 812between FROM and TO are shown in a popup window. Among them, the most
813proper one is suggested as the default.
814
d0d8885d 815The list of `buffer-file-coding-system' of the current buffer, the
b56a5ae0 816default `buffer-file-coding-system', and the most preferred coding
d0d8885d
JB		 817system (if it corresponds to a MIME charset) is treated as the
818default coding system list. Among them, the first one that safely
819encodes the text is normally selected silently and returned without
820any user interaction. See also the command `prefer-coding-system'.
d37ef0f6
DL		 821
822However, the user is queried if the chosen coding system is
29d04c4f 823inconsistent with what would be selected by `find-auto-coding' from
d37ef0f6
DL		 824coding cookies &c. if the contents of the region were read from a
825file. (That could lead to data corruption in a file subsequently
826re-visited and edited.)
54b226f7 827
b5edd1d1
KH		 828Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
829list of coding systems to be prepended to the default coding system
0e9ec609 830list. However, if DEFAULT-CODING-SYSTEM is a list and the first
ccb06340 831element is t, the cdr part is used as the default coding system list,
b56a5ae0 832i.e. current `buffer-file-coding-system', default `buffer-file-coding-system',
a985cd2f 833and the most preferred coding system are not used.
54b226f7 834
b5edd1d1
KH		 835Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to
836determine the acceptability of the silently selected coding system.
837It is called with that coding system, and should return nil if it
838should not be silently selected and thus user interaction is required.
839
efa2c6d7
RS		 840Optional 5th arg FILE is the file name to use for this purpose.
841That is different from `buffer-file-name' when handling `write-region'
842\(for example).
843
d0d8885d
JB		 844The variable `select-safe-coding-system-accept-default-p', if non-nil,
845overrides ACCEPT-DEFAULT-P.
54b226f7
KH		 846
847Kludgy feature: if FROM is a string, the string is the target text,
848and TO is ignored."
64657387 849 (if (not (listp default-coding-system))
b5edd1d1
KH		 850 (setq default-coding-system (list default-coding-system)))
851
29d04c4f
KH		 852 (let ((no-other-defaults nil)
853 auto-cs)
d35deeec 854 (unless (or (stringp from) find-file-literally)
29d04c4f
KH		 855 ;; Find an auto-coding that is specified for the the current
856 ;; buffer and file from the region FROM and TO.
857 (save-excursion
858 (save-restriction
859 (widen)
860 (goto-char from)
861 (setq auto-cs (find-auto-coding (or file buffer-file-name "")
862 (- to from)))
863 (if auto-cs
864 (if (coding-system-p (car auto-cs))
865 (setq auto-cs (car auto-cs))
866 (display-warning
2364df5c 867 'mule
29d04c4f
KH		 868 (format "\
869Invalid coding system `%s' is specified
870for the current buffer/file by the %s.
871It is highly recommended to fix it before writing to a file."
872 (car auto-cs)
873 (if (eq (cdr auto-cs) :coding) ":coding tag"
2364df5c
JB		 874 (format "variable `%s'" (cdr auto-cs))))
875 :warning)
29d04c4f
KH		 876 (or (yes-or-no-p "Really proceed with writing? ")
877 (error "Save aborted"))
878 (setq auto-cs nil))))))
879
0e9ec609
KH		 880 (if (eq (car default-coding-system) t)
881 (setq no-other-defaults t
882 default-coding-system (cdr default-coding-system)))
883
884 ;; Change elements of the list to (coding . base-coding).
885 (setq default-coding-system
886 (mapcar (function (lambda (x) (cons x (coding-system-base x))))
887 default-coding-system))
888
29d04c4f
KH		 889 (if (and auto-cs (not no-other-defaults))
890 ;; If the file has a coding cookie, try to use it before anything
891 ;; else (i.e. before default-coding-system which will typically come
892 ;; from file-coding-system-alist).
893 (let ((base (coding-system-base auto-cs)))
894 (or (memq base '(nil undecided))
895 (rassq base default-coding-system)
896 (push (cons auto-cs base) default-coding-system))))
897
0e9ec609
KH		 898 (unless no-other-defaults
899 ;; If buffer-file-coding-system is not nil nor undecided, append it
900 ;; to the defaults.
901 (if buffer-file-coding-system
902 (let ((base (coding-system-base buffer-file-coding-system)))
903 (or (eq base 'undecided)
0e9ec609 904 (rassq base default-coding-system)
ccb06340
KH		 905 (setq default-coding-system
906 (append default-coding-system
907 (list (cons buffer-file-coding-system base)))))))
a985cd2f 908
659be258
KH		 909 (unless (and buffer-file-coding-system-explicit
910 (cdr buffer-file-coding-system-explicit))
b56a5ae0 911 ;; If default buffer-file-coding-system is not nil nor undecided,
659be258 912 ;; append it to the defaults.
b56a5ae0
SM		 913 (when (default-value 'buffer-file-coding-system)
914 (let ((base (coding-system-base
915 (default-value 'buffer-file-coding-system))))
916 (or (eq base 'undecided)
917 (rassq base default-coding-system)
918 (setq default-coding-system
919 (append default-coding-system
920 (list (cons (default-value
921 'buffer-file-coding-system)
922 base)))))))
659be258
KH		 923
924 ;; If the most preferred coding system has the property mime-charset,
925 ;; append it to the defaults.
926 (let ((preferred (coding-system-priority-list t))
927 base)
928 (and (coding-system-p preferred)
929 (setq base (coding-system-base preferred))
930 (coding-system-get preferred :mime-charset)
931 (not (rassq base default-coding-system))
932 (setq default-coding-system
933 (append default-coding-system
934 (list (cons preferred base))))))))
29d04c4f
KH		 935
936 (if select-safe-coding-system-accept-default-p
937 (setq accept-default-p select-safe-coding-system-accept-default-p))
938
bae7cd08 939 ;; Decide the eol-type from the top of the default codings,
b56a5ae0 940 ;; current buffer-file-coding-system, or default buffer-file-coding-system.
bae7cd08
KH		 941 (if default-coding-system
942 (let ((default-eol-type (coding-system-eol-type
943 (caar default-coding-system))))
944 (if (and (vectorp default-eol-type) buffer-file-coding-system)
d35deeec 945 (setq default-eol-type (coding-system-eol-type
bae7cd08 946 buffer-file-coding-system)))
b56a5ae0
SM		 947 (if (and (vectorp default-eol-type)
948 (default-value 'buffer-file-coding-system))
949 (setq default-eol-type
950 (coding-system-eol-type
951 (default-value 'buffer-file-coding-system))))
bae7cd08
KH		 952 (if (and default-eol-type (not (vectorp default-eol-type)))
953 (dolist (elt default-coding-system)
954 (setcar elt (coding-system-change-eol-conversion
955 (car elt) default-eol-type))))))
956
29d04c4f
KH		 957 (let ((codings (find-coding-systems-region from to))
958 (coding-system nil)
c381cb8d 959 (tick (if (not (stringp from)) (buffer-chars-modified-tick)))
29d04c4f 960 safe rejected unsafe)
bae7cd08
KH		 961 (if (eq (car codings) 'undecided)
962 ;; Any coding system is ok.
963 (setq coding-system (caar default-coding-system))
964 ;; Reverse the list so that elements are accumulated in safe,
965 ;; rejected, and unsafe in the correct order.
966 (setq default-coding-system (nreverse default-coding-system))
967
968 ;; Classify the defaults into safe, rejected, and unsafe.
969 (dolist (elt default-coding-system)
970 (if (or (eq (car codings) 'undecided)
971 (memq (cdr elt) codings))
972 (if (and (functionp accept-default-p)
973 (not (funcall accept-default-p (cdr elt))))
974 (push (car elt) rejected)
975 (push (car elt) safe))
976 (push (car elt) unsafe)))
977 (if safe
978 (setq coding-system (car safe))))
29d04c4f
KH		 979
980 ;; If all the defaults failed, ask a user.
bae7cd08 981 (when (not coding-system)
29d04c4f
KH		 982 (setq coding-system (select-safe-coding-system-interactively
983 from to codings unsafe rejected (car codings))))
984
29d04c4f
KH		 985 ;; Check we're not inconsistent with what `coding:' spec &c would
986 ;; give when file is re-read.
987 ;; But don't do this if we explicitly ignored the cookie
988 ;; by using `find-file-literally'.
989 (when (and auto-cs
990 (not (and
991 coding-system
992 (memq (coding-system-type coding-system) '(0 5)))))
6b61353c
KH		 993 ;; Merge coding-system and auto-cs as far as possible.
994 (if (not coding-system)
995 (setq coding-system auto-cs)
996 (if (not auto-cs)
997 (setq auto-cs coding-system)
998 (let ((eol-type-1 (coding-system-eol-type coding-system))
999 (eol-type-2 (coding-system-eol-type auto-cs)))
1000 (if (eq (coding-system-base coding-system) 'undecided)
1001 (setq coding-system (coding-system-change-text-conversion
1002 coding-system auto-cs))
1003 (if (eq (coding-system-base auto-cs) 'undecided)
1004 (setq auto-cs (coding-system-change-text-conversion
1005 auto-cs coding-system))))
1006 (if (vectorp eol-type-1)
1007 (or (vectorp eol-type-2)
1008 (setq coding-system (coding-system-change-eol-conversion
1009 coding-system eol-type-2)))
1010 (if (vectorp eol-type-2)
1011 (setq auto-cs (coding-system-change-eol-conversion
1012 auto-cs eol-type-1)))))))
1013
1014 (if (and auto-cs
d37ef0f6
DL		 1015 ;; Don't barf if writing a compressed file, say.
1016 ;; This check perhaps isn't ideal, but is probably
1017 ;; the best thing to do.
1018 (not (auto-coding-alist-lookup (or file buffer-file-name "")))
6b61353c 1019 (not (coding-system-equal coding-system auto-cs)))
43afed8c
RS		 1020 (unless (yes-or-no-p
1021 (format "Selected encoding %s disagrees with \
1022%s specified by file contents. Really save (else edit coding cookies \
1023and try again)? " coding-system auto-cs))
29d04c4f 1024 (error "Save aborted"))))
c381cb8d 1025 (when (and tick (/= tick (buffer-chars-modified-tick)))
86c3a9fb 1026 (error "Cancelled because the buffer was modified"))
29d04c4f 1027 coding-system)))
54b226f7
KH		 1028
1029(setq select-safe-coding-system-function 'select-safe-coding-system)
1030
46babb23
KH		 1031(defun select-message-coding-system ()
1032 "Return a coding system to encode the outgoing message of the current buffer.
1033It at first tries the first coding system found in these variables
1034in this order:
1035 (1) local value of `buffer-file-coding-system'
1036 (2) value of `sendmail-coding-system'
b5edd1d1 1037 (3) value of `default-sendmail-coding-system'
b56a5ae0 1038 (4) default value of `buffer-file-coding-system'
46babb23
KH		 1039If the found coding system can't encode the current buffer,
1040or none of them are bound to a coding system,
48e41165 1041it asks the user to select a proper coding system."
46babb23 1042 (let ((coding (or (and (local-variable-p 'buffer-file-coding-system)
b5edd1d1
KH		 1043 buffer-file-coding-system)
1044 sendmail-coding-system
1045 default-sendmail-coding-system
b56a5ae0 1046 (default-value 'buffer-file-coding-system))))
46babb23 1047 (if (eq coding 'no-conversion)
d37ef0f6 1048 ;; We should never use no-conversion for outgoing mail.
46babb23
KH		 1049 (setq coding nil))
1050 (if (fboundp select-safe-coding-system-function)
1051 (funcall select-safe-coding-system-function
b5edd1d1 1052 (point-min) (point-max) coding
209c73b0 1053 (function (lambda (x) (coding-system-get x :mime-charset))))
46babb23 1054 coding)))
4ed46869 1055\f
03c35c83 1056;;; Language support stuff.
4ed46869 1057
4ed46869 1058(defvar language-info-alist nil
2c395d56 1059 "Alist of language environment definitions.
4ed46869
KH		 1060Each element looks like:
1061 (LANGUAGE-NAME . ((KEY . INFO) ...))
2c395d56
RS		 1062where LANGUAGE-NAME is a string, the name of the language environment,
1063KEY is a symbol denoting the kind of information, and
1064INFO is the data associated with KEY.
1065Meaningful values for KEY include
1066
1067 documentation value is documentation of what this language environment
1068 is meant for, and how to use it.
7dd42fb1
KH		 1069 charset value is a list of the character sets mainly used
1070 by this language environment.
d37ef0f6
DL		 1071 sample-text value is an expression which is evalled to generate
1072 a line of text written using characters appropriate
1073 for this language environment.
2c395d56
RS		 1074 setup-function value is a function to call to switch to this
1075 language environment.
1076 exit-function value is a function to call to leave this
1077 language environment.
d0d8885d
JB		 1078 coding-system value is a list of coding systems that are good for
1079 saving text written in this language environment.
2c395d56
RS		 1080 This list serves as suggestions to the user;
1081 in effect, as a kind of documentation.
1082 coding-priority value is a list of coding systems for this language
1083 environment, in order of decreasing priority.
1084 This is used to set up the coding system priority
45d08cb2 1085 list when you switch to this language environment.
ddb5c041 1086 nonascii-translation
7dd42fb1
KH		 1087 value is a charset of dimension one to use for
1088 converting a unibyte character to multibyte
1089 and vice versa.
ddb5c041
KH		 1090 input-method value is a default input method for this language
1091 environment.
7624ebb9
KH		 1092 features value is a list of features requested in this
1093 language environment.
6b61353c 1094 ctext-non-standard-encodings
d0d8885d
JB		 1095 value is a list of non-standard encoding names used
1096 in extended segments of CTEXT. See the variable
1097 `ctext-non-standard-encodings' for more detail.
ddb5c041
KH		 1098
1099The following keys take effect only when multibyte characters are
597e2240 1100globally disabled, i.e. the default value of `enable-multibyte-characters'
ddb5c041
KH		 1101is nil.
1102
d0d8885d
JB		 1103 unibyte-display value is a coding system to encode characters for
1104 the terminal. Characters in the range of 160 to
1105 255 display not as octal escapes, but as non-ASCII
1106 characters in this language environment.")
2c395d56
RS		 1107
1108(defun get-language-info (lang-env key)
1109 "Return information listed under KEY for language environment LANG-ENV.
1110KEY is a symbol denoting the kind of information.
1111For a list of useful values for KEY and their meanings,
1112see `language-info-alist'."
1113 (if (symbolp lang-env)
1114 (setq lang-env (symbol-name lang-env)))
f15466c5 1115 (let ((lang-slot (assoc-string lang-env language-info-alist t)))
4ed46869
KH		 1116 (if lang-slot
1117 (cdr (assq key (cdr lang-slot))))))
1118
f08adf27 1119(defun set-language-info (lang-env key info)
2c395d56
RS		 1120 "Modify part of the definition of language environment LANG-ENV.
1121Specifically, this stores the information INFO under KEY
1122in the definition of this language environment.
4ed46869 1123KEY is a symbol denoting the kind of information.
2c395d56 1124INFO is the value for that information.
281d03ec 1125
2c395d56 1126For a list of useful values for KEY and their meanings,
f08adf27 1127see `language-info-alist'."
2c395d56
RS		 1128 (if (symbolp lang-env)
1129 (setq lang-env (symbol-name lang-env)))
eec5c8f9
KH		 1130 (set-language-info-internal lang-env key info)
1131 (if (equal lang-env current-language-environment)
d042f8b4 1132 (cond ((eq key 'coding-priority)
e9a8ed3c
KH		 1133 (set-language-environment-coding-systems lang-env)
1134 (set-language-environment-charset lang-env))
d042f8b4
KH		 1135 ((eq key 'input-method)
1136 (set-language-environment-input-method lang-env))
1137 ((eq key 'nonascii-translation)
1138 (set-language-environment-nonascii-translation lang-env))
1139 ((eq key 'charset)
1140 (set-language-environment-charset lang-env))
597e2240 1141 ((and (not (default-value 'enable-multibyte-characters))
d042f8b4
KH		 1142 (or (eq key 'unibyte-syntax) (eq key 'unibyte-display)))
1143 (set-language-environment-unibyte lang-env)))))
eec5c8f9
KH		 1144
1145(defun set-language-info-internal (lang-env key info)
1146 "Internal use only.
1147Arguments are the same as `set-language-info'."
4ed46869 1148 (let (lang-slot key-slot)
2c395d56 1149 (setq lang-slot (assoc lang-env language-info-alist))
4ed46869 1150 (if (null lang-slot) ; If no slot for the language, add it.
2c395d56 1151 (setq lang-slot (list lang-env)
4ed46869
KH		 1152 language-info-alist (cons lang-slot language-info-alist)))
1153 (setq key-slot (assq key lang-slot))
1154 (if (null key-slot) ; If no slot for the key, add it.
1155 (progn
1156 (setq key-slot (list key))
1157 (setcdr lang-slot (cons key-slot (cdr lang-slot)))))
590dbcba 1158 (setcdr key-slot (purecopy info))
1169bd86 1159 ;; Update the custom-type of `current-language-environment'.
590dbcba 1160 (put 'current-language-environment 'custom-type
1169bd86
MR		 1161 (cons 'choice (mapcar
1162 (lambda (lang)
756e055f
MR		 1163 (list 'const lang))
1164 (sort (mapcar 'car language-info-alist) 'string<))))))
4ed46869 1165
2c395d56
RS		 1166(defun set-language-info-alist (lang-env alist &optional parents)
1167 "Store ALIST as the definition of language environment LANG-ENV.
1168ALIST is an alist of KEY and INFO values. See the documentation of
98c6d6ed 1169`language-info-alist' for the meanings of KEY and INFO.
54b226f7 1170
2c395d56 1171Optional arg PARENTS is a list of parent menu names; it specifies
d37ef0f6 1172where to put this language environment in the
2c395d56
RS		 1173Describe Language Environment and Set Language Environment menus.
1174For example, (\"European\") means to put this language environment
1175in the European submenu in each of those two menus."
1176 (if (symbolp lang-env)
1177 (setq lang-env (symbol-name lang-env)))
54b226f7
KH		 1178 (let ((describe-map describe-language-environment-map)
1179 (setup-map setup-language-environment-map))
1180 (if parents
1181 (let ((l parents)
9deed82f 1182 map parent-symbol parent prompt)
54b226f7
KH		 1183 (while l
1184 (if (symbolp (setq parent-symbol (car l)))
1185 (setq parent (symbol-name parent))
1186 (setq parent parent-symbol parent-symbol (intern parent)))
1187 (setq map (lookup-key describe-map (vector parent-symbol)))
9deed82f
EZ		 1188 ;; This prompt string is for define-prefix-command, so
1189 ;; that the map it creates will be suitable for a menu.
1190 (or map (setq prompt (format "%s Environment" parent)))
54b226f7
KH		 1191 (if (not map)
1192 (progn
1193 (setq map (intern (format "describe-%s-environment-map"
1194 (downcase parent))))
9deed82f 1195 (define-prefix-command map nil prompt)
54b226f7 1196 (define-key-after describe-map (vector parent-symbol)
64657387 1197 (cons parent map))))
54b226f7
KH		 1198 (setq describe-map (symbol-value map))
1199 (setq map (lookup-key setup-map (vector parent-symbol)))
1200 (if (not map)
1201 (progn
1202 (setq map (intern (format "setup-%s-environment-map"
1203 (downcase parent))))
9deed82f 1204 (define-prefix-command map nil prompt)
54b226f7 1205 (define-key-after setup-map (vector parent-symbol)
64657387 1206 (cons parent map))))
54b226f7
KH		 1207 (setq setup-map (symbol-value map))
1208 (setq l (cdr l)))))
f08adf27
RS		 1209
1210 ;; Set up menu items for this language env.
7624ebb9 1211 (let ((doc (assq 'documentation alist)))
f08adf27
RS		 1212 (when doc
1213 (define-key-after describe-map (vector (intern lang-env))
64657387 1214 (cons lang-env 'describe-specified-language-support))))
7624ebb9 1215 (define-key-after setup-map (vector (intern lang-env))
64657387 1216 (cons lang-env 'setup-specified-language-environment))
f08adf27 1217
eec5c8f9
KH		 1218 (dolist (elt alist)
1219 (set-language-info-internal lang-env (car elt) (cdr elt)))
d35deeec 1220
eec5c8f9
KH		 1221 (if (equal lang-env current-language-environment)
1222 (set-language-environment lang-env))))
4ed46869 1223
ae302641 1224(defun read-language-name (key prompt &optional default)
2c395d56 1225 "Read a language environment name which has information for KEY.
ddb5c041 1226If KEY is nil, read any language environment.
2c395d56
RS		 1227Prompt with PROMPT. DEFAULT is the default choice of language environment.
1228This returns a language environment name as a string."
4ed46869
KH		 1229 (let* ((completion-ignore-case t)
1230 (name (completing-read prompt
1231 language-info-alist
ddb5c041 1232 (and key
ca429a25 1233 (function (lambda (elm) (and (listp elm) (assq key elm)))))
ae302641 1234 t nil nil default)))
13e82c04 1235 (if (and (> (length name) 0)
ddb5c041
KH		 1236 (or (not key)
1237 (get-language-info name key)))
13e82c04 1238 name)))
4ed46869
KH		 1239\f
1240;;; Multilingual input methods.
d37ef0f6 1241(defgroup leim nil
d0c40faa
KH		 1242 "LEIM: Libraries of Emacs Input Methods."
1243 :group 'mule)
4ed46869 1244
d0b9c3ab
KH		 1245(defconst leim-list-file-name "leim-list.el"
1246 "Name of LEIM list file.
1247This file contains a list of libraries of Emacs input methods (LEIM)
1248in the format of Lisp expression for registering each input method.
1249Emacs loads this file at startup time.")
1250
2e224638 1251(defvar leim-list-header (format
316732d2 1252";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
d0b9c3ab 1253;;
bcd76f45
SM		 1254;; This file is automatically generated.
1255;;
d0b9c3ab 1256;; This file contains a list of LEIM (Library of Emacs Input Method)
c654de1d
DL		 1257;; methods in the same directory as this file. Loading this file
1258;; registers all the input methods in Emacs.
d0b9c3ab 1259;;
d33d5fbe 1260;; Each entry has the form:
d0b9c3ab
KH		 1261;; (register-input-method
1262;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC
1263;; TITLE DESCRIPTION
1264;; ARG ...)
c654de1d 1265;; See the function `register-input-method' for the meanings of the arguments.
d0b9c3ab 1266;;
bcd76f45 1267;; If this directory is included in `load-path', Emacs automatically
d0b9c3ab
KH		 1268;; loads this file at startup time.
1269
1270"
1271 leim-list-file-name)
1272 "Header to be inserted in LEIM list file.")
1273
e55e92ee 1274(defvar leim-list-entry-regexp "^(register-input-method"
d0b9c3ab 1275 "Regexp matching head of each entry in LEIM list file.
caff3c0a 1276See also the variable `leim-list-header'.")
d0b9c3ab
KH		 1277
1278(defvar update-leim-list-functions
1279 '(quail-update-leim-list-file)
1280 "List of functions to call to update LEIM list file.
1281Each function is called with one arg, LEIM directory name.")
1282
a337fe7f
RS		 1283(defun update-leim-list-file (&rest dirs)
1284 "Update LEIM list file in directories DIRS."
d0d8885d
JB		 1285 (dolist (function update-leim-list-functions)
1286 (apply function dirs)))
d0b9c3ab 1287
4ed46869
KH		 1288(defvar current-input-method nil
1289 "The current input method for multilingual text.
96db204a 1290If nil, that means no input method is activated now.")
4ed46869
KH		 1291(make-variable-buffer-local 'current-input-method)
1292(put 'current-input-method 'permanent-local t)
1293
1294(defvar current-input-method-title nil
d0b9c3ab 1295 "Title string of the current input method shown in mode line.")
4ed46869
KH		 1296(make-variable-buffer-local 'current-input-method-title)
1297(put 'current-input-method-title 'permanent-local t)
1298
b4fba33f 1299(defcustom default-input-method nil
caff3c0a 1300 "Default input method for multilingual text (a string).
b4fba33f 1301This is the input method activated automatically by the command
9b10b5a3 1302`toggle-input-method' (\\[toggle-input-method])."
1f547b92 1303 :link '(custom-manual "(emacs)Input Methods")
8861c593 1304 :group 'mule
d398dba6
DL		 1305 :type '(choice (const nil) (string
1306 :completion-ignore-case t
1307 :complete-function widget-string-complete
1308 :completion-alist input-method-alist
1309 :prompt-history input-method-history))
5806e8a6 1310 :set-after '(current-language-environment))
b4fba33f 1311
0f835e87
KH		 1312(put 'input-method-function 'permanent-local t)
1313
723a427a 1314(defvar input-method-history nil
6f5d2452
EZ		 1315 "History list of input methods read from the minibuffer.
1316
1317Maximum length of the history list is determined by the value
1318of `history-length', which see.")
723a427a
KH		 1319(make-variable-buffer-local 'input-method-history)
1320(put 'input-method-history 'permanent-local t)
4ed46869
KH		 1321
1322(defvar inactivate-current-input-method-function nil
1323 "Function to call for inactivating the current input method.
1324Every input method should set this to an appropriate value when activated.
f17ccaee
KH		 1325This function is called with no argument.
1326
1327This function should never change the value of `current-input-method'.
1328It is set to nil by the function `inactivate-input-method'.")
4ed46869
KH		 1329(make-variable-buffer-local 'inactivate-current-input-method-function)
1330(put 'inactivate-current-input-method-function 'permanent-local t)
1331
1332(defvar describe-current-input-method-function nil
1333 "Function to call for describing the current input method.
1334This function is called with no argument.")
1335(make-variable-buffer-local 'describe-current-input-method-function)
1336(put 'describe-current-input-method-function 'permanent-local t)
1337
d0b9c3ab 1338(defvar input-method-alist nil
2c395d56 1339 "Alist of input method names vs how to use them.
d0b9c3ab 1340Each element has the form:
2c395d56
RS		 1341 (INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...)
1342See the function `register-input-method' for the meanings of the elements.")
6dc3311d
GM		 1343;; Autoload if this file no longer dumped.
1344(put 'input-method-alist 'risky-local-variable t)
2c395d56 1345
f08adf27 1346(defun register-input-method (input-method lang-env &rest args)
bf42aa15 1347 "Register INPUT-METHOD as an input method for language environment LANG-ENV.
d0b9c3ab 1348
d35deeec 1349INPUT-METHOD and LANG-ENV are symbols or strings.
2c395d56
RS		 1350ACTIVATE-FUNC is a function to call to activate this method.
1351TITLE is a string to show in the mode line when this method is active.
1352DESCRIPTION is a string describing this method and what it is good for.
1353The ARGS, if any, are passed as arguments to ACTIVATE-FUNC.
205814ee
KH		 1354All told, the arguments to ACTIVATE-FUNC are INPUT-METHOD and the ARGS.
1355
c654de1d
DL		 1356This function is mainly used in the file \"leim-list.el\" which is
1357created at Emacs build time, registering all Quail input methods
0b6cadff 1358contained in the Emacs distribution.
205814ee 1359
0b6cadff 1360In case you want to register a new Quail input method by yourself, be
205814ee 1361careful to use the same input method title as given in the third
0b6cadff
DL		 1362parameter of `quail-define-package'. (If the values are different, the
1363string specified in this function takes precedence.)
205814ee
KH		 1364
1365The commands `describe-input-method' and `list-input-methods' need
0b6cadff 1366these duplicated values to show some information about input methods
d35deeec
JB		 1367without loading the relevant Quail packages.
1368\n(fn INPUT-METHOD LANG-ENV ACTIVATE-FUNC TITLE DESCRIPTION &rest ARGS)"
f08adf27
RS		 1369 (if (symbolp lang-env)
1370 (setq lang-env (symbol-name lang-env)))
4ef06f75
KH		 1371 (if (symbolp input-method)
1372 (setq input-method (symbol-name input-method)))
f08adf27 1373 (let ((info (cons lang-env args))
d0b9c3ab
KH		 1374 (slot (assoc input-method input-method-alist)))
1375 (if slot
1376 (setcdr slot info)
1377 (setq slot (cons input-method info))
1378 (setq input-method-alist (cons slot input-method-alist)))))
1379
4d5ac029 1380(defun read-input-method-name (prompt &optional default inhibit-null)
d0b9c3ab 1381 "Read a name of input method from a minibuffer prompting with PROMPT.
4d5ac029 1382If DEFAULT is non-nil, use that as the default,
0b6cadff 1383and substitute it into PROMPT at the first `%s'.
4ef06f75
KH		 1384If INHIBIT-NULL is non-nil, null input signals an error.
1385
1386The return value is a string."
4d5ac029
RS		 1387 (if default
1388 (setq prompt (format prompt default)))
d0b9c3ab 1389 (let* ((completion-ignore-case t)
c54044ff
KH		 1390 ;; As it is quite normal to change input method in the
1391 ;; minibuffer, we must enable it even if
1392 ;; enable-recursive-minibuffers is currently nil.
1393 (enable-recursive-minibuffers t)
723a427a
KH		 1394 ;; This binding is necessary because input-method-history is
1395 ;; buffer local.
d0b9c3ab 1396 (input-method (completing-read prompt input-method-alist
87505a98
RS		 1397 nil t nil 'input-method-history
1398 default)))
bf294e6e
KH		 1399 (if (and input-method (symbolp input-method))
1400 (setq input-method (symbol-name input-method)))
d0b9c3ab
KH		 1401 (if (> (length input-method) 0)
1402 input-method
1403 (if inhibit-null
43807b77 1404 (error "No valid input method is specified")))))
d0b9c3ab 1405
d0b9c3ab 1406(defun activate-input-method (input-method)
2c395d56
RS		 1407 "Switch to input method INPUT-METHOD for the current buffer.
1408If some other input method is already active, turn it off first.
1409If INPUT-METHOD is nil, deactivate any current input method."
305a3cb6 1410 (if (and input-method (symbolp input-method))
4ef06f75 1411 (setq input-method (symbol-name input-method)))
723a427a
KH		 1412 (if (and current-input-method
1413 (not (string= current-input-method input-method)))
305a3cb6 1414 (inactivate-input-method))
2c395d56 1415 (unless (or current-input-method (null input-method))
d0b9c3ab
KH		 1416 (let ((slot (assoc input-method input-method-alist)))
1417 (if (null slot)
723a427a 1418 (error "Can't activate input method `%s'" input-method))
278dd6ac 1419 (setq current-input-method-title nil)
8efc03e1
KH		 1420 (let ((func (nth 2 slot)))
1421 (if (functionp func)
1422 (apply (nth 2 slot) input-method (nthcdr 5 slot))
1423 (if (and (consp func) (symbolp (car func)) (symbolp (cdr func)))
1424 (progn
1425 (require (cdr func))
1426 (apply (car func) input-method (nthcdr 5 slot)))
1427 (error "Can't activate input method `%s'" input-method))))
d0b9c3ab 1428 (setq current-input-method input-method)
278dd6ac
KH		 1429 (or (stringp current-input-method-title)
1430 (setq current-input-method-title (nth 3 slot)))
28885c0e
KH		 1431 (unwind-protect
1432 (run-hooks 'input-method-activate-hook)
1433 (force-mode-line-update)))))
15b3e511 1434
15b3e511 1435(defun inactivate-input-method ()
f17ccaee 1436 "Turn off the current input method."
723a427a
KH		 1437 (when current-input-method
1438 (if input-method-history
1439 (unless (string= current-input-method (car input-method-history))
1440 (setq input-method-history
1441 (cons current-input-method
1442 (delete current-input-method input-method-history))))
1443 (setq input-method-history (list current-input-method)))
1444 (unwind-protect
36f8618c
KH		 1445 (progn
1446 (setq input-method-function nil
1447 current-input-method-title nil)
1448 (funcall inactivate-current-input-method-function))
15b3e511 1449 (unwind-protect
723a427a 1450 (run-hooks 'input-method-inactivate-hook)
36f8618c 1451 (setq current-input-method nil)
28885c0e 1452 (force-mode-line-update)))))
4ed46869 1453
e893eae2 1454(defun set-input-method (input-method &optional interactive)
2c395d56 1455 "Select and activate input method INPUT-METHOD for the current buffer.
bc406911 1456This also sets the default input method to the one you specify.
402dbbd1
EZ		 1457If INPUT-METHOD is nil, this function turns off the input method, and
1458also causes you to be prompted for a name of an input method the next
1459time you invoke \\[toggle-input-method].
e893eae2
RS		 1460When called interactively, the optional arg INTERACTIVE is non-nil,
1461which marks the variable `default-input-method' as set for Custom buffers.
402dbbd1 1462
bc406911 1463To deactivate the input method interactively, use \\[toggle-input-method].
caff3c0a 1464To deactivate it programmatically, use `inactivate-input-method'."
d0b9c3ab 1465 (interactive
723a427a 1466 (let* ((default (or (car input-method-history) default-input-method)))
42395763 1467 (list (read-input-method-name
87505a98 1468 (if default "Select input method (default %s): " "Select input method: ")
e893eae2
RS		 1469 default t)
1470 t)))
d0b9c3ab 1471 (activate-input-method input-method)
f4990970 1472 (setq default-input-method input-method)
e893eae2 1473 (when interactive
f4990970
PA		 1474 (customize-mark-as-set 'default-input-method))
1475 default-input-method)
4ed46869 1476
023df4cf
RS		 1477(defvar toggle-input-method-active nil
1478 "Non-nil inside `toggle-input-method'.")
1479
e893eae2 1480(defun toggle-input-method (&optional arg interactive)
f8ec20be
RS		 1481 "Enable or disable multilingual text input method for the current buffer.
1482Only one input method can be enabled at any time in a given buffer.
1483
d0d8885d
JB		 1484The normal action is to enable an input method if none was enabled,
1485and disable the current one otherwise. Which input method to enable
1486can be determined in various ways--either the one most recently used,
1487or the one specified by `default-input-method', or as a last resort
1488by reading the name of an input method in the minibuffer.
f8ec20be 1489
d0d8885d 1490With a prefix argument ARG, read an input method name with the minibuffer
f8ec20be 1491and enable that one. The default is the most recent input method specified
e893eae2 1492\(not including the currently active input method, if any).
f8ec20be 1493
d0d8885d 1494When called interactively, the optional argument INTERACTIVE is non-nil,
e893eae2
RS		 1495which marks the variable `default-input-method' as set for Custom buffers."
1496
1497 (interactive "P\np")
023df4cf
RS		 1498 (if toggle-input-method-active
1499 (error "Recursive use of `toggle-input-method'"))
7ddbb5bc
RS		 1500 (if (and current-input-method (not arg))
1501 (inactivate-input-method)
023df4cf
RS		 1502 (let ((toggle-input-method-active t)
1503 (default (or (car input-method-history) default-input-method)))
7ddbb5bc
RS		 1504 (if (and arg default (equal current-input-method default)
1505 (> (length input-method-history) 1))
1506 (setq default (nth 1 input-method-history)))
723a427a
KH		 1507 (activate-input-method
1508 (if (or arg (not default))
7ddbb5bc
RS		 1509 (progn
1510 (read-input-method-name
1511 (if default "Input method (default %s): " "Input method: " )
1512 default t))
723a427a 1513 default))
f4990970 1514 (unless default-input-method
d37ef0f6 1515 (prog1
f4990970 1516 (setq default-input-method current-input-method)
e893eae2 1517 (when interactive
f4990970 1518 (customize-mark-as-set 'default-input-method)))))))
d0b9c3ab 1519
26b3dce6 1520(autoload 'help-buffer "help-mode")
0855c6cd 1521
d0b9c3ab 1522(defun describe-input-method (input-method)
2c395d56 1523 "Describe input method INPUT-METHOD."
d0b9c3ab
KH		 1524 (interactive
1525 (list (read-input-method-name
5b76833f 1526 "Describe input method (default current choice): ")))
78754934 1527 (if (and input-method (symbolp input-method))
4ef06f75 1528 (setq input-method (symbol-name input-method)))
43125c28
RS		 1529 (help-setup-xref (list #'describe-input-method
1530 (or input-method current-input-method))
f80e2142
RS		 1531 (interactive-p))
1532
d0b9c3ab
KH		 1533 (if (null input-method)
1534 (describe-current-input-method)
464cc130
KH		 1535 (let ((current current-input-method))
1536 (condition-case nil
1537 (progn
1538 (save-excursion
1539 (activate-input-method input-method)
1540 (describe-current-input-method))
1541 (activate-input-method current))
d37ef0f6 1542 (error
464cc130 1543 (activate-input-method current)
5f395df3
SM		 1544 (help-setup-xref (list #'describe-input-method input-method)
1545 (interactive-p))
1546 (with-output-to-temp-buffer (help-buffer)
464cc130
KH		 1547 (let ((elt (assoc input-method input-method-alist)))
1548 (princ (format
1549 "Input method: %s (`%s' in mode line) for %s\n %s\n"
1550 input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
d0b9c3ab
KH		 1551
1552(defun describe-current-input-method ()
f80e2142
RS		 1553 "Describe the input method currently in use.
1554This is a subroutine for `describe-input-method'."
4ed46869
KH		 1555 (if current-input-method
1556 (if (and (symbolp describe-current-input-method-function)
1557 (fboundp describe-current-input-method-function))
1558 (funcall describe-current-input-method-function)
1559 (message "No way to describe the current input method `%s'"
f2979bdb 1560 current-input-method)
4ed46869 1561 (ding))
d0b9c3ab 1562 (error "No input method is activated now")))
4ed46869 1563
d3459641 1564(defun read-multilingual-string (prompt &optional initial-input input-method)
4ed46869
KH		 1565 "Read a multilingual string from minibuffer, prompting with string PROMPT.
1566The input method selected last time is activated in minibuffer.
d0d8885d
JB		 1567If optional second argument INITIAL-INPUT is non-nil, insert it in the
1568minibuffer initially.
1569Optional 3rd argument INPUT-METHOD specifies the input method to be activated
1570instead of the one selected last time. It is a symbol or a string."
88d559ec
KH		 1571 (setq input-method
1572 (or input-method
d3459641 1573 current-input-method
88d559ec
KH		 1574 default-input-method
1575 (read-input-method-name "Input method: " nil t)))
3df60841 1576 (if (and input-method (symbolp input-method))
4ef06f75 1577 (setq input-method (symbol-name input-method)))
305a3cb6
KH		 1578 (let ((prev-input-method current-input-method))
1579 (unwind-protect
1580 (progn
1581 (activate-input-method input-method)
1582 (read-string prompt initial-input nil nil t))
1583 (activate-input-method prev-input-method))))
4ed46869
KH		 1584
1585;; Variables to control behavior of input methods. All input methods
1586;; should react to these variables.
1587
8efc03e1 1588(defcustom input-method-verbose-flag 'default
caff3c0a 1589 "A flag to control extra guidance given by input methods.
8efc03e1 1590The value should be nil, t, `complex-only', or `default'.
4ed46869 1591
cb29dfb6 1592The extra guidance is done by showing list of available keys in echo
8efc03e1
KH		 1593area. When you use the input method in the minibuffer, the guidance
1594is shown at the bottom short window (split from the existing window).
c27c4ed8 1595
8efc03e1
KH		 1596If the value is t, extra guidance is always given, if the value is
1597nil, extra guidance is always suppressed.
1598
1599If the value is `complex-only', only complex input methods such as
1600`chinese-py' and `japanese' give extra guidance.
1601
1602If the value is `default', complex input methods always give extra
1603guidance, but simple input methods give it only when you are not in
1604the minibuffer.
1605
1606See also the variable `input-method-highlight-flag'."
d37ef0f6
DL		 1607 :type '(choice (const :tag "Always" t) (const :tag "Never" nil)
1608 (const complex-only) (const default))
42395763
RS		 1609 :group 'mule)
1610
1611(defcustom input-method-highlight-flag t
caff3c0a 1612 "If this flag is non-nil, input methods highlight partially-entered text.
42395763
RS		 1613For instance, while you are in the middle of a Quail input method sequence,
1614the text inserted so far is temporarily underlined.
8efc03e1
KH		 1615The underlining goes away when you finish or abort the input method sequence.
1616See also the variable `input-method-verbose-flag'."
42395763
RS		 1617 :type 'boolean
1618 :group 'mule)
4ed46869 1619
1f547b92 1620(defcustom input-method-activate-hook nil
f17ccaee
KH		 1621 "Normal hook run just after an input method is activated.
1622
1623The variable `current-input-method' keeps the input method name
1f547b92
DL		 1624just activated."
1625 :type 'hook
1626 :group 'mule)
4ed46869 1627
1f547b92 1628(defcustom input-method-inactivate-hook nil
f17ccaee
KH		 1629 "Normal hook run just after an input method is inactivated.
1630
1631The variable `current-input-method' still keeps the input method name
1f547b92
DL		 1632just inactivated."
1633 :type 'hook
1634 :group 'mule)
4ed46869 1635
1f547b92 1636(defcustom input-method-after-insert-chunk-hook nil
8f924df7 1637 "Normal hook run just after an input method insert some chunk of text."
1f547b92
DL		 1638 :type 'hook
1639 :group 'mule)
4ed46869 1640
dccca980 1641(defvar input-method-exit-on-first-char nil
0b6cadff 1642 "This flag controls when an input method returns.
dccca980
KH		 1643Usually, the input method does not return while there's a possibility
1644that it may find a different translation if a user types another key.
d0d8885d
JB		 1645But, if this flag is non-nil, the input method returns as soon as the
1646current key sequence gets long enough to have some valid translation.")
dccca980 1647
1f547b92 1648(defcustom input-method-use-echo-area nil
dccca980 1649 "This flag controls how an input method shows an intermediate key sequence.
39e643e2
RS		 1650Usually, the input method inserts the intermediate key sequence,
1651or candidate translations corresponding to the sequence,
1652at point in the current buffer.
1f547b92
DL		 1653But, if this flag is non-nil, it displays them in echo area instead."
1654 :type 'hook
1655 :group 'mule)
dccca980 1656
723a427a 1657(defvar input-method-exit-on-invalid-key nil
fea6b736 1658 "This flag controls the behavior of an input method on invalid key input.
723a427a
KH		 1659Usually, when a user types a key which doesn't start any character
1660handled by the input method, the key is handled by turning off the
e8dd0160 1661input method temporarily. After that key, the input method is re-enabled.
723a427a
KH		 1662But, if this flag is non-nil, the input method is never back on.")
1663
4ed46869 1664\f
1f547b92 1665(defcustom set-language-environment-hook nil
8efc03e1
KH		 1666 "Normal hook run after some language environment is set.
1667
1668When you set some hook function here, that effect usually should not
1669be inherited to another language environment. So, you had better set
1670another function in `exit-language-environment-hook' (which see) to
1f547b92
DL		 1671cancel the effect."
1672 :type 'hook
1673 :group 'mule)
8efc03e1 1674
1f547b92 1675(defcustom exit-language-environment-hook nil
8efc03e1
KH		 1676 "Normal hook run after exiting from some language environment.
1677When this hook is run, the variable `current-language-environment'
1678is still bound to the language environment being exited.
1679
e8dd0160 1680This hook is mainly used for canceling the effect of
caff3c0a 1681`set-language-environment-hook' (which see)."
1f547b92
DL		 1682 :type 'hook
1683 :group 'mule)
8efc03e1 1684
b0648a00
RS		 1685(put 'setup-specified-language-environment 'apropos-inhibit t)
1686
15b3e511 1687(defun setup-specified-language-environment ()
f08adf27 1688 "Switch to a specified language environment."
15b3e511 1689 (interactive)
f850d782 1690 (let (language-name)
15b3e511
KH		 1691 (if (and (symbolp last-command-event)
1692 (or (not (eq last-command-event 'Default))
1693 (setq last-command-event 'English))
f850d782 1694 (setq language-name (symbol-name last-command-event)))
f4990970
PA		 1695 (prog1
1696 (set-language-environment language-name)
1697 (customize-mark-as-set 'current-language-environment))
15b3e511 1698 (error "Bogus calling sequence"))))
4ed46869 1699
8861c593 1700(defcustom current-language-environment "English"
94d04df6 1701 "The last language environment specified with `set-language-environment'.
ebef6d93
KH		 1702This variable should be set only with \\[customize], which is equivalent
1703to using the function `set-language-environment'."
94d04df6 1704 :link '(custom-manual "(emacs)Language Environments")
dff1aa24 1705 :set (lambda (symbol value) (set-language-environment value))
94d04df6 1706 :get (lambda (x)
f15466c5 1707 (or (car-safe (assoc-string
94d04df6
DL		 1708 (if (symbolp current-language-environment)
1709 (symbol-name current-language-environment)
1710 current-language-environment)
f15466c5 1711 language-info-alist t))
94d04df6 1712 "English"))
990a4108
MR		 1713 ;; custom type will be updated with `set-language-info'.
1714 :type (if language-info-alist
1715 (cons 'choice (mapcar
1716 (lambda (lang)
756e055f
MR		 1717 (list 'const lang))
1718 (sort (mapcar 'car language-info-alist) 'string<)))
990a4108 1719 'string)
8861c593 1720 :initialize 'custom-initialize-default
eb9fc9e6 1721 :group 'mule)
f850d782 1722
ddb5c041
KH		 1723(defun reset-language-environment ()
1724 "Reset multilingual environment of Emacs to the default status.
1725
1726The default status is as follows:
1727
d37ef0f6 1728 The default value of `buffer-file-coding-system' is nil.
ddb5c041
KH		 1729 The default coding system for process I/O is nil.
1730 The default value for the command `set-terminal-coding-system' is nil.
1731 The default value for the command `set-keyboard-coding-system' is nil.
1732
97941b05
KH		 1733 The order of priorities of coding systems are as follows:
1734 utf-8
1735 iso-2022-7bit
1736 iso-latin-1
1737 iso-2022-7bit-lock
1738 iso-2022-8bit-ss2
1739 emacs-mule
1740 raw-text"
ddb5c041
KH		 1741 (interactive)
1742 ;; This function formerly set default-enable-multibyte-characters to t,
1743 ;; but that is incorrect. It should not alter the unibyte/multibyte choice.
1744
97941b05
KH		 1745 (set-coding-system-priority
1746 'utf-8
1747 'iso-2022-7bit
1748 'iso-latin-1
1749 'iso-2022-7bit-lock
1750 'iso-2022-8bit-ss2
1751 'emacs-mule
1752 'raw-text)
91693d18 1753
ddb5c041 1754 (set-default-coding-systems nil)
b5edd1d1 1755 (setq default-sendmail-coding-system 'iso-latin-1)
a41118cc
SM		 1756 ;; On Darwin systems, this should be utf-8, but when this file is loaded
1757 ;; utf-8 is not yet defined, so we set it in set-locale-environment instead.
787caf99 1758 (setq default-file-name-coding-system 'iso-latin-1)
1d77e15a
JR		 1759 ;; Preserve eol-type from existing default-process-coding-systems.
1760 ;; On non-unix-like systems in particular, these may have been set
1761 ;; carefully by the user, or by the startup code, to deal with the
1762 ;; users shell appropriately, so should not be altered by changing
1763 ;; language environment.
1764 (let ((output-coding
a099a2ff
JR		 1765 ;; When bootstrapping, coding-systems are not defined yet, so
1766 ;; we need to catch the error from check-coding-system.
d37ef0f6 1767 (condition-case nil
a099a2ff
JR		 1768 (coding-system-change-text-conversion
1769 (car default-process-coding-system) 'undecided)
1770 (coding-system-error 'undecided)))
1d77e15a 1771 (input-coding
a099a2ff
JR		 1772 (condition-case nil
1773 (coding-system-change-text-conversion
1774 (cdr default-process-coding-system) 'iso-latin-1)
1775 (coding-system-error 'iso-latin-1))))
1d77e15a
JR		 1776 (setq default-process-coding-system
1777 (cons output-coding input-coding)))
b5edd1d1 1778
a43977db
KH		 1779 ;; Put the highest priority to the charset iso-8859-1 to prefer the
1780 ;; registry iso8859-1 over iso8859-2 in font selection. It also
1781 ;; makes unibyte-display-via-language-environment to use iso-8859-1
1782 ;; as the unibyte charset.
1783 (set-charset-priority 'iso-8859-1)
1784
ddb5c041
KH		 1785 ;; Don't alter the terminal and keyboard coding systems here.
1786 ;; The terminal still supports the same coding system
1787 ;; that it supported a minute ago.
1b8dc791
SM		 1788 ;; (set-terminal-coding-system-internal nil)
1789 ;; (set-keyboard-coding-system-internal nil)
ddb5c041 1790
33de15f4
SM		 1791 ;; Back in Emacs-20, it was necessary to provide some fallback implicit
1792 ;; conversion, because almost no packages handled coding-system issues.
1793 ;; Nowadays it'd just paper over bugs.
1794 ;; (set-unibyte-charset 'iso-8859-1)
1795 )
ddb5c041 1796
0c47a7c8
KH		 1797(reset-language-environment)
1798
97c57fb2 1799(defun set-display-table-and-terminal-coding-system (language-name &optional coding-system display)
40c81f74
PE		 1800 "Set up the display table and terminal coding system for LANGUAGE-NAME."
1801 (let ((coding (get-language-info language-name 'unibyte-display)))
735b7c87
KH		 1802 (if (and coding
1803 (or (not coding-system)
1804 (coding-system-equal coding coding-system)))
40c81f74 1805 (standard-display-european-internal)
a67ae60e
EZ		 1806 ;; The following 2 lines undo the 8-bit display that we set up
1807 ;; in standard-display-european-internal, which see. This is in
1808 ;; case the user has used standard-display-european earlier in
970c9391 1809 ;; this session.
d73a7bb8
JPW		 1810 (when standard-display-table
1811 (dotimes (i 128)
b221615b 1812 (aset standard-display-table (+ i 128) nil))))
970c9391 1813 (set-terminal-coding-system (or coding-system coding) display)))
40c81f74 1814
166246f7 1815(defun set-language-environment (language-name)
6c05d680
RS		 1816 "Set up multi-lingual environment for using LANGUAGE-NAME.
1817This sets the coding system priority and the default input method
8861c593
RS		 1818and sometimes other things. LANGUAGE-NAME should be a string
1819which is the name of a language environment. For example, \"Latin-1\"
1820specifies the character set for the major languages of Western Europe."
8efc03e1 1821 (interactive (list (read-language-name
ddb5c041 1822 nil
5b76833f 1823 "Set language environment (default English): ")))
4ef06f75
KH		 1824 (if language-name
1825 (if (symbolp language-name)
1826 (setq language-name (symbol-name language-name)))
1827 (setq language-name "English"))
f15466c5 1828 (let ((slot (assoc-string language-name language-info-alist t)))
95498fd0 1829 (unless slot
f850d782 1830 (error "Language environment not defined: %S" language-name))
95498fd0 1831 (setq language-name (car slot)))
8efc03e1
KH		 1832 (if current-language-environment
1833 (let ((func (get-language-info current-language-environment
1834 'exit-function)))
e63645c2 1835 (run-hooks 'exit-language-environment-hook)
5f395df3 1836 (if (functionp func) (funcall func))))
ddb5c041 1837
e9a8ed3c
KH		 1838 (reset-language-environment)
1839 ;; The features might set up coding systems.
ddb5c041
KH		 1840 (let ((required-features (get-language-info language-name 'features)))
1841 (while required-features
1842 (require (car required-features))
1843 (setq required-features (cdr required-features))))
6b61353c 1844
e9a8ed3c
KH		 1845 (setq current-language-environment language-name)
1846
1847 (set-language-environment-coding-systems language-name)
1848 (set-language-environment-input-method language-name)
1849 (set-language-environment-nonascii-translation language-name)
1850 (set-language-environment-charset language-name)
1851 ;; Unibyte setups if necessary.
597e2240 1852 (unless (default-value 'enable-multibyte-characters)
e9a8ed3c
KH		 1853 (set-language-environment-unibyte language-name))
1854
ddb5c041 1855 (let ((func (get-language-info language-name 'setup-function)))
5f395df3 1856 (if (functionp func)
ddb5c041 1857 (funcall func)))
e9a8ed3c 1858
8aeebac2 1859 (setq current-iso639-language
e9aaa1db
KH		 1860 (or (get-language-info language-name 'iso639-language)
1861 current-iso639-language))
8aeebac2 1862
8efc03e1 1863 (run-hooks 'set-language-environment-hook)
f850d782 1864 (force-mode-line-update t))
4ed46869 1865
c3869589 1866(define-widget 'charset 'symbol
1644d5b9
DL		 1867 "An Emacs charset."
1868 :tag "Charset"
c3869589
DL		 1869 :complete-function (lambda ()
1870 (interactive)
1871 (lisp-complete-symbol 'charsetp))
1872 :completion-ignore-case t
1873 :value 'ascii
1874 :validate (lambda (widget)
1875 (unless (charsetp (widget-value widget))
1876 (widget-put widget :error (format "Invalid charset: %S"
1877 (widget-value widget)))
1878 widget))
1879 :prompt-history 'charset-history)
1880
1881(defcustom language-info-custom-alist nil
1882 "Customizations of language environment parameters.
1883Value is an alist with elements like those of `language-info-alist'.
1884These are used to set values in `language-info-alist' which replace
1885the defaults. A typical use is replacing the default input method for
1886the environment. Use \\[describe-language-environment] to find the environment's settings.
1887
1888This option is intended for use at startup. Removing items doesn't
1889remove them from the language info until you next restart Emacs.
1890
d0d8885d
JB		 1891Setting this variable directly does not take effect.
1892See `set-language-info-alist' for use in programs."
c3869589 1893 :group 'mule
8589dc17 1894 :version "23.1"
c3869589
DL		 1895 :set (lambda (s v)
1896 (custom-set-default s v)
1897 ;; Can't do this before language environments are set up.
1898 (when v
1899 ;; modify language-info-alist
1900 (dolist (elt v)
1901 (set-language-info-alist (car elt) (cdr elt)))
1902 ;; re-set the environment in case its parameters changed
1903 (set-language-environment current-language-environment)))
1904 :type `(alist
1905 :key-type (string :tag "Language environment"
1906 :completion-ignore-case t
1907 :complete-function widget-string-complete
1908 :completion-alist language-info-alist)
1909 :value-type
1910 (alist :key-type symbol
1911 :options ((documentation string)
1912 (charset (repeat charset))
1913 (sample-text string)
1914 (setup-function function)
1915 (exit-function function)
1916 (coding-system (repeat coding-system))
1917 (coding-priority (repeat coding-system))
1918 (nonascii-translation charset)
1919 (input-method
1920 (string
1921 :completion-ignore-case t
1922 :complete-function widget-string-complete
1923 :completion-alist input-method-alist
1924 :prompt-history input-method-history))
1925 (features (repeat symbol))
1926 (unibyte-display coding-system)))))
1927
aa360da1
GM		 1928(declare-function x-server-vendor "xfns.c" (&optional terminal))
1929(declare-function x-server-version "xfns.c" (&optional terminal))
1930
51a8fc1d
RS		 1931(defun standard-display-european-internal ()
1932 ;; Actually set up direct output of non-ASCII characters.
03c35c83
EZ		 1933 (standard-display-8bit (if (eq window-system 'pc) 128 160) 255)
1934 ;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with
1935 ;; the native font, and codes 160 and 146 stand for something very
1936 ;; different there.
597e2240
GM		 1937 (or (and (eq window-system 'pc) (not (default-value
1938 'enable-multibyte-characters)))
03c35c83 1939 (progn
6b626913
SM		 1940 ;; Most X fonts used to do the wrong thing for latin-1 code 160.
1941 (unless (and (eq window-system 'x)
1942 ;; XFree86 4 has fixed the fonts.
1943 (string= "The XFree86 Project, Inc" (x-server-vendor))
1944 (> (aref (number-to-string (nth 2 (x-server-version))) 0)
1945 ?3))
1946 ;; Make non-line-break space display as a plain space.
1947 (aset standard-display-table 160 [32]))
1492f7ac 1948 ;; Most Windows programs send out apostrophes as \222. Most X fonts
03c35c83 1949 ;; don't contain a character at that position. Map it to the ASCII
5f395df3
SM		 1950 ;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
1951 ;; U+2019, normally from the windows-1252 character set. XFree 4
1952 ;; fonts probably have the appropriate glyph at this position,
1953 ;; so they could use standard-display-8bit. It's better to use a
1954 ;; proper windows-1252 coding system. --fx]
6b626913 1955 (aset standard-display-table 146 [39]))))
03c35c83 1956
e9a8ed3c
KH		 1957(defun set-language-environment-coding-systems (language-name)
1958 "Do various coding system setups for language environment LANGUAGE-NAME."
54b226f7 1959 (let* ((priority (get-language-info language-name 'coding-priority))
e9a8ed3c 1960 (default-coding (car priority))
b56a5ae0 1961 ;; If the default buffer-file-coding-system is nil, don't use
207422da 1962 ;; coding-system-eol-type, because it treats nil as
b56a5ae0 1963 ;; `no-conversion'. The default buffer-file-coding-system is set
207422da
EZ		 1964 ;; to nil by reset-language-environment, and in that case we
1965 ;; want to have here the native EOL type for each platform.
1966 ;; FIXME: there should be a common code that runs both on
1967 ;; startup and here to set the default EOL type correctly.
1968 ;; Right now, DOS/Windows platforms set this on dos-w32.el,
1969 ;; which works only as long as the order of loading files at
1970 ;; dump time and calling functions at startup is not modified
1971 ;; significantly, i.e. as long as this function is called
b56a5ae0 1972 ;; _after_ the default buffer-file-coding-system was set by
207422da
EZ		 1973 ;; dos-w32.el.
1974 (eol-type
b56a5ae0
SM		 1975 (coding-system-eol-type
1976 (or (default-value 'buffer-file-coding-system)
1977 (if (memq system-type '(windows-nt ms-dos)) 'dos 'unix)))))
97941b05
KH		 1978 (when priority
1979 (set-default-coding-systems
1980 (if (memq eol-type '(0 1 2 unix dos mac))
1981 (coding-system-change-eol-conversion default-coding eol-type)
1982 default-coding))
1983 (setq default-sendmail-coding-system default-coding)
1984 (apply 'set-coding-system-priority priority))))
54b226f7 1985
d042f8b4
KH		 1986(defun set-language-environment-input-method (language-name)
1987 "Do various input method setups for language environment LANGUAGE-NAME."
1988 (let ((input-method (get-language-info language-name 'input-method)))
1989 (when input-method
1990 (setq default-input-method input-method)
1991 (if input-method-history
1992 (setq input-method-history
1993 (cons input-method
1994 (delete input-method input-method-history)))))))
1995
1996(defun set-language-environment-nonascii-translation (language-name)
1997 "Do unibyte/multibyte translation setup for language environment LANGUAGE-NAME."
e9a8ed3c
KH		 1998 ;; Note: For DOS, we assumed that the charset cpXXX is already
1999 ;; defined.
2000 (let ((nonascii (get-language-info language-name 'nonascii-translation)))
2001 (if (eq window-system 'pc)
970c9391 2002 (setq nonascii (intern (format "cp%d" dos-codepage))))
e9a8ed3c
KH		 2003 (or (and (charsetp nonascii)
2004 (get-charset-property nonascii :ascii-compatible-p))
2005 (setq nonascii 'iso-8859-1))
33de15f4
SM		 2006 ;; Back in Emacs-20, it was necessary to provide some fallback implicit
2007 ;; conversion, because almost no packages handled coding-system issues.
2008 ;; Nowadays it'd just paper over bugs.
2009 ;; (set-unibyte-charset nonascii)
2010 ))
d042f8b4
KH		 2011
2012(defun set-language-environment-charset (language-name)
2013 "Do various charset setups for language environment LANGUAGE-NAME."
e9a8ed3c
KH		 2014 ;; Put higher priorities to such charsets that are supported by the
2015 ;; coding systems of higher priorities in this environment.
2016 (let ((charsets (get-language-info language-name 'charset)))
2017 (dolist (coding (get-language-info language-name 'coding-priority))
bf974dc9
KH		 2018 (let ((list (coding-system-charset-list coding)))
2019 (if (consp list)
2020 (setq charsets (append charsets list)))))
e9a8ed3c
KH		 2021 (if charsets
2022 (apply 'set-charset-priority charsets))))
d042f8b4
KH		 2023
2024(defun set-language-environment-unibyte (language-name)
2025 "Do various unibyte-mode setups for language environment LANGUAGE-NAME."
d042f8b4
KH		 2026 (set-display-table-and-terminal-coding-system language-name))
2027
4ed46869 2028(defsubst princ-list (&rest args)
caff3c0a 2029 "Print all arguments with `princ', then print \"\\n\"."
4ed46869
KH		 2030 (while args (princ (car args)) (setq args (cdr args)))
2031 (princ "\n"))
2032
b0648a00
RS		 2033(put 'describe-specified-language-support 'apropos-inhibit t)
2034
6b61353c 2035;; Print language-specific information such as input methods,
13e82c04 2036;; charsets, and coding systems. This function is intended to be
48082651 2037;; called from the menu:
281d03ec 2038;; [menu-bar mule describe-language-environment LANGUAGE]
48082651
KH		 2039;; and should not run it by `M-x describe-current-input-method-function'.
2040(defun describe-specified-language-support ()
96db204a 2041 "Describe how Emacs supports the specified language environment."
48082651 2042 (interactive)
281d03ec 2043 (let (language-name)
48082651 2044 (if (not (and (symbolp last-command-event)
cda74479
DL		 2045 (or (not (eq last-command-event 'Default))
2046 (setq last-command-event 'English))
281d03ec 2047 (setq language-name (symbol-name last-command-event))))
48082651 2048 (error "Bogus calling sequence"))
281d03ec
RS		 2049 (describe-language-environment language-name)))
2050
2051(defun describe-language-environment (language-name)
2052 "Describe how Emacs supports language environment LANGUAGE-NAME."
78754934
KH		 2053 (interactive
2054 (list (read-language-name
2055 'documentation
5b76833f 2056 "Describe language environment (default current choice): ")))
f850d782
RS		 2057 (if (null language-name)
2058 (setq language-name current-language-environment))
281d03ec
RS		 2059 (if (or (null language-name)
2060 (null (get-language-info language-name 'documentation)))
2061 (error "No documentation for the specified language"))
4ef06f75
KH		 2062 (if (symbolp language-name)
2063 (setq language-name (symbol-name language-name)))
ef5a4730
KH		 2064 (dolist (feature (get-language-info language-name 'features))
2065 (require feature))
6b626913 2066 (let ((doc (get-language-info language-name 'documentation)))
c3034e84
SM		 2067 (help-setup-xref (list #'describe-language-environment language-name)
2068 (interactive-p))
2069 (with-output-to-temp-buffer (help-buffer)
464cc130
KH		 2070 (save-excursion
2071 (set-buffer standard-output)
2072 (insert language-name " language environment\n\n")
2073 (if (stringp doc)
2074 (insert doc "\n\n"))
e036b0a6
KH		 2075 (condition-case nil
2076 (let ((str (eval (get-language-info language-name 'sample-text))))
2077 (if (stringp str)
fd0dd4c3
KH		 2078 (insert "Sample text:\n "
2079 (replace-regexp-in-string "\n" "\n " str)
2080 "\n\n")))
e036b0a6 2081 (error nil))
464cc130 2082 (let ((input-method (get-language-info language-name 'input-method))
acd1b9bd
KH		 2083 (l (copy-sequence input-method-alist))
2084 (first t))
2085 (when (and input-method
2086 (setq input-method (assoc input-method l)))
2087 (insert "Input methods (default " (car input-method) ")\n")
2088 (setq l (cons input-method (delete input-method l))
2089 first nil))
2090 (dolist (elt l)
2091 (when (or (eq input-method elt)
2092 (eq t (compare-strings language-name nil nil
2093 (nth 1 elt) nil nil t)))
2094 (when first
2095 (insert "Input methods:\n")
2096 (setq first nil))
2097 (insert " " (car elt))
2098 (search-backward (car elt))
2099 (help-xref-button 0 'help-input-method (car elt))
464cc130 2100 (goto-char (point-max))
2fa7e202 2101 (insert " (\""
acd1b9bd
KH		 2102 (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
2103 "\" in mode line)\n")))
2104 (or first
2105 (insert "\n")))
464cc130
KH		 2106 (insert "Character sets:\n")
2107 (let ((l (get-language-info language-name 'charset)))
2108 (if (null l)
2109 (insert " nothing specific to " language-name "\n")
2110 (while l
2111 (insert " " (symbol-name (car l)))
2112 (search-backward (symbol-name (car l)))
467412aa 2113 (help-xref-button 0 'help-character-set (car l))
464cc130
KH		 2114 (goto-char (point-max))
2115 (insert ": " (charset-description (car l)) "\n")
2116 (setq l (cdr l)))))
2117 (insert "\n")
2118 (insert "Coding systems:\n")
2119 (let ((l (get-language-info language-name 'coding-system)))
2120 (if (null l)
2121 (insert " nothing specific to " language-name "\n")
2122 (while l
2123 (insert " " (symbol-name (car l)))
2124 (search-backward (symbol-name (car l)))
467412aa 2125 (help-xref-button 0 'help-coding-system (car l))
464cc130
KH		 2126 (goto-char (point-max))
2127 (insert " (`"
2128 (coding-system-mnemonic (car l))
2129 "' in mode line):\n\t"
2130 (coding-system-doc-string (car l))
2131 "\n")
0855c6cd 2132 (let ((aliases (coding-system-aliases (car l))))
464cc130
KH		 2133 (when aliases
2134 (insert "\t(alias:")
2135 (while aliases
2136 (insert " " (symbol-name (car aliases)))
2137 (setq aliases (cdr aliases)))
2138 (insert ")\n")))
c3034e84 2139 (setq l (cdr l)))))))))
4ed46869 2140\f
40c81f74
PE		 2141;;; Locales.
2142
0d7c5bb9
DL		 2143(defvar locale-translation-file-name nil
2144 "File name for the system's file of locale-name aliases, or nil if none.")
40c81f74 2145
5f395df3
SM		 2146;; The following definitions might as well be marked as constants and
2147;; purecopied, since they're normally used on startup, and probably
2148;; should reflect the facilities of the base Emacs.
2149(defconst locale-language-names
2150 (purecopy
2151 '(
40c81f74
PE		 2152 ;; Locale names of the form LANGUAGE[_TERRITORY][.CODESET][@MODIFIER]
2153 ;; as specified in the Single Unix Spec, Version 2.
2154 ;; LANGUAGE is a language code taken from ISO 639:1988 (E/F)
2155 ;; with additions from ISO 639/RA Newsletter No.1/1989;
5f395df3
SM		 2156 ;; see Internet RFC 2165 (1997-06) and
2157 ;; http://www.evertype.com/standards/iso639/iso639-en.html
2158 ;; TERRITORY is a country code taken from ISO 3166
2159 ;; http://www.din.de/gremien/nas/nabd/iso3166ma/codlstp1/en_listp1.html.
40c81f74 2160 ;; CODESET and MODIFIER are implementation-dependent.
5f395df3 2161
6b61353c
KH		 2162 ;; jasonr comments: MS Windows uses three letter codes for
2163 ;; languages instead of the two letter ISO codes that POSIX
2164 ;; uses. In most cases the first two letters are the same, so
2165 ;; most of the regexps in locale-language-names work. Japanese
2166 ;; and Chinese are exceptions, which are listed in the
2167 ;; non-standard section at the bottom of locale-language-names.
2168
8dedddd5
KH		 2169 ("aa_DJ" . "Latin-1") ; Afar
2170 ("aa" . "UTF-8")
2171 ;; ab Abkhazian
6ececc4d 2172 ("af" . "Latin-1") ; Afrikaans
8dedddd5
KH		 2173 ("am" "Ethiopic" utf-8) ; Amharic
2174 ("an" . "Latin-9") ; Aragonese
5f395df3 2175 ; ar Arabic glibc uses 8859-6
40c81f74
PE		 2176 ; as Assamese
2177 ; ay Aymara
8dedddd5 2178 ("az" . "UTF-8") ; Azerbaijani
40c81f74 2179 ; ba Bashkir
8dedddd5
KH		 2180 ("be" "Belarusian" cp1251) ; Belarusian [Byelorussian until early 1990s]
2181 ("bg" "Bulgarian" cp1251) ; Bulgarian
40c81f74
PE		 2182 ; bh Bihari
2183 ; bi Bislama
8dedddd5 2184 ("bn" . "UTF-8") ; Bengali, Bangla
40c81f74
PE		 2185 ("bo" . "Tibetan")
2186 ("br" . "Latin-1") ; Breton
d37ef0f6 2187 ("bs" . "Latin-2") ; Bosnian
8dedddd5 2188 ("byn" . "UTF-8") ; Bilin; Blin
40c81f74
PE		 2189 ("ca" . "Latin-1") ; Catalan
2190 ; co Corsican
8dedddd5
KH		 2191 ("cs" "Czech" iso-8859-2)
2192 ("cy" "Welsh" iso-8859-14)
40c81f74 2193 ("da" . "Latin-1") ; Danish
8dedddd5 2194 ("de" "German" iso-8859-1)
569a6374 2195 ; dv Divehi
40c81f74 2196 ; dz Bhutani
8dedddd5 2197 ("el" "Greek" iso-8859-7)
6ececc4d 2198 ;; Users who specify "en" explicitly typically want Latin-1, not ASCII.
e11cf111
DL		 2199 ;; That's actually what the GNU locales define, modulo things like
2200 ;; en_IN -- fx.
8dedddd5 2201 ("en_IN" "English" utf-8) ; glibc uses utf-8 for English in India
eec5c8f9 2202 ("en" "English" iso-8859-1) ; English
58802cd7 2203 ("eo" . "Esperanto") ; Esperanto
8dedddd5
KH		 2204 ("es" "Spanish" iso-8859-1)
2205 ("et" . "Latin-1") ; Estonian
40c81f74 2206 ("eu" . "Latin-1") ; Basque
8dedddd5 2207 ("fa" . "UTF-8") ; Persian
40c81f74 2208 ("fi" . "Latin-1") ; Finnish
8dedddd5 2209 ("fj" . "Latin-1") ; Fiji
40c81f74 2210 ("fo" . "Latin-1") ; Faroese
8dedddd5 2211 ("fr" "French" iso-8859-1) ; French
40c81f74 2212 ("fy" . "Latin-1") ; Frisian
6ececc4d 2213 ("ga" . "Latin-1") ; Irish Gaelic (new orthography)
8dedddd5
KH		 2214 ("gd" . "Latin-9") ; Scots Gaelic
2215 ("gez" "Ethiopic" utf-8) ; Geez
2216 ("gl" . "Latin-1") ; Gallegan; Galician
40c81f74 2217 ; gn Guarani
8dedddd5
KH		 2218 ("gu" . "UTF-8") ; Gujarati
2219 ("gv" . "Latin-1") ; Manx Gaelic
40c81f74 2220 ; ha Hausa
8dedddd5
KH		 2221 ("he" "Hebrew" iso-8859-8)
2222 ("hi" "Devanagari" utf-8) ; Hindi
2223 ("hr" "Croatian" iso-8859-2) ; Croatian
40c81f74
PE		 2224 ("hu" . "Latin-2") ; Hungarian
2225 ; hy Armenian
2226 ; ia Interlingua
2227 ("id" . "Latin-1") ; Indonesian
2228 ; ie Interlingue
2229 ; ik Inupiak
2230 ("is" . "Latin-1") ; Icelandic
8dedddd5 2231 ("it" "Italian" iso-8859-1) ; Italian
40c81f74 2232 ; iu Inuktitut
8dedddd5
KH		 2233 ("iw" "Hebrew" iso-8859-8)
2234 ("ja" "Japanese" euc-jp)
40c81f74 2235 ; jw Javanese
8dedddd5 2236 ("ka" "Georgian" georgian-ps) ; Georgian
40c81f74 2237 ; kk Kazakh
6ececc4d 2238 ("kl" . "Latin-1") ; Greenlandic
40c81f74 2239 ; km Cambodian
8dedddd5
KH		 2240 ("kn" "Kannada" utf-8)
2241 ("ko" "Korean" euc-kr)
40c81f74
PE		 2242 ; ks Kashmiri
2243 ; ku Kurdish
5f395df3 2244 ("kw" . "Latin-1") ; Cornish
40c81f74
PE		 2245 ; ky Kirghiz
2246 ("la" . "Latin-1") ; Latin
5f395df3 2247 ("lb" . "Latin-1") ; Luxemburgish
8dedddd5 2248 ("lg" . "Laint-6") ; Ganda
40c81f74 2249 ; ln Lingala
8dedddd5
KH		 2250 ("lo" "Lao" utf-8) ; Laothian
2251 ("lt" "Lithuanian" iso-8859-13)
9c20a8d5 2252 ("lv" . "Latvian") ; Latvian, Lettish
40c81f74 2253 ; mg Malagasy
5f395df3 2254 ("mi" . "Latin-7") ; Maori
8dedddd5
KH		 2255 ("mk" "Cyrillic-ISO" iso-8859-5) ; Macedonian
2256 ("ml" "Malayalam" utf-8)
2257 ("mn" . "UTF-8") ; Mongolian
40c81f74 2258 ; mo Moldavian
8dedddd5 2259 ("mr" "Devanagari" utf-8) ; Marathi
5f395df3 2260 ("ms" . "Latin-1") ; Malay
40c81f74
PE		 2261 ("mt" . "Latin-3") ; Maltese
2262 ; my Burmese
2263 ; na Nauru
8dedddd5
KH		 2264 ("nb" . "Latin-1") ; Norwegian
2265 ("ne" "Devanagari" utf-8) ; Nepali
2266 ("nl" "Dutch" iso-8859-1)
40c81f74 2267 ("no" . "Latin-1") ; Norwegian
5f395df3 2268 ("oc" . "Latin-1") ; Occitan
8dedddd5
KH		 2269 ("om_ET" . "UTF-8") ; (Afan) Oromo
2270 ("om" . "Latin-1") ; (Afan) Oromo
40c81f74 2271 ; or Oriya
8dedddd5 2272 ("pa" . "UTF-8") ; Punjabi
40c81f74
PE		 2273 ("pl" . "Latin-2") ; Polish
2274 ; ps Pashto, Pushto
2275 ("pt" . "Latin-1") ; Portuguese
2276 ; qu Quechua
6ececc4d 2277 ("rm" . "Latin-1") ; Rhaeto-Romanic
40c81f74 2278 ; rn Kirundi
8dedddd5
KH		 2279 ("ro" "Romanian" iso-8859-2)
2280 ("ru_RU" "Russian" iso-8859-5)
2281 ("ru_UA" "Russian" koi8-u)
40c81f74
PE		 2282 ; rw Kinyarwanda
2283 ("sa" . "Devanagari") ; Sanskrit
2284 ; sd Sindhi
8dedddd5 2285 ("se" . "UTF-8") ; Northern Sami
40c81f74
PE		 2286 ; sg Sangho
2287 ("sh" . "Latin-2") ; Serbo-Croatian
2288 ; si Sinhalese
8dedddd5
KH		 2289 ("sid" . "UTF-8") ; Sidamo
2290 ("sk" "Slovak" iso-8859-2)
2291 ("sl" "Slovenian" iso-8859-2)
40c81f74
PE		 2292 ; sm Samoan
2293 ; sn Shona
8dedddd5
KH		 2294 ("so_ET" "UTF-8") ; Somali
2295 ("so" "Latin-1") ; Somali
6ececc4d 2296 ("sq" . "Latin-1") ; Albanian
40c81f74
PE		 2297 ("sr" . "Latin-2") ; Serbian (Latin alphabet)
2298 ; ss Siswati
8dedddd5 2299 ("st" . "Latin-1") ; Sesotho
40c81f74 2300 ; su Sundanese
8dedddd5 2301 ("sv" "Swedish" iso-8859-1) ; Swedish
40c81f74 2302 ("sw" . "Latin-1") ; Swahili
8dedddd5
KH		 2303 ("ta" "Tamil" utf-8)
2304 ("te" . "UTF-8") ; Telugu
2305 ("tg" "Tajik" koi8-t)
2306 ("th" "Thai" tis-620)
2307 ("ti" "Ethiopic" utf-8) ; Tigrinya
2308 ("tig_ER" . "UTF-8") ; Tigre
40c81f74 2309 ; tk Turkmen
6ececc4d 2310 ("tl" . "Latin-1") ; Tagalog
40c81f74
PE		 2311 ; tn Setswana
2312 ; to Tonga
8dedddd5 2313 ("tr" "Turkish" iso-8859-9)
40c81f74 2314 ; ts Tsonga
8dedddd5 2315 ("tt" . "UTF-8") ; Tatar
40c81f74
PE		 2316 ; tw Twi
2317 ; ug Uighur
8dedddd5
KH		 2318 ("uk" "Ukrainian" koi8-u)
2319 ("ur" . "UTF-8") ; Urdu
2320 ("uz_UZ@cyrillic" . "UTF-8"); Uzbek
5f395df3 2321 ("uz" . "Latin-1") ; Uzbek
8dedddd5 2322 ("vi" "Vietnamese" utf-8)
40c81f74 2323 ; vo Volapuk
d37ef0f6 2324 ("wa" . "Latin-1") ; Walloon
40c81f74 2325 ; wo Wolof
8dedddd5 2326 ("xh" . "Latin-1") ; Xhosa
9c20a8d5 2327 ("yi" . "Windows-1255") ; Yiddish
40c81f74
PE		 2328 ; yo Yoruba
2329 ; za Zhuang
8dedddd5 2330 ("zh_HK" . "Chinese-Big5")
05b81b42 2331 ; zh_HK/BIG5-HKSCS \
8dedddd5 2332 ("zh_TW" . "Chinese-Big5")
05b81b42
KH		 2333 ("zh_CN.GB2312" "Chinese-GB")
2334 ("zh_CN.GBK" "Chinese-GBK")
2335 ("zh_CN.GB18030" "Chinese-GB18030")
f21605fa 2336 ("zh_CN.UTF-8" . "Chinese-GBK")
8dedddd5 2337 ("zh_CN" . "Chinese-GB")
40c81f74 2338 ("zh" . "Chinese-GB")
8dedddd5 2339 ("zu" . "Latin-1") ; Zulu
40c81f74
PE		 2340
2341 ;; ISO standard locales
2342 ("c$" . "ASCII")
2343 ("posix$" . "ASCII")
2344
40c81f74
PE		 2345 ;; The "IPA" Emacs language environment does not correspond
2346 ;; to any ISO 639 code, so let it stand for itself.
2347 ("ipa$" . "IPA")
2348
2349 ;; Nonstandard or obsolete language codes
2350 ("cz" . "Czech") ; e.g. Solaris 2.6
2351 ("ee" . "Latin-4") ; Estonian, e.g. X11R6.4
2352 ("iw" . "Hebrew") ; e.g. X11R6.4
f1282c7f 2353 ("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4
40c81f74 2354 ("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6
2e86ceaa 2355 ("jp" . "Japanese") ; e.g. MS Windows
f21605fa 2356 ("chs" . "Chinese-GBK") ; MS Windows Chinese Simplified
86d9e628 2357 ("cht" . "Chinese-BIG5") ; MS Windows Chinese Traditional
569a6374
EZ		 2358 ("gbz" . "UTF-8") ; MS Windows Dari Persian
2359 ("div" . "UTF-8") ; MS Windows Divehi (Maldives)
2360 ("wee" . "Latin-2") ; MS Windows Lower Sorbian
2361 ("wen" . "Latin-2") ; MS Windows Upper Sorbian
367ca50f 2362 ))
8dedddd5 2363 "Alist of locale regexps vs the corresponding languages and coding systems.
caff3c0a 2364Each element has this form:
8dedddd5
KH		 2365 \(LOCALE-REGEXP LANG-ENV CODING-SYSTEM)
2366The first element whose LOCALE-REGEXP matches the start of a
caff3c0a 2367downcased locale specifies the LANG-ENV \(language environment)
8dedddd5
KH		 2368and CODING-SYSTEM corresponding to that locale. If there is no
2369appropriate language environment, the element may have this form:
2370 \(LOCALE-REGEXP . LANG-ENV)
2371In this case, LANG-ENV is one of generic language environments for an
2372specific encoding such as \"Latin-1\" and \"UTF-8\".")
40c81f74 2373
5f395df3
SM		 2374(defconst locale-charset-language-names
2375 (purecopy
2376 '((".*8859[-_]?1\\>" . "Latin-1")
2377 (".*8859[-_]?2\\>" . "Latin-2")
2378 (".*8859[-_]?3\\>" . "Latin-3")
2379 (".*8859[-_]?4\\>" . "Latin-4")
2380 (".*8859[-_]?9\\>" . "Latin-5")
2381 (".*8859[-_]?14\\>" . "Latin-8")
2382 (".*8859[-_]?15\\>" . "Latin-9")
6b61353c
KH		 2383 (".*utf\\(?:-?8\\)?\\>" . "UTF-8")
2384 ;; utf-8@euro exists, so put this last. (@euro really specifies
2385 ;; the currency, rather than the charset.)
e522f07b 2386 (".*@euro\\>" . "Latin-9")))
6ececc4d
PE		 2387 "List of pairs of locale regexps and charset language names.
2388The first element whose locale regexp matches the start of a downcased locale
6b61353c 2389specifies the language name whose charset corresponds to that locale.
8dedddd5 2390This language name is used if the locale is not listed in
caff3c0a 2391`locale-language-names'.")
6ececc4d 2392
5f395df3
SM		 2393(defconst locale-preferred-coding-systems
2394 (purecopy
8dedddd5
KH		 2395 '((".*8859[-_]?1\\>" . iso-8859-1)
2396 (".*8859[-_]?2\\>" . iso-8859-2)
2397 (".*8859[-_]?3\\>" . iso-8859-3)
2398 (".*8859[-_]?4\\>" . iso-8859-4)
2399 (".*8859[-_]?9\\>" . iso-8859-9)
2400 (".*8859[-_]?14\\>" . iso-8859-14)
2401 (".*8859[-_]?15\\>" . iso-8859-15)
2402 (".*utf\\(?:-?8\\)?" . utf-8)
2403 ;; utf-8@euro exists, so put this after utf-8. (@euro really
2404 ;; specifies the currency, rather than the charset.)
2405 (".*@euro" . iso-8859-15)
2406 ("koi8-?r" . koi8-r)
2407 ("koi8-?u" . koi8-u)
2408 ("tcvn" . tcvn)
38c05d07 2409 ("big5[-_]?hkscs" . big5-hkscs)
8dedddd5
KH		 2410 ("big5" . big5)
2411 ("euc-?tw" . euc-tw)
d6be7497 2412 ("euc-?cn" . euc-cn)
38c05d07
KH		 2413 ("gb2312" . gb2312)
2414 ("gbk" . gbk)
2415 ("gb18030" . gb18030)
8dedddd5 2416 ("ja.*[._]euc" . japanese-iso-8bit)
5f395df3
SM		 2417 ("ja.*[._]jis7" . iso-2022-jp)
2418 ("ja.*[._]pck" . japanese-shift-jis)
2419 ("ja.*[._]sjis" . japanese-shift-jis)
69210880 2420 ("jpn" . japanese-shift-jis) ; MS-Windows uses this.
8dedddd5 2421 ))
6ececc4d
PE		 2422 "List of pairs of locale regexps and preferred coding systems.
2423The first element whose locale regexp matches the start of a downcased locale
8dedddd5
KH		 2424specifies the coding system to prefer when using that locale.
2425This coding system is used if the locale specifies a specific charset.")
40c81f74
PE		 2426
2427(defun locale-name-match (key alist)
2428 "Search for KEY in ALIST, which should be a list of regexp-value pairs.
2429Return the value corresponding to the first regexp that matches the
2430start of KEY, or nil if there is no match."
2431 (let (element)
2432 (while (and alist (not element))
d0d8885d 2433 (if (string-match-p (concat "\\`\\(?:" (car (car alist)) "\\)") key)
40c81f74
PE		 2434 (setq element (car alist)))
2435 (setq alist (cdr alist)))
2436 (cdr element)))
2437
58b78d5b 2438(defun locale-charset-match-p (charset1 charset2)
91ed0599 2439 "Whether charset names (strings) CHARSET1 and CHARSET2 are equivalent.
58b78d5b
DL		 2440Matching is done ignoring case and any hyphens and underscores in the
2441names. E.g. `ISO_8859-1' and `iso88591' both match `iso-8859-1'."
2442 (setq charset1 (replace-regexp-in-string "[-_]" "" charset1))
2443 (setq charset2 (replace-regexp-in-string "[-_]" "" charset2))
2444 (eq t (compare-strings charset1 nil nil charset2 nil nil t)))
2445
6b61353c
KH		 2446(defvar locale-charset-alist nil
2447 "Coding system alist keyed on locale-style charset name.
2448Used by `locale-charset-to-coding-system'.")
2449
2450(defun locale-charset-to-coding-system (charset)
2451 "Find coding system corresponding to CHARSET.
2452CHARSET is any sort of non-Emacs charset name, such as might be used
2453in a locale codeset, or elsewhere. It is matched to a coding system
2454first by case-insensitive lookup in `locale-charset-alist'. Then
2455matches are looked for in the coding system list, treating case and
2456the characters `-' and `_' as insignificant. The coding system base
2457is returned. Thus, for instance, if charset \"ISO8859-2\",
2458`iso-latin-2' is returned."
f15466c5 2459 (or (car (assoc-string charset locale-charset-alist t))
6b61353c
KH		 2460 (let ((cs coding-system-alist)
2461 c)
2462 (while (and (not c) cs)
2463 (if (locale-charset-match-p charset (caar cs))
2464 (setq c (intern (caar cs)))
2465 (pop cs)))
2466 (if c (coding-system-base c)))))
2467
2468;; Fixme: This ought to deal with the territory part of the locale
2469;; too, for setting things such as calendar holidays, ps-print paper
2470;; size, spelling dictionary.
2471
44ee1bdf
GM		 2472(defun locale-translate (locale)
2473 "Expand LOCALE according to `locale-translation-file-name', if possible.
2474For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."
2475 (if locale-translation-file-name
2476 (with-temp-buffer
2477 (set-buffer-multibyte nil)
2478 (insert-file-contents locale-translation-file-name)
2479 (if (re-search-forward
2480 (concat "^" (regexp-quote locale) ":?[ \t]+") nil t)
2481 (buffer-substring (point) (line-end-position))
2482 locale))
2483 locale))
2484
36ab8612 2485(defun set-locale-environment (&optional locale-name frame)
40c81f74 2486 "Set up multi-lingual environment for using LOCALE-NAME.
758f07de
RS		 2487This sets the language environment, the coding system priority,
2488the default input method and sometimes other things.
2489
58b78d5b 2490LOCALE-NAME should be a string which is the name of a locale supported
6b61353c 2491by the system. Often it is of the form xx_XX.CODE, where xx is a
58b78d5b
DL		 2492language, XX is a country, and CODE specifies a character set and
2493coding system. For example, the locale name \"ja_JP.EUC\" might name
2494a locale for Japanese in Japan using the `japanese-iso-8bit'
2495coding-system. The name may also have a modifier suffix, e.g. `@euro'
2496or `@cyrillic'.
40c81f74 2497
758f07de 2498If LOCALE-NAME is nil, its value is taken from the environment
d37ef0f6 2499variables LC_ALL, LC_CTYPE and LANG (the first one that is set).
40c81f74
PE		 2500
2501The locale names supported by your system can typically be found in a
0812c1e8 2502directory named `/usr/share/locale' or `/usr/lib/locale'. LOCALE-NAME
758f07de 2503will be translated according to the table specified by
0812c1e8
DL		 2504`locale-translation-file-name'.
2505
36ab8612
MB		 2506If FRAME is non-nil, only set the keyboard coding system and the
2507terminal coding system for the terminal of that frame, and don't
2508touch session-global parameters like the language environment.
97c57fb2 2509
0812c1e8
DL		 2510See also `locale-charset-language-names', `locale-language-names',
2511`locale-preferred-coding-systems' and `locale-coding-system'."
758f07de 2512 (interactive "sSet environment for locale: ")
a1506d29 2513
0d7c5bb9
DL		 2514 ;; Do this at runtime for the sake of binaries possibly transported
2515 ;; to a system without X.
2516 (setq locale-translation-file-name
2517 (let ((files
6bba8c70
KH		 2518 '("/usr/share/X11/locale/locale.alias" ; e.g. X11R7
2519 "/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4
6b61353c 2520 "/usr/X11R6/lib/X11/locale/locale.alias" ; XFree86, e.g. RedHat 4.2
0d7c5bb9
DL		 2521 "/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6
2522 ;;
2523 ;; The following name appears after the X-related names above,
2524 ;; since the X-related names are what X actually uses.
2525 "/usr/share/locale/locale.alias" ; GNU/Linux sans X
2526 )))
2527 (while (and files (not (file-exists-p (car files))))
2528 (setq files (cdr files)))
2529 (car files)))
2530
7008ccac
GM		 2531 (let ((locale locale-name))
2532
2533 (unless locale
2534 ;; Use the first of these three environment variables
2535 ;; that has a nonempty value.
2536 (let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
db6bd804
DL		 2537 (while (and vars
2538 (= 0 (length locale))) ; nil or empty string
36ab8612 2539 (setq locale (getenv (pop vars) frame)))))
7008ccac
GM		 2540
2541 (when locale
44ee1bdf 2542 (setq locale (locale-translate locale))
7008ccac
GM		 2543
2544 ;; Leave the system locales alone if the caller did not specify
2545 ;; an explicit locale name, as their defaults are set from
2546 ;; LC_MESSAGES and LC_TIME, not LC_CTYPE, and the user might not
2547 ;; want to set them to the same value as LC_CTYPE.
2548 (when locale-name
2549 (setq system-messages-locale locale)
e9aaa1db
KH		 2550 (setq system-time-locale locale))
2551
2552 (if (string-match "^[a-z][a-z]" locale)
2553 (setq current-iso639-language (intern (match-string 0 locale)))))
7008ccac 2554
44ee1bdf
GM		 2555 (setq woman-locale
2556 (or system-messages-locale
739b7764 2557 (let ((msglocale (getenv "LC_MESSAGES" frame)))
44ee1bdf
GM		 2558 (if (zerop (length msglocale))
2559 locale
2560 (locale-translate msglocale)))))
2561
2562 (when locale
7008ccac
GM		 2563 (setq locale (downcase locale))
2564
2565 (let ((language-name
2566 (locale-name-match locale locale-language-names))
2567 (charset-language-name
2568 (locale-name-match locale locale-charset-language-names))
cdb1af30 2569 (default-eol-type (coding-system-eol-type
b56a5ae0 2570 (default-value 'buffer-file-coding-system)))
7008ccac 2571 (coding-system
6b61353c
KH		 2572 (or (locale-name-match locale locale-preferred-coding-systems)
2573 (when locale
2574 (if (string-match "\\.\\([^@]+\\)" locale)
2575 (locale-charset-to-coding-system
9e2a2647 2576 (match-string 1 locale)))))))
7008ccac 2577
8dedddd5
KH		 2578 (if (consp language-name)
2579 ;; locale-language-names specify both lang-env and coding.
2580 ;; But, what specified in locale-preferred-coding-systems
2581 ;; has higher priority.
2582 (setq coding-system (or coding-system
2583 (nth 1 language-name))
2584 language-name (car language-name))
2585 ;; Otherwise, if locale is not listed in locale-language-names,
2586 ;; use what listed in locale-charset-language-names.
2587 (if (not language-name)
2588 (setq language-name charset-language-name)))
7008ccac 2589
cdb1af30
EZ		 2590 ;; If a specific EOL conversion was specified in the default
2591 ;; buffer-file-coding-system, preserve it in the coding system
2592 ;; we will be using from now on.
8bca692e
EZ		 2593 (if (and (memq default-eol-type '(0 1 2 unix dos mac))
2594 coding-system
2595 (coding-system-p coding-system))
cdb1af30
EZ		 2596 (setq coding-system (coding-system-change-eol-conversion
2597 coding-system default-eol-type)))
2598
7008ccac
GM		 2599 (when language-name
2600
2601 ;; Set up for this character set. This is now the right way
2602 ;; to do it for both unibyte and multibyte modes.
36ab8612 2603 (unless frame
97c57fb2 2604 (set-language-environment language-name))
7008ccac 2605
597e2240 2606 ;; If the default enable-multibyte-characters is nil,
7008ccac
GM		 2607 ;; we are using single-byte characters,
2608 ;; so the display table and terminal coding system are irrelevant.
597e2240 2609 (when (default-value 'enable-multibyte-characters)
ff76e074 2610 (set-display-table-and-terminal-coding-system
36ab8612 2611 language-name coding-system frame))
7008ccac 2612
166ce29f
DL		 2613 ;; Set the `keyboard-coding-system' if appropriate (tty
2614 ;; only). At least X and MS Windows can generate
2615 ;; multilingual input.
68bba4e4 2616 ;; XXX This was disabled unless `window-system', but that
fffa137c 2617 ;; leads to buggy behavior when a tty frame is opened
68bba4e4
KL		 2618 ;; later. Setting the keyboard coding system has no adverse
2619 ;; effect on X, so let's do it anyway. -- Lorentey
2620 (let ((kcs (or coding-system
2621 (car (get-language-info language-name
2622 'coding-system)))))
36ab8612 2623 (if kcs (set-keyboard-coding-system kcs frame)))
dc2be2fa 2624
36ab8612 2625 (unless frame
97c57fb2
KL		 2626 (setq locale-coding-system
2627 (car (get-language-info language-name 'coding-priority)))))
7008ccac 2628
36ab8612 2629 (when (and (not frame)
97c57fb2 2630 coding-system
8dedddd5
KH		 2631 (not (coding-system-equal coding-system
2632 locale-coding-system)))
7008ccac 2633 (prefer-coding-system coding-system)
218e7ce3
KH		 2634 ;; Fixme: perhaps prefer-coding-system should set this too.
2635 ;; But it's not the time to do such a fundamental change.
2636 (setq default-sendmail-coding-system coding-system)
80e3310b 2637 (setq locale-coding-system coding-system))))
e76ef161 2638
52c7f9ee 2639 ;; On Windows, override locale-coding-system,
26245233
JR		 2640 ;; default-file-name-coding-system, keyboard-coding-system,
2641 ;; terminal-coding-system with system codepage.
5eb94383 2642 (when (boundp 'w32-ansi-code-page)
893b49bb
JR		 2643 (let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
2644 (when (coding-system-p code-page-coding)
36ab8612
MB		 2645 (unless frame (setq locale-coding-system code-page-coding))
2646 (set-keyboard-coding-system code-page-coding frame)
d4aa48db 2647 (set-terminal-coding-system code-page-coding frame)
59938af3
EZ		 2648 ;; Set default-file-name-coding-system last, so that Emacs
2649 ;; doesn't try to use cpNNNN when it defines keyboard and
2650 ;; terminal encoding. That's because the above two lines
2651 ;; will want to load code-pages.el, where cpNNNN are
2652 ;; defined; if default-file-name-coding-system were set to
2653 ;; cpNNNN while these two lines run, Emacs will want to use
2654 ;; it for encoding the file name it wants to load. And that
2655 ;; will fail, since cpNNNN is not yet usable until
2656 ;; code-pages.el finishes loading.
2657 (setq default-file-name-coding-system code-page-coding))))
893b49bb 2658
a41118cc 2659 (when (eq system-type 'darwin)
ff76e074
SM		 2660 ;; On Darwin, file names are always encoded in utf-8, no matter
2661 ;; the locale.
2662 (setq default-file-name-coding-system 'utf-8)
2663 ;; Mac OS X's Terminal.app by default uses utf-8 regardless of
2664 ;; the locale.
2665 (when (and (null window-system)
36ab8612 2666 (equal (getenv "TERM_PROGRAM" frame) "Apple_Terminal"))
ff76e074
SM		 2667 (set-terminal-coding-system 'utf-8)
2668 (set-keyboard-coding-system 'utf-8)))
a41118cc 2669
e76ef161 2670 ;; Default to A4 paper if we're not in a C, POSIX or US locale.
3479c806 2671 ;; (See comments in Flocale_info.)
36ab8612 2672 (unless frame
97c57fb2
KL		 2673 (let ((locale locale)
2674 (paper (locale-info 'paper)))
2675 (if paper
2676 ;; This will always be null at the time of writing.
2677 (cond
2678 ((equal paper '(216 279))
2679 (setq ps-paper-type 'letter))
2680 ((equal paper '(210 297))
2681 (setq ps-paper-type 'a4)))
2682 (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
2683 (while (and vars (= 0 (length locale)))
36ab8612 2684 (setq locale (getenv (pop vars) frame))))
97c57fb2
KL		 2685 (when locale
2686 ;; As of glibc 2.2.5, these are the only US Letter locales,
2687 ;; and the rest are A4.
2688 (setq ps-paper-type
2689 (or (locale-name-match locale '(("c$" . letter)
2690 ("posix$" . letter)
2691 (".._us" . letter)
2692 (".._pr" . letter)
2693 (".._ca" . letter)
2694 ("enu$" . letter) ; Windows
2695 ("esu$" . letter)
2696 ("enc$" . letter)
2697 ("frc$" . letter)))
2698 'a4)))))))
e76ef161 2699 nil)
40c81f74 2700\f
16400c32
KH		 2701;;; Character property
2702
2703;; Each element has the form (PROP . TABLE).
2704;; PROP is a symbol representing a character property.
2705;; TABLE is a char-table containing the property value for each character.
2706;; TABLE may be a name of file to load to build a char-table.
2707;; Don't modify this variable directly but use `define-char-code-property'.
2708
2709(defvar char-code-property-alist nil
2710 "Alist of character property name vs char-table containing property values.
2711Internal use only.")
2712
2713(put 'char-code-property-table 'char-table-extra-slots 5)
2714
2715(defun define-char-code-property (name table &optional docstring)
2716 "Define NAME as a character code property given by TABLE.
2717TABLE is a char-table of purpose `char-code-property-table' with
2718these extra slots:
2719 1st: NAME.
2720 2nd: Function to call to get a property value of a character.
caff3c0a 2721 It is called with three arguments CHAR, VAL, and TABLE, where
16400c32
KH		 2722 CHAR is a character, VAL is the value of (aref TABLE CHAR).
2723 3rd: Function to call to put a property value of a character.
2724 It is called with the same arguments as above.
2725 4th: Function to call to get a description string of a property value.
2726 It is called with one argument VALUE, a property value.
2727 5th: Data used by the above functions.
2728
2729TABLE may be a name of file to load to build a char-table. The
2730file should contain a call of `define-char-code-property' with a
2731char-table of the above format as the argument TABLE.
2732
2733TABLE may also be nil, in which case no property value is pre-assigned.
2734
49275d55 2735Optional 3rd argument DOCSTRING is a documentation string of the property.
16400c32
KH		 2736
2737See also the documentation of `get-char-code-property' and
2738`put-char-code-property'."
2739 (or (symbolp name)
2740 (error "Not a symbol: %s" name))
2741 (if (char-table-p table)
2742 (or (and (eq (char-table-subtype table) 'char-code-property-table)
2743 (eq (char-table-extra-slot table 0) name))
2744 (error "Invalid char-table: %s" table))
2745 (or (stringp table)
2746 (error "Not a char-table nor a file name: %s" table)))
2747 (let ((slot (assq name char-code-property-alist)))
2748 (if slot
2749 (setcdr slot table)
2750 (setq char-code-property-alist
2751 (cons (cons name table) char-code-property-alist))))
2752 (put name 'char-code-property-documentation docstring))
4ed46869
KH		 2753
2754(defvar char-code-property-table
2755 (make-char-table 'char-code-property-table)
2756 "Char-table containing a property list of each character code.
16400c32 2757This table is used for properties not listed in `char-code-property-alist'.
4ed46869 2758See also the documentation of `get-char-code-property' and
96db204a 2759`put-char-code-property'.")
4ed46869
KH		 2760
2761(defun get-char-code-property (char propname)
16400c32
KH		 2762 "Return the value of CHAR's PROPNAME property."
2763 (let ((slot (assq propname char-code-property-alist)))
2764 (if slot
2765 (let (table value func)
2766 (if (stringp (cdr slot))
d0d8885d 2767 (load (cdr slot) nil t))
16400c32
KH		 2768 (setq table (cdr slot)
2769 value (aref table char)
2770 func (char-table-extra-slot table 1))
2771 (if (functionp func)
2772 (setq value (funcall func char value table)))
2773 value)
2774 (plist-get (aref char-code-property-table char) propname))))
4ed46869
KH		 2775
2776(defun put-char-code-property (char propname value)
16400c32 2777 "Store CHAR's PROPNAME property with VALUE.
4ed46869 2778It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
16400c32
KH		 2779 (let ((slot (assq propname char-code-property-alist)))
2780 (if slot
2781 (let (table func)
2782 (if (stringp (cdr slot))
d0d8885d 2783 (load (cdr slot) nil t))
16400c32
KH		 2784 (setq table (cdr slot)
2785 func (char-table-extra-slot table 2))
2786 (if (functionp func)
2787 (funcall func char value table)
2788 (aset table char value)))
2789 (let* ((plist (aref char-code-property-table char))
2790 (x (plist-put plist propname value)))
2791 (or (eq x plist)
2792 (aset char-code-property-table char x))))
2793 value))
2794
2795(defun char-code-property-description (prop value)
2796 "Return a description string of character property PROP's value VALUE.
2797If there's no description string for VALUE, return nil."
2798 (let ((slot (assq prop char-code-property-alist)))
2799 (if slot
2800 (let (table func)
2801 (if (stringp (cdr slot))
d0d8885d 2802 (load (cdr slot) nil t))
16400c32
KH		 2803 (setq table (cdr slot)
2804 func (char-table-extra-slot table 3))
2805 (if (functionp func)
2806 (funcall func value))))))
4ed46869 2807
a127b764
KH		 2808\f
2809;; Pretty description of encoded string
2810
2811;; Alist of ISO 2022 control code vs the corresponding mnemonic string.
2812(defvar iso-2022-control-alist
2813 '((?\x1b . "ESC")
2814 (?\x0e . "SO")
2815 (?\x0f . "SI")
2816 (?\x8e . "SS2")
2817 (?\x8f . "SS3")
2818 (?\x9b . "CSI")))
2819
2820(defun encoded-string-description (str coding-system)
2821 "Return a pretty description of STR that is encoded by CODING-SYSTEM."
2822 (setq str (string-as-unibyte str))
993b2a7d 2823 (mapconcat
a6dfc99b 2824 (if (and coding-system (eq (coding-system-type coding-system) 'iso-2022))
993b2a7d
KH		 2825 ;; Try to get a pretty description for ISO 2022 escape sequences.
2826 (function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
695effcc
JL		 2827 (format "#x%02X" x))))
2828 (function (lambda (x) (format "#x%02X" x))))
993b2a7d 2829 str " "))
a127b764 2830
430c6ced 2831(defun encode-coding-char (char coding-system &optional charset)
a127b764 2832 "Encode CHAR by CODING-SYSTEM and return the resulting string.
430c6ced
KH		 2833If CODING-SYSTEM can't safely encode CHAR, return nil.
2834The 3rd optional argument CHARSET, if non-nil, is a charset preferred
2835on encoding."
b529ed1e
KH		 2836 (let* ((str1 (string-as-multibyte (string char)))
2837 (str2 (string-as-multibyte (string char char)))
2838 (found (find-coding-systems-string str1))
a127b764 2839 enc1 enc2 i1 i2)
b529ed1e
KH		 2840 (if (and (consp found)
2841 (eq (car found) 'undecided))
2842 str1
2843 (when (memq (coding-system-base coding-system) found)
2844 ;; We must find the encoded string of CHAR. But, just encoding
2845 ;; CHAR will put extra control sequences (usually to designate
2846 ;; ASCII charset) at the tail if type of CODING is ISO 2022.
2847 ;; To exclude such tailing bytes, we at first encode one-char
2848 ;; string and two-char string, then check how many bytes at the
2849 ;; tail of both encoded strings are the same.
2850
430c6ced
KH		 2851 (when charset
2852 (put-text-property 0 1 'charset charset str1)
2853 (put-text-property 0 2 'charset charset str2))
b529ed1e
KH		 2854 (setq enc1 (encode-coding-string str1 coding-system)
2855 i1 (length enc1)
2856 enc2 (encode-coding-string str2 coding-system)
2857 i2 (length enc2))
2858 (while (and (> i1 0) (= (aref enc1 (1- i1)) (aref enc2 (1- i2))))
2859 (setq i1 (1- i1) i2 (1- i2)))
2860
2861 ;; Now (substring enc1 i1) and (substring enc2 i2) are the same,
2862 ;; and they are the extra control sequences at the tail to
2863 ;; exclude.
2864 (substring enc2 0 i2)))))
a127b764 2865
d2f613a0
DL		 2866;; Backwards compatibility. These might be better with :init-value t,
2867;; but that breaks loadup.
2868(define-minor-mode unify-8859-on-encoding-mode
2869 "Obsolete."
2870 :group 'mule
2871 :global t)
2872(define-minor-mode unify-8859-on-decoding-mode
2873 "Obsolete."
2874 :group 'mule
2875 :global t)
a127b764 2876
7dd42fb1
KH		 2877(defvar nonascii-insert-offset 0 "This variable is obsolete.")
2878(defvar nonascii-translation-table nil "This variable is obsolete.")
2879
838d78d4
JL		 2880(defvar ucs-names nil
2881 "Alist of cached (CHAR-NAME . CHAR-CODE) pairs.")
2882
2883(defun ucs-names ()
2884 "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'."
2885 (or ucs-names
2886 (setq ucs-names
2887 (let (name names)
d0d8885d
JB		 2888 (dotimes-with-progress-reporter (c #xEFFFF)
2889 "Loading Unicode character names..."
838d78d4
JL		 2890 (unless (or
2891 (and (>= c #x3400 ) (<= c #x4dbf )) ; CJK Ideograph Extension A
2892 (and (>= c #x4e00 ) (<= c #x9fff )) ; CJK Ideograph
2893 (and (>= c #xd800 ) (<= c #xfaff )) ; Private/Surrogate
2894 (and (>= c #x20000) (<= c #x2ffff)) ; CJK Ideograph Extension B
2895 )
2896 (if (setq name (get-char-code-property c 'name))
2897 (setq names (cons (cons name c) names)))
2898 (if (setq name (get-char-code-property c 'old-name))
2899 (setq names (cons (cons name c) names)))))
2900 names))))
2901
2902(defvar ucs-completions (lazy-completion-table ucs-completions ucs-names)
2903 "Lazy completion table for completing on Unicode character names.")
bdf66e8d 2904(put 'ucs-completions 'risky-local-variable t)
838d78d4
JL		 2905
2906(defun read-char-by-name (prompt)
2907 "Read a character by its Unicode name or hex number string.
c0a67379
JL		 2908Display PROMPT and read a string that represents a character by its
2909Unicode property `name' or `old-name'. You can type a few of first
2910letters of the Unicode name and use completion. This function also
2911accepts a hexadecimal number of Unicode code point or a number in
2912hash notation, e.g. #o21430 for octal, #x2318 for hex, or #10r8984
2913for decimal. Returns a character as a number."
838d78d4
JL		 2914 (let* ((completion-ignore-case t)
2915 (input (completing-read prompt ucs-completions)))
c0a67379 2916 (cond
d0d8885d 2917 ((string-match-p "^[0-9a-fA-F]+$" input)
c0a67379 2918 (string-to-number input 16))
d0d8885d 2919 ((string-match-p "^#" input)
c0a67379
JL		 2920 (read input))
2921 (t
d6ff002e 2922 (cdr (assoc-string input (ucs-names) t))))))
838d78d4 2923
dcbac02a
JL		 2924(defun ucs-insert (character &optional count inherit)
2925 "Insert COUNT copies of CHARACTER of the given Unicode code point.
c0a67379 2926Interactively, prompts for a Unicode character name or a hex number
dcbac02a
JL		 2927using `read-char-by-name'.
2928The optional third arg INHERIT (non-nil when called interactively),
2929says to inherit text properties from adjoining text, if those
2930properties are sticky."
2931 (interactive
2932 (list (read-char-by-name "Unicode (name or hex): ")
2933 (prefix-numeric-value current-prefix-arg)
2934 t))
2935 (unless count (setq count 1))
2936 (if (stringp character)
2937 (setq character (string-to-number character 16)))
c0a67379 2938 (cond
dcbac02a
JL		 2939 ((not (integerp character))
2940 (error "Not a Unicode character code: %S" character))
2941 ((or (< character 0) (> character #x10FFFF))
2942 (error "Not a Unicode character code: 0x%X" character)))
2943 (if inherit
2944 (dotimes (i count) (insert-and-inherit character))
2945 (dotimes (i count) (insert character))))
cb9e47dd 2946
c0a67379 2947(define-key ctl-x-map "8\r" 'ucs-insert)
a127b764 2948
9ee5b744 2949;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
4ed46869 2950;;; mule-cmds.el ends here
Unnamed repository; edit this file 'description' to name the repository.