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