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