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