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