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