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