Commit | Line | Data |
---|---|---|
60370d40 | 1 | ;;; mule-cmds.el --- commands for mulitilingual environment |
4ed46869 | 2 | |
4ed46869 | 3 | ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
fa526c4a | 4 | ;; Licensed to the Free Software Foundation. |
7008ccac | 5 | ;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. |
97941b05 KH |
6 | ;; Copyright (C) 2001, 2002 |
7 | ;; National Institute of Advanced Industrial Science and Technology (AIST) | |
8 | ;; Registration Number H13PRO009 | |
4ed46869 KH |
9 | |
10 | ;; Keywords: mule, multilingual | |
11 | ||
12 | ;; This file is part of GNU Emacs. | |
13 | ||
14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 | ;; it under the terms of the GNU General Public License as published by | |
16 | ;; the Free Software Foundation; either version 2, or (at your option) | |
17 | ;; any later version. | |
18 | ||
19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
369314dc KH |
25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
26 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
27 | ;; Boston, MA 02111-1307, USA. | |
4ed46869 | 28 | |
60370d40 PJ |
29 | ;;; Commentary: |
30 | ||
4ed46869 KH |
31 | ;;; Code: |
32 | ||
cda74479 DL |
33 | (eval-when-compile (defvar dos-codepage)) |
34 | ||
4ed46869 KH |
35 | ;;; MULE related key bindings and menus. |
36 | ||
0709d285 | 37 | (defvar mule-keymap (make-sparse-keymap) |
33d17698 | 38 | "Keymap for Mule (Multilingual environment) specific commands.") |
4ed46869 | 39 | |
8f81f784 | 40 | ;; Keep "C-x C-m ..." for mule specific commands. |
0709d285 | 41 | (define-key ctl-x-map "\C-m" mule-keymap) |
ef8a8c8c | 42 | |
4ed46869 KH |
43 | (define-key mule-keymap "f" 'set-buffer-file-coding-system) |
44 | (define-key mule-keymap "t" 'set-terminal-coding-system) | |
15b3e511 KH |
45 | (define-key mule-keymap "k" 'set-keyboard-coding-system) |
46 | (define-key mule-keymap "p" 'set-buffer-process-coding-system) | |
7624ebb9 KH |
47 | (define-key mule-keymap "x" 'set-selection-coding-system) |
48 | (define-key mule-keymap "X" 'set-next-selection-coding-system) | |
8b784951 | 49 | (define-key mule-keymap "\C-\\" 'set-input-method) |
15b3e511 | 50 | (define-key mule-keymap "c" 'universal-coding-system-argument) |
b4fba33f | 51 | (define-key mule-keymap "l" 'set-language-environment) |
4ed46869 | 52 | |
538d88fb EZ |
53 | (defvar mule-menu-keymap |
54 | (make-sparse-keymap "Mule (Multilingual Environment)") | |
33d17698 | 55 | "Keymap for Mule (Multilingual environment) menu specific commands.") |
15b3e511 | 56 | |
dcad02bc EZ |
57 | (defvar describe-language-environment-map |
58 | (make-sparse-keymap "Describe Language Environment")) | |
15b3e511 | 59 | |
dcad02bc EZ |
60 | (defvar setup-language-environment-map |
61 | (make-sparse-keymap "Set Language Environment")) | |
15b3e511 | 62 | |
dcad02bc EZ |
63 | (defvar set-coding-system-map |
64 | (make-sparse-keymap "Set Coding System")) | |
15b3e511 | 65 | |
15b3e511 | 66 | (define-key-after mule-menu-keymap [set-language-environment] |
cda74479 DL |
67 | (list 'menu-item "Set Language Environment" setup-language-environment-map |
68 | :help "Multilingual environment suitable for a specific language")) | |
a61f401d | 69 | (define-key-after mule-menu-keymap [mouse-set-font] |
538d88fb | 70 | '(menu-item "Set Font/Fontset" mouse-set-font |
cda74479 DL |
71 | :visible (fboundp 'generate-fontset-menu) |
72 | :help "Select a font from list of known fonts/fontsets")) | |
15b3e511 KH |
73 | (define-key-after mule-menu-keymap [separator-mule] |
74 | '("--") | |
75 | t) | |
76 | (define-key-after mule-menu-keymap [toggle-input-method] | |
538d88fb | 77 | '(menu-item "Toggle Input Method" toggle-input-method) |
15b3e511 | 78 | t) |
8b784951 | 79 | (define-key-after mule-menu-keymap [set-input-method] |
538d88fb | 80 | '(menu-item "Select Input Method..." set-input-method) |
15b3e511 | 81 | t) |
cda74479 DL |
82 | (define-key-after mule-menu-keymap [describe-input-method] |
83 | '(menu-item "Describe Input Method" describe-input-method)) | |
15b3e511 KH |
84 | (define-key-after mule-menu-keymap [separator-input-method] |
85 | '("--") | |
86 | t) | |
15b3e511 | 87 | (define-key-after mule-menu-keymap [set-various-coding-system] |
cda74479 DL |
88 | (list 'menu-item "Set Coding Systems" set-coding-system-map |
89 | :enable 'enable-multibyte-characters)) | |
538d88fb EZ |
90 | (define-key-after mule-menu-keymap [view-hello-file] |
91 | '(menu-item "Show Multi-lingual Text" view-hello-file | |
92 | :enable (file-readable-p | |
93 | (expand-file-name "HELLO" data-directory)) | |
94 | :help "Display file which says HELLO in many languages") | |
15b3e511 KH |
95 | t) |
96 | (define-key-after mule-menu-keymap [separator-coding-system] | |
97 | '("--") | |
98 | t) | |
538d88fb EZ |
99 | (define-key-after mule-menu-keymap [describe-language-environment] |
100 | (list 'menu-item "Describe Language Environment" | |
101 | describe-language-environment-map | |
cda74479 | 102 | :help "Show multilingual settings for a specific language") |
15b3e511 | 103 | t) |
538d88fb EZ |
104 | (define-key-after mule-menu-keymap [describe-input-method] |
105 | '(menu-item "Describe Input Method..." describe-input-method | |
cda74479 | 106 | :help "Keyboard layout for a specific input method") |
538d88fb EZ |
107 | t) |
108 | (define-key-after mule-menu-keymap [describe-coding-system] | |
109 | '(menu-item "Describe Coding System..." describe-coding-system) | |
110 | t) | |
cda74479 DL |
111 | (define-key-after mule-menu-keymap [list-character-sets] |
112 | '(menu-item "List Character Sets" list-character-sets | |
113 | :help "Show table of available character sets")) | |
538d88fb EZ |
114 | (define-key-after mule-menu-keymap [mule-diag] |
115 | '(menu-item "Show All of Mule Status" mule-diag | |
116 | :help "Display multilingual environment settings") | |
15b3e511 KH |
117 | t) |
118 | ||
119 | (define-key-after set-coding-system-map [set-buffer-file-coding-system] | |
538d88fb EZ |
120 | '(menu-item "For Saving this Buffer" set-buffer-file-coding-system |
121 | :help "How to encode this buffer on disk") | |
15b3e511 | 122 | t) |
3a151e98 | 123 | (define-key-after set-coding-system-map [universal-coding-system-argument] |
538d88fb EZ |
124 | '(menu-item "For Next Command" universal-coding-system-argument |
125 | :help "Coding system to be used by next command") | |
3a151e98 | 126 | t) |
15b3e511 | 127 | (define-key-after set-coding-system-map [set-terminal-coding-system] |
538d88fb EZ |
128 | '(menu-item "For Terminal" set-terminal-coding-system |
129 | :enable (null (memq window-system '(x w32 mac))) | |
130 | :help "How to encode terminal output") | |
15b3e511 KH |
131 | t) |
132 | (define-key-after set-coding-system-map [set-keyboard-coding-system] | |
538d88fb EZ |
133 | '(menu-item "For Keyboard" set-keyboard-coding-system |
134 | :help "How to decode keyboard input") | |
15b3e511 KH |
135 | t) |
136 | (define-key-after set-coding-system-map [set-buffer-process-coding-system] | |
538d88fb EZ |
137 | '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system |
138 | :visible (fboundp 'start-process) | |
139 | :enable (get-buffer-process (current-buffer)) | |
140 | :help "How to en/decode I/O from/to subprocess connected to this buffer") | |
15b3e511 | 141 | t) |
7624ebb9 | 142 | (define-key-after set-coding-system-map [set-selection-coding-system] |
538d88fb EZ |
143 | '(menu-item "For X Selections/Clipboard" set-selection-coding-system |
144 | :visible (display-selections-p) | |
145 | :help "How to en/decode data to/from selection/clipboard") | |
7624ebb9 KH |
146 | t) |
147 | (define-key-after set-coding-system-map [set-next-selection-coding-system] | |
538d88fb EZ |
148 | '(menu-item "For Next X Selection" set-next-selection-coding-system |
149 | :visible (display-selections-p) | |
150 | :help "How to en/decode next selection/clipboard operation") | |
7624ebb9 | 151 | t) |
15b3e511 | 152 | (define-key setup-language-environment-map |
538d88fb | 153 | [Default] '(menu-item "Default" setup-specified-language-environment)) |
4ed46869 | 154 | |
cda74479 DL |
155 | (define-key describe-language-environment-map |
156 | [Default] '(menu-item "Default" describe-specified-language-support)) | |
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 EZ |
182 | (defun coding-system-change-eol-conversion (coding-system eol-type) |
183 | "Return a coding system which differs from CODING-SYSTEM in eol conversion. | |
184 | The returned coding system converts end-of-line by EOL-TYPE | |
185 | but text as the same way as CODING-SYSTEM. | |
186 | EOL-TYPE should be `unix', `dos', `mac', or nil. | |
187 | If EOL-TYPE is nil, the returned coding system detects | |
188 | how end-of-line is formatted automatically while decoding. | |
189 | ||
190 | EOL-TYPE can be specified by an integer 0, 1, or 2. | |
191 | They 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)))) | |
197 | (let ((orig-eol-type (coding-system-eol-type coding-system))) | |
198 | (if (vectorp orig-eol-type) | |
199 | (if (not eol-type) | |
200 | coding-system | |
201 | (aref orig-eol-type eol-type)) | |
202 | (let ((base (coding-system-base coding-system))) | |
203 | (if (not eol-type) | |
204 | base | |
205 | (if (= eol-type orig-eol-type) | |
206 | coding-system | |
207 | (setq orig-eol-type (coding-system-eol-type base)) | |
208 | (if (vectorp orig-eol-type) | |
209 | (aref orig-eol-type eol-type)))))))) | |
210 | ||
211 | (defun coding-system-change-text-conversion (coding-system coding) | |
212 | "Return a coding system which differs from CODING-SYSTEM in text conversion. | |
213 | The returned coding system converts text by CODING | |
214 | but end-of-line as the same way as CODING-SYSTEM. | |
215 | If CODING is nil, the returned coding system detects | |
216 | how text is formatted automatically while decoding." | |
217 | (if (not coding) | |
218 | (coding-system-base coding-system) | |
219 | (let ((eol-type (coding-system-eol-type coding-system))) | |
220 | (coding-system-change-eol-conversion | |
221 | coding | |
222 | (if (numberp eol-type) (aref [unix dos mac] eol-type)))))) | |
223 | ||
4ed46869 | 224 | (defun toggle-enable-multibyte-characters (&optional arg) |
6998e1a1 RS |
225 | "Change whether this buffer uses multibyte characters. |
226 | With arg, use multibyte characters if the arg is positive. | |
227 | ||
228 | Note that this command does not convert the byte contents of | |
229 | the buffer; it only changes the way those bytes are interpreted. | |
230 | In general, therefore, this command *changes* the sequence of | |
231 | characters that the current buffer contains. | |
232 | ||
233 | We suggest you avoid using use this command unless you know what you | |
234 | are doing. If you use it by mistake, and the buffer is now displayed | |
235 | wrong, use this command again to toggle back to the right mode." | |
4ed46869 | 236 | (interactive "P") |
b7079457 RS |
237 | (let ((new-flag |
238 | (if (null arg) (null enable-multibyte-characters) | |
239 | (> (prefix-numeric-value arg) 0)))) | |
240 | (set-buffer-multibyte new-flag)) | |
4ed46869 KH |
241 | (force-mode-line-update)) |
242 | ||
243 | (defun view-hello-file () | |
244 | "Display the HELLO file which list up many languages and characters." | |
245 | (interactive) | |
8f81f784 KH |
246 | ;; We have to decode the file in any environment. |
247 | (let ((default-enable-multibyte-characters t) | |
95fa03b4 | 248 | (coding-system-for-read 'iso-2022-7bit)) |
8f81f784 | 249 | (find-file-read-only (expand-file-name "HELLO" data-directory)))) |
4ed46869 | 250 | |
15b3e511 KH |
251 | (defun universal-coding-system-argument () |
252 | "Execute an I/O command using the specified coding system." | |
253 | (interactive) | |
34104362 KH |
254 | (let* ((default (and buffer-file-coding-system |
255 | (not (eq (coding-system-type buffer-file-coding-system) | |
256 | t)) | |
257 | buffer-file-coding-system)) | |
258 | (coding-system (read-coding-system | |
259 | (if default | |
260 | (format "Coding system for following command (default, %s): " default) | |
261 | "Coding system for following command: ") | |
262 | default)) | |
15b3e511 | 263 | (keyseq (read-key-sequence |
e14a8f4c | 264 | (format "Command to execute with %s:" coding-system))) |
04363179 GM |
265 | (cmd (key-binding keyseq)) |
266 | prefix) | |
267 | ||
268 | (when (eq cmd 'universal-argument) | |
269 | (call-interactively cmd) | |
270 | ||
271 | ;; Process keys bound in `universal-argument-map'. | |
272 | (while (progn | |
273 | (setq keyseq (read-key-sequence nil t) | |
274 | cmd (key-binding keyseq t)) | |
275 | (not (eq cmd 'universal-argument-other-key))) | |
276 | (let ((current-prefix-arg prefix-arg) | |
277 | ;; Have to bind `last-command-char' here so that | |
278 | ;; `digit-argument', for isntance, can compute the | |
279 | ;; prefix arg. | |
280 | (last-command-char (aref keyseq 0))) | |
281 | (call-interactively cmd))) | |
282 | ||
283 | ;; This is the final call to `univeral-argument-other-key', which | |
284 | ;; set's the final `prefix-arg. | |
285 | (let ((current-prefix-arg prefix-arg)) | |
286 | (call-interactively cmd)) | |
287 | ||
288 | ;; Read the command to execute with the given prefix arg. | |
289 | (setq prefix prefix-arg | |
290 | keyseq (read-key-sequence nil t) | |
291 | cmd (key-binding keyseq))) | |
292 | ||
15b3e511 | 293 | (let ((coding-system-for-read coding-system) |
04363179 GM |
294 | (coding-system-for-write coding-system) |
295 | (current-prefix-arg prefix)) | |
15b3e511 KH |
296 | (message "") |
297 | (call-interactively cmd)))) | |
298 | ||
de94d711 | 299 | (defun set-default-coding-systems (coding-system) |
0c3154d2 | 300 | "Set default value of various coding systems to CODING-SYSTEM. |
387136f6 | 301 | This sets the following coding systems: |
0c3154d2 | 302 | o coding system of a newly created buffer |
8efc03e1 KH |
303 | o default coding system for subprocess I/O |
304 | This also sets the following values: | |
387136f6 | 305 | o default value used as file-name-coding-system for converting file names. |
03c35c83 EZ |
306 | o default value for the command `set-terminal-coding-system' (not on MSDOS) |
307 | o default value for the command `set-keyboard-coding-system'." | |
de94d711 KH |
308 | (check-coding-system coding-system) |
309 | (setq-default buffer-file-coding-system coding-system) | |
716184d4 RS |
310 | (if default-enable-multibyte-characters |
311 | (setq default-file-name-coding-system coding-system)) | |
03c35c83 EZ |
312 | ;; If coding-system is nil, honor that on MS-DOS as well, so |
313 | ;; that they could reset the terminal coding system. | |
314 | (unless (and (eq window-system 'pc) coding-system) | |
315 | (setq default-terminal-coding-system coding-system)) | |
de94d711 KH |
316 | (setq default-keyboard-coding-system coding-system) |
317 | (setq default-process-coding-system (cons coding-system coding-system))) | |
318 | ||
45d08cb2 | 319 | (defalias 'update-iso-coding-systems 'update-coding-systems-internal) |
2598a293 | 320 | (make-obsolete 'update-iso-coding-systems 'update-coding-systems-internal "20.3") |
45d08cb2 | 321 | |
0c3154d2 KH |
322 | (defun prefer-coding-system (coding-system) |
323 | "Add CODING-SYSTEM at the front of the priority list for automatic detection. | |
387136f6 | 324 | This also sets the following coding systems: |
0c3154d2 | 325 | o coding system of a newly created buffer |
8efc03e1 KH |
326 | o default coding system for subprocess I/O |
327 | This also sets the following values: | |
c654de1d | 328 | o default value used as `file-name-coding-system' for converting file names. |
03c35c83 EZ |
329 | o default value for the command `set-terminal-coding-system' (not on MSDOS) |
330 | o default value for the command `set-keyboard-coding-system' | |
331 | ||
bd3ac67e EZ |
332 | If CODING-SYSTEM specifies a certain type of EOL conversion, the coding |
333 | systems set by this function will use that type of EOL conversion. | |
334 | ||
03c35c83 EZ |
335 | This command does not change the default value of terminal coding system |
336 | for MS-DOS terminal, because DOS terminals only support a single coding | |
337 | system, and Emacs automatically sets the default to that coding system at | |
5beaa0d1 KH |
338 | startup. |
339 | ||
c654de1d | 340 | A coding system that requires automatic detection of text |
0855c6cd | 341 | encoding (e.g. undecided, unix) can't be preferred.." |
0c3154d2 KH |
342 | (interactive "zPrefer coding system: ") |
343 | (if (not (and coding-system (coding-system-p coding-system))) | |
344 | (error "Invalid coding system `%s'" coding-system)) | |
97941b05 KH |
345 | (if (memq (coding-system-type coding-system) '(raw-text undecided)) |
346 | (error "Can't prefer the coding system `%s'" coding-system)) | |
347 | (let ((base (coding-system-base coding-system)) | |
bd3ac67e | 348 | (eol-type (coding-system-eol-type coding-system))) |
97941b05 KH |
349 | (set-coding-system-priority base) |
350 | (and (interactive-p) | |
351 | (or (eq base coding-system) | |
352 | (message "Highest priority is set to %s (base of %s)" | |
353 | base coding-system))) | |
bd3ac67e | 354 | ;; If they asked for specific EOL conversion, honor that. |
6f9dc4fd | 355 | (if (memq eol-type '(0 1 2)) |
97941b05 KH |
356 | (setq base |
357 | (coding-system-change-eol-conversion base eol-type))) | |
358 | (set-default-coding-systems base))) | |
0c3154d2 | 359 | |
b5edd1d1 KH |
360 | (defvar sort-coding-systems-predicate nil |
361 | "If non-nil, a predicate function to sort coding systems. | |
362 | ||
363 | It is called with two coding systems, and should return t if the first | |
364 | one is \"less\" than the second. | |
365 | ||
366 | The function `sort-coding-systems' use it.") | |
367 | ||
368 | (defun sort-coding-systems (codings) | |
369 | "Sort coding system list CODINGS by a priority of each coding system. | |
370 | ||
371 | If a coding system is most preferred, it has the highest priority. | |
372 | Otherwise, a coding system corresponds to some MIME charset has higher | |
373 | priorities. Among them, a coding system included in `coding-system' | |
374 | key of the current language environment has higher priorities. See | |
375 | also the documentation of `language-info-alist'. | |
376 | ||
377 | If the variable `sort-coding-systems-predicate' (which see) is | |
378 | non-nil, it is used to sort CODINGS in the different way than above." | |
379 | (if sort-coding-systems-predicate | |
380 | (sort codings sort-coding-systems-predicate) | |
97941b05 | 381 | (let* ((most-preferred (coding-system-priority-list t)) |
b5edd1d1 KH |
382 | (lang-preferred (get-language-info current-language-environment |
383 | 'coding-system)) | |
384 | (func (function | |
385 | (lambda (x) | |
386 | (let ((base (coding-system-base x))) | |
387 | (+ (if (eq base most-preferred) 64 0) | |
209c73b0 | 388 | (let ((mime (coding-system-get base :mime-charset))) |
b5edd1d1 KH |
389 | (if mime |
390 | (if (string-match "^x-" (symbol-name mime)) | |
391 | 16 32) | |
392 | 0)) | |
393 | (if (memq base lang-preferred) 8 0) | |
394 | (if (string-match "-with-esc$" (symbol-name base)) | |
395 | 0 4) | |
396 | (if (eq (coding-system-type base) 2) | |
397 | ;; For ISO based coding systems, prefer | |
398 | ;; one that doesn't use escape sequences. | |
bc304a20 | 399 | ;; Fixme: coding-system-spec |
97941b05 KH |
400 | (let* ((extra-spec (coding-system-spec base)) |
401 | (flags (aref extra-spec 3))) | |
402 | (if (/= (logand flags #x40) 0) | |
403 | (if (/= (logand flags #x30) 0) | |
b5edd1d1 KH |
404 | 0 |
405 | 1) | |
406 | 2)) | |
407 | 1))))))) | |
408 | (sort codings (function (lambda (x y) | |
409 | (> (funcall func x) (funcall func y)))))))) | |
54b226f7 | 410 | |
3fc7dfe5 | 411 | (defun find-coding-systems-region (from to) |
54b226f7 KH |
412 | "Return a list of proper coding systems to encode a text between FROM and TO. |
413 | All coding systems in the list can safely encode any multibyte characters | |
414 | in the text. | |
415 | ||
e8dd0160 | 416 | If the text contains no multibyte characters, return a list of a single |
3fc7dfe5 | 417 | element `undecided'." |
b5edd1d1 KH |
418 | (let ((codings (find-coding-systems-region-internal from to))) |
419 | (if (eq codings t) | |
420 | ;; The text contains only ASCII characters. Any coding | |
421 | ;; systems are safe. | |
422 | '(undecided) | |
423 | ;; We need copy-sequence because sorting will alter the argument. | |
424 | (sort-coding-systems (copy-sequence codings))))) | |
54b226f7 | 425 | |
3fc7dfe5 KH |
426 | (defun find-coding-systems-string (string) |
427 | "Return a list of proper coding systems to encode STRING. | |
428 | All coding systems in the list can safely encode any multibyte characters | |
429 | in STRING. | |
430 | ||
e8dd0160 | 431 | If STRING contains no multibyte characters, return a list of a single |
3fc7dfe5 | 432 | element `undecided'." |
b5edd1d1 | 433 | (find-coding-systems-region string nil)) |
3fc7dfe5 | 434 | |
0855c6cd | 435 | ;; Fixme: re-write |
3fc7dfe5 KH |
436 | (defun find-coding-systems-for-charsets (charsets) |
437 | "Return a list of proper coding systems to encode characters of CHARSETS. | |
438 | CHARSETS is a list of character sets." | |
b5edd1d1 KH |
439 | (cond ((or (null charsets) |
440 | (and (= (length charsets) 1) | |
441 | (eq 'ascii (car charsets)))) | |
442 | '(undecided)) | |
443 | ((or (memq 'eight-bit-control charsets) | |
444 | (memq 'eight-bit-graphic charsets)) | |
445 | '(raw-text emacs-mule)) | |
446 | (t | |
447 | (let ((codings t) | |
448 | charset l ll) | |
449 | (while (and codings charsets) | |
450 | (setq charset (car charsets) charsets (cdr charsets)) | |
451 | (unless (eq charset 'ascii) | |
452 | (setq l (aref char-coding-system-table (make-char charset))) | |
453 | (if (eq codings t) | |
454 | (setq codings l) | |
455 | (let ((ll nil)) | |
456 | (while codings | |
457 | (if (memq (car codings) l) | |
458 | (setq ll (cons (car codings) ll))) | |
459 | (setq codings (cdr codings))) | |
460 | (setq codings ll))))) | |
461 | (append codings | |
462 | (char-table-extra-slot char-coding-system-table 0)))))) | |
54b226f7 | 463 | |
15f2c48a | 464 | ;; Fixme: is this doing the right thing now, at least with eight-bit? |
51ed58ea KH |
465 | (defun find-multibyte-characters (from to &optional maxcount excludes) |
466 | "Find multibyte characters in the region specified by FROM and TO. | |
467 | If FROM is a string, find multibyte characters in the string. | |
468 | The return value is an alist of the following format: | |
469 | ((CHARSET COUNT CHAR ...) ...) | |
470 | where | |
471 | CHARSET is a character set, | |
472 | COUNT is a number of characters, | |
473 | CHARs are found characters of the character set. | |
474 | Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list. | |
15f2c48a | 475 | Optional 4th arg EXCLUDE is a list of character sets to be ignored." |
51ed58ea KH |
476 | (let ((chars nil) |
477 | charset char) | |
478 | (if (stringp from) | |
479 | (let ((idx 0)) | |
480 | (while (setq idx (string-match "[^\000-\177]" from idx)) | |
481 | (setq char (aref from idx) | |
482 | charset (char-charset char)) | |
15f2c48a | 483 | (if (or (memq charset '(eight-bit-control eight-bit-graphic)) |
251d4f4b | 484 | (not (or (eq excludes t) (memq charset excludes)))) |
51ed58ea KH |
485 | (let ((slot (assq charset chars))) |
486 | (if slot | |
487 | (if (not (memq char (nthcdr 2 slot))) | |
488 | (let ((count (nth 1 slot))) | |
489 | (setcar (cdr slot) (1+ count)) | |
490 | (if (or (not maxcount) (< count maxcount)) | |
491 | (nconc slot (list char))))) | |
492 | (setq chars (cons (list charset 1 char) chars))))) | |
493 | (setq idx (1+ idx)))) | |
494 | (save-excursion | |
495 | (goto-char from) | |
496 | (while (re-search-forward "[^\000-\177]" to t) | |
497 | (setq char (preceding-char) | |
498 | charset (char-charset char)) | |
15f2c48a | 499 | (if (or (memq charset '(eight-bit-control eight-bit-graphic)) |
251d4f4b | 500 | (not (or (eq excludes t) (memq charset excludes)))) |
51ed58ea KH |
501 | (let ((slot (assq charset chars))) |
502 | (if slot | |
251d4f4b | 503 | (if (not (member char (nthcdr 2 slot))) |
51ed58ea KH |
504 | (let ((count (nth 1 slot))) |
505 | (setcar (cdr slot) (1+ count)) | |
506 | (if (or (not maxcount) (< count maxcount)) | |
507 | (nconc slot (list char))))) | |
508 | (setq chars (cons (list charset 1 char) chars)))))))) | |
509 | (nreverse chars))) | |
510 | ||
c83c4f60 RS |
511 | (defvar last-coding-system-specified nil |
512 | "Most recent coding system explicitly specified by the user when asked. | |
513 | This variable is set whenever Emacs asks the user which coding system | |
514 | to use in order to write a file. If you set it to nil explicitly, | |
515 | then call `write-region', then afterward this variable will be non-nil | |
516 | only if the user was explicitly asked and specified a coding system.") | |
517 | ||
b5edd1d1 KH |
518 | (defvar select-safe-coding-system-accept-default-p nil |
519 | "If non-nil, a function to control the behaviour of coding system selection. | |
520 | The meaning is the same as the argument ACCEPT-DEFAULT-P of the | |
521 | function `select-safe-coding-system' (which see). This variable | |
522 | overrides that argument.") | |
523 | ||
524 | (defun select-safe-coding-system (from to &optional default-coding-system | |
525 | accept-default-p) | |
d5266ddf KH |
526 | "Ask a user to select a safe coding system from candidates. |
527 | The candidates of coding systems which can safely encode a text | |
b5edd1d1 KH |
528 | between FROM and TO are shown in a popup window. Among them, the most |
529 | proper one is suggested as the default. | |
530 | ||
531 | The list of `buffer-file-coding-system' of the current buffer and the | |
532 | most preferred coding system (if it corresponds to a MIME charset) is | |
533 | treated as the default coding system list. Among them, the first one | |
534 | that safely encodes the text is silently selected and returned without | |
535 | any user interaction. See also the command `prefer-coding-system'. | |
54b226f7 | 536 | |
b5edd1d1 KH |
537 | Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a |
538 | list of coding systems to be prepended to the default coding system | |
539 | list. | |
54b226f7 | 540 | |
b5edd1d1 KH |
541 | Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to |
542 | determine the acceptability of the silently selected coding system. | |
543 | It is called with that coding system, and should return nil if it | |
544 | should not be silently selected and thus user interaction is required. | |
545 | ||
546 | The variable `select-safe-coding-system-accept-default-p', if | |
547 | non-nil, overrides ACCEPT-DEFAULT-P. | |
54b226f7 KH |
548 | |
549 | Kludgy feature: if FROM is a string, the string is the target text, | |
550 | and TO is ignored." | |
b5edd1d1 KH |
551 | (if (and default-coding-system |
552 | (not (listp default-coding-system))) | |
553 | (setq default-coding-system (list default-coding-system))) | |
554 | ||
555 | ;; Change elements of the list to (coding . base-coding). | |
556 | (setq default-coding-system | |
557 | (mapcar (function (lambda (x) (cons x (coding-system-base x)))) | |
558 | default-coding-system)) | |
559 | ||
560 | ;; If buffer-file-coding-system is not nil nor undecided, append it | |
561 | ;; to the defaults. | |
562 | (if buffer-file-coding-system | |
563 | (let ((base (coding-system-base buffer-file-coding-system))) | |
564 | (or (eq base 'undecided) | |
565 | (assq buffer-file-coding-system default-coding-system) | |
566 | (rassq base default-coding-system) | |
e56d7900 | 567 | (setq default-coding-system |
b5edd1d1 KH |
568 | (append default-coding-system |
569 | (list (cons buffer-file-coding-system base))))))) | |
570 | ||
571 | ;; If the most preferred coding system has the property mime-charset, | |
572 | ;; append it to the defaults. | |
97941b05 KH |
573 | (let ((preferred (coding-system-priority-list t)) |
574 | base) | |
c24e49a8 KH |
575 | (and (coding-system-p preferred) |
576 | (setq base (coding-system-base preferred)) | |
209c73b0 | 577 | (coding-system-get preferred :mime-charset) |
b5edd1d1 KH |
578 | (not (assq preferred default-coding-system)) |
579 | (not (rassq base default-coding-system)) | |
580 | (setq default-coding-system | |
581 | (append default-coding-system (list (cons preferred base)))))) | |
582 | ||
583 | (if select-safe-coding-system-accept-default-p | |
584 | (setq accept-default-p select-safe-coding-system-accept-default-p)) | |
585 | ||
586 | (let ((codings (find-coding-systems-region from to)) | |
587 | (coding-system nil) | |
45610c98 | 588 | (bufname (buffer-name)) |
b5edd1d1 KH |
589 | (l default-coding-system)) |
590 | (if (eq (car codings) 'undecided) | |
591 | ;; Any coding system is ok. | |
592 | (setq coding-system t) | |
593 | ;; Try the defaults. | |
594 | (while (and l (not coding-system)) | |
595 | (if (memq (cdr (car l)) codings) | |
596 | (setq coding-system (car (car l))) | |
597 | (setq l (cdr l)))) | |
598 | (if (and coding-system accept-default-p) | |
599 | (or (funcall accept-default-p coding-system) | |
600 | (setq coding-system (list coding-system))))) | |
601 | ||
602 | ;; If all the defaults failed, ask a user. | |
603 | (when (or (not coding-system) (consp coding-system)) | |
34104362 | 604 | ;; At first, change each coding system to the corresponding |
b5edd1d1 KH |
605 | ;; mime-charset name if it is also a coding system. Such a name |
606 | ;; is more friendly to users. | |
607 | (let ((l codings) | |
34104362 KH |
608 | mime-charset) |
609 | (while l | |
209c73b0 | 610 | (setq mime-charset (coding-system-get (car l) :mime-charset)) |
34104362 KH |
611 | (if (and mime-charset (coding-system-p mime-charset)) |
612 | (setcar l mime-charset)) | |
613 | (setq l (cdr l)))) | |
614 | ||
45610c98 EZ |
615 | ;; Make sure the offending buffer is displayed. |
616 | (or (stringp from) | |
617 | (pop-to-buffer bufname)) | |
b5edd1d1 KH |
618 | ;; Then ask users to select one form CODINGS. |
619 | (unwind-protect | |
620 | (save-window-excursion | |
621 | (with-output-to-temp-buffer "*Warning*" | |
622 | (save-excursion | |
623 | (set-buffer standard-output) | |
a672b7cd | 624 | (if (not default-coding-system) |
45610c98 EZ |
625 | (insert "No default coding systems to try for " |
626 | (if (stringp from) | |
627 | (format "string \"%s\"." from) | |
628 | (format "buffer `%s'." bufname))) | |
629 | (insert | |
630 | "These default coding systems were tried to encode" | |
631 | (if (stringp from) | |
632 | (concat " \"" (if (> (length from) 10) | |
633 | (concat (substring from 0 10) "...\"") | |
634 | (concat from "\""))) | |
635 | (format " text\nin the buffer `%s'" bufname)) | |
636 | ":\n") | |
a672b7cd KH |
637 | (let ((pos (point)) |
638 | (fill-prefix " ")) | |
639 | (mapcar (function (lambda (x) | |
640 | (princ " ") (princ (car x)))) | |
641 | default-coding-system) | |
642 | (insert "\n") | |
643 | (fill-region-as-paragraph pos (point))) | |
644 | (insert | |
645 | (if (consp coding-system) | |
646 | (concat (format "%s safely encodes the target text,\n" | |
647 | (car coding-system)) | |
648 | "but it is not recommended for encoding text in this context,\n" | |
649 | "e.g., for sending an email message.\n") | |
650 | "However, none of them safely encodes the target text.\n"))) | |
b5edd1d1 | 651 | (insert (if (consp coding-system) |
2f1fa038 EZ |
652 | "\nSelect the above, or " |
653 | "\nSelect ") | |
654 | "one of the following safe coding systems:\n") | |
b5edd1d1 KH |
655 | (let ((pos (point)) |
656 | (fill-prefix " ")) | |
657 | (mapcar (function (lambda (x) (princ " ") (princ x))) | |
658 | codings) | |
659 | (insert "\n") | |
660 | (fill-region-as-paragraph pos (point))))) | |
661 | ||
662 | ;; Read a coding system. | |
663 | (if (consp coding-system) | |
664 | (setq codings (cons (car coding-system) codings))) | |
665 | (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x))) | |
666 | codings)) | |
667 | (name (completing-read | |
668 | (format "Select coding system (default %s): " | |
669 | (car codings)) | |
670 | safe-names nil t nil nil | |
671 | (car (car safe-names))))) | |
672 | (setq last-coding-system-specified (intern name) | |
673 | coding-system last-coding-system-specified))) | |
674 | (kill-buffer "*Warning*"))) | |
675 | ||
676 | (if (vectorp (coding-system-eol-type coding-system)) | |
677 | (let ((eol (coding-system-eol-type buffer-file-coding-system))) | |
678 | (if (numberp eol) | |
679 | (setq coding-system | |
680 | (coding-system-change-eol-conversion coding-system eol))))) | |
681 | ||
682 | (if (eq coding-system t) | |
683 | (setq coding-system buffer-file-coding-system)) | |
e56d7900 | 684 | coding-system)) |
54b226f7 KH |
685 | |
686 | (setq select-safe-coding-system-function 'select-safe-coding-system) | |
687 | ||
46babb23 KH |
688 | (defun select-message-coding-system () |
689 | "Return a coding system to encode the outgoing message of the current buffer. | |
690 | It at first tries the first coding system found in these variables | |
691 | in this order: | |
692 | (1) local value of `buffer-file-coding-system' | |
693 | (2) value of `sendmail-coding-system' | |
b5edd1d1 KH |
694 | (3) value of `default-sendmail-coding-system' |
695 | (4) value of `default-buffer-file-coding-system' | |
46babb23 KH |
696 | If the found coding system can't encode the current buffer, |
697 | or none of them are bound to a coding system, | |
48e41165 | 698 | it asks the user to select a proper coding system." |
46babb23 | 699 | (let ((coding (or (and (local-variable-p 'buffer-file-coding-system) |
b5edd1d1 KH |
700 | buffer-file-coding-system) |
701 | sendmail-coding-system | |
702 | default-sendmail-coding-system | |
703 | default-buffer-file-coding-system))) | |
46babb23 | 704 | (if (eq coding 'no-conversion) |
209c73b0 | 705 | ;; We should never use no-conversion for outgoing mail. |
46babb23 KH |
706 | (setq coding nil)) |
707 | (if (fboundp select-safe-coding-system-function) | |
708 | (funcall select-safe-coding-system-function | |
b5edd1d1 | 709 | (point-min) (point-max) coding |
209c73b0 | 710 | (function (lambda (x) (coding-system-get x :mime-charset)))) |
46babb23 | 711 | coding))) |
4ed46869 | 712 | \f |
03c35c83 | 713 | ;;; Language support stuff. |
4ed46869 | 714 | |
4ed46869 | 715 | (defvar language-info-alist nil |
2c395d56 | 716 | "Alist of language environment definitions. |
4ed46869 KH |
717 | Each element looks like: |
718 | (LANGUAGE-NAME . ((KEY . INFO) ...)) | |
2c395d56 RS |
719 | where LANGUAGE-NAME is a string, the name of the language environment, |
720 | KEY is a symbol denoting the kind of information, and | |
721 | INFO is the data associated with KEY. | |
722 | Meaningful values for KEY include | |
723 | ||
724 | documentation value is documentation of what this language environment | |
725 | is meant for, and how to use it. | |
726 | charset value is a list of the character sets used by this | |
727 | language environment. | |
728 | sample-text value is one line of text, | |
729 | written using those character sets, | |
730 | appropriate for this language environment. | |
731 | setup-function value is a function to call to switch to this | |
732 | language environment. | |
733 | exit-function value is a function to call to leave this | |
734 | language environment. | |
735 | coding-system value is a list of coding systems that are good | |
736 | for saving text written in this language environment. | |
737 | This list serves as suggestions to the user; | |
738 | in effect, as a kind of documentation. | |
739 | coding-priority value is a list of coding systems for this language | |
740 | environment, in order of decreasing priority. | |
741 | This is used to set up the coding system priority | |
45d08cb2 | 742 | list when you switch to this language environment. |
ddb5c041 | 743 | nonascii-translation |
7624ebb9 | 744 | value is a translation table to be set in the |
45d08cb2 | 745 | variable `nonascii-translation-table' in this |
7624ebb9 KH |
746 | language environment, or a character set from |
747 | which `nonascii-insert-offset' is calculated. | |
ddb5c041 KH |
748 | input-method value is a default input method for this language |
749 | environment. | |
7624ebb9 KH |
750 | features value is a list of features requested in this |
751 | language environment. | |
ddb5c041 KH |
752 | |
753 | The following keys take effect only when multibyte characters are | |
754 | globally disabled, i.e. the value of `default-enable-multibyte-characters' | |
755 | is nil. | |
756 | ||
757 | unibyte-syntax value is a library name to load to set | |
e8dd0160 | 758 | unibyte 8-bit character syntaxes for this |
ddb5c041 KH |
759 | language environment. |
760 | ||
761 | unibyte-display value is a coding system to encode characters | |
762 | for the terminal. Characters in the range | |
763 | of 160 to 255 display not as octal escapes, | |
764 | but as non-ASCII characters in this language | |
765 | environment.") | |
2c395d56 RS |
766 | |
767 | (defun get-language-info (lang-env key) | |
768 | "Return information listed under KEY for language environment LANG-ENV. | |
769 | KEY is a symbol denoting the kind of information. | |
770 | For a list of useful values for KEY and their meanings, | |
771 | see `language-info-alist'." | |
772 | (if (symbolp lang-env) | |
773 | (setq lang-env (symbol-name lang-env))) | |
774 | (let ((lang-slot (assoc-ignore-case lang-env language-info-alist))) | |
4ed46869 KH |
775 | (if lang-slot |
776 | (cdr (assq key (cdr lang-slot)))))) | |
777 | ||
f08adf27 | 778 | (defun set-language-info (lang-env key info) |
2c395d56 RS |
779 | "Modify part of the definition of language environment LANG-ENV. |
780 | Specifically, this stores the information INFO under KEY | |
781 | in the definition of this language environment. | |
4ed46869 | 782 | KEY is a symbol denoting the kind of information. |
2c395d56 | 783 | INFO is the value for that information. |
281d03ec | 784 | |
2c395d56 | 785 | For a list of useful values for KEY and their meanings, |
f08adf27 | 786 | see `language-info-alist'." |
2c395d56 RS |
787 | (if (symbolp lang-env) |
788 | (setq lang-env (symbol-name lang-env))) | |
4ed46869 | 789 | (let (lang-slot key-slot) |
2c395d56 | 790 | (setq lang-slot (assoc lang-env language-info-alist)) |
4ed46869 | 791 | (if (null lang-slot) ; If no slot for the language, add it. |
2c395d56 | 792 | (setq lang-slot (list lang-env) |
4ed46869 KH |
793 | language-info-alist (cons lang-slot language-info-alist))) |
794 | (setq key-slot (assq key lang-slot)) | |
795 | (if (null key-slot) ; If no slot for the key, add it. | |
796 | (progn | |
797 | (setq key-slot (list key)) | |
798 | (setcdr lang-slot (cons key-slot (cdr lang-slot))))) | |
cda74479 | 799 | (setcdr key-slot (purecopy info)))) |
4ed46869 | 800 | |
2c395d56 RS |
801 | (defun set-language-info-alist (lang-env alist &optional parents) |
802 | "Store ALIST as the definition of language environment LANG-ENV. | |
803 | ALIST is an alist of KEY and INFO values. See the documentation of | |
98c6d6ed | 804 | `language-info-alist' for the meanings of KEY and INFO. |
54b226f7 | 805 | |
2c395d56 RS |
806 | Optional arg PARENTS is a list of parent menu names; it specifies |
807 | where to put this language environment in the | |
808 | Describe Language Environment and Set Language Environment menus. | |
809 | For example, (\"European\") means to put this language environment | |
810 | in the European submenu in each of those two menus." | |
811 | (if (symbolp lang-env) | |
812 | (setq lang-env (symbol-name lang-env))) | |
54b226f7 KH |
813 | (let ((describe-map describe-language-environment-map) |
814 | (setup-map setup-language-environment-map)) | |
815 | (if parents | |
816 | (let ((l parents) | |
9deed82f | 817 | map parent-symbol parent prompt) |
54b226f7 KH |
818 | (while l |
819 | (if (symbolp (setq parent-symbol (car l))) | |
820 | (setq parent (symbol-name parent)) | |
821 | (setq parent parent-symbol parent-symbol (intern parent))) | |
822 | (setq map (lookup-key describe-map (vector parent-symbol))) | |
9deed82f EZ |
823 | ;; This prompt string is for define-prefix-command, so |
824 | ;; that the map it creates will be suitable for a menu. | |
825 | (or map (setq prompt (format "%s Environment" parent))) | |
54b226f7 KH |
826 | (if (not map) |
827 | (progn | |
828 | (setq map (intern (format "describe-%s-environment-map" | |
829 | (downcase parent)))) | |
9deed82f | 830 | (define-prefix-command map nil prompt) |
54b226f7 KH |
831 | (define-key-after describe-map (vector parent-symbol) |
832 | (cons parent map) t))) | |
833 | (setq describe-map (symbol-value map)) | |
834 | (setq map (lookup-key setup-map (vector parent-symbol))) | |
835 | (if (not map) | |
836 | (progn | |
837 | (setq map (intern (format "setup-%s-environment-map" | |
838 | (downcase parent)))) | |
9deed82f | 839 | (define-prefix-command map nil prompt) |
54b226f7 KH |
840 | (define-key-after setup-map (vector parent-symbol) |
841 | (cons parent map) t))) | |
842 | (setq setup-map (symbol-value map)) | |
843 | (setq l (cdr l))))) | |
f08adf27 RS |
844 | |
845 | ;; Set up menu items for this language env. | |
7624ebb9 | 846 | (let ((doc (assq 'documentation alist))) |
f08adf27 RS |
847 | (when doc |
848 | (define-key-after describe-map (vector (intern lang-env)) | |
7624ebb9 KH |
849 | (cons lang-env 'describe-specified-language-support) t))) |
850 | (define-key-after setup-map (vector (intern lang-env)) | |
851 | (cons lang-env 'setup-specified-language-environment) t) | |
f08adf27 | 852 | |
54b226f7 | 853 | (while alist |
f08adf27 | 854 | (set-language-info lang-env (car (car alist)) (cdr (car alist))) |
54b226f7 | 855 | (setq alist (cdr alist))))) |
4ed46869 | 856 | |
ae302641 | 857 | (defun read-language-name (key prompt &optional default) |
2c395d56 | 858 | "Read a language environment name which has information for KEY. |
ddb5c041 | 859 | If KEY is nil, read any language environment. |
2c395d56 RS |
860 | Prompt with PROMPT. DEFAULT is the default choice of language environment. |
861 | This returns a language environment name as a string." | |
4ed46869 KH |
862 | (let* ((completion-ignore-case t) |
863 | (name (completing-read prompt | |
864 | language-info-alist | |
ddb5c041 KH |
865 | (and key |
866 | (function (lambda (elm) (assq key elm)))) | |
ae302641 | 867 | t nil nil default))) |
13e82c04 | 868 | (if (and (> (length name) 0) |
ddb5c041 KH |
869 | (or (not key) |
870 | (get-language-info name key))) | |
13e82c04 | 871 | name))) |
4ed46869 KH |
872 | \f |
873 | ;;; Multilingual input methods. | |
d0c40faa KH |
874 | (defgroup leim nil |
875 | "LEIM: Libraries of Emacs Input Methods." | |
876 | :group 'mule) | |
4ed46869 | 877 | |
d0b9c3ab KH |
878 | (defconst leim-list-file-name "leim-list.el" |
879 | "Name of LEIM list file. | |
880 | This file contains a list of libraries of Emacs input methods (LEIM) | |
881 | in the format of Lisp expression for registering each input method. | |
882 | Emacs loads this file at startup time.") | |
883 | ||
2e224638 SM |
884 | (defvar leim-list-header (format |
885 | ";;; %s -- list of LEIM (Library of Emacs Input Method) | |
d0b9c3ab KH |
886 | ;; |
887 | ;; This file contains a list of LEIM (Library of Emacs Input Method) | |
c654de1d DL |
888 | ;; methods in the same directory as this file. Loading this file |
889 | ;; registers all the input methods in Emacs. | |
d0b9c3ab | 890 | ;; |
d33d5fbe | 891 | ;; Each entry has the form: |
d0b9c3ab KH |
892 | ;; (register-input-method |
893 | ;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC | |
894 | ;; TITLE DESCRIPTION | |
895 | ;; ARG ...) | |
c654de1d | 896 | ;; See the function `register-input-method' for the meanings of the arguments. |
d0b9c3ab KH |
897 | ;; |
898 | ;; If this directory is included in load-path, Emacs automatically | |
899 | ;; loads this file at startup time. | |
900 | ||
901 | " | |
902 | leim-list-file-name) | |
903 | "Header to be inserted in LEIM list file.") | |
904 | ||
e55e92ee | 905 | (defvar leim-list-entry-regexp "^(register-input-method" |
d0b9c3ab KH |
906 | "Regexp matching head of each entry in LEIM list file. |
907 | See also the variable `leim-list-header'") | |
908 | ||
909 | (defvar update-leim-list-functions | |
910 | '(quail-update-leim-list-file) | |
911 | "List of functions to call to update LEIM list file. | |
912 | Each function is called with one arg, LEIM directory name.") | |
913 | ||
a337fe7f RS |
914 | (defun update-leim-list-file (&rest dirs) |
915 | "Update LEIM list file in directories DIRS." | |
d0b9c3ab KH |
916 | (let ((functions update-leim-list-functions)) |
917 | (while functions | |
a337fe7f | 918 | (apply (car functions) dirs) |
d0b9c3ab KH |
919 | (setq functions (cdr functions))))) |
920 | ||
4ed46869 KH |
921 | (defvar current-input-method nil |
922 | "The current input method for multilingual text. | |
96db204a | 923 | If nil, that means no input method is activated now.") |
4ed46869 KH |
924 | (make-variable-buffer-local 'current-input-method) |
925 | (put 'current-input-method 'permanent-local t) | |
926 | ||
927 | (defvar current-input-method-title nil | |
d0b9c3ab | 928 | "Title string of the current input method shown in mode line.") |
4ed46869 KH |
929 | (make-variable-buffer-local 'current-input-method-title) |
930 | (put 'current-input-method-title 'permanent-local t) | |
931 | ||
b4fba33f | 932 | (defcustom default-input-method nil |
8861c593 | 933 | "*Default input method for multilingual text (a string). |
b4fba33f | 934 | This is the input method activated automatically by the command |
9b10b5a3 | 935 | `toggle-input-method' (\\[toggle-input-method])." |
8861c593 | 936 | :group 'mule |
5806e8a6 GM |
937 | :type '(choice (const nil) string) |
938 | :set-after '(current-language-environment)) | |
b4fba33f | 939 | |
0f835e87 KH |
940 | (put 'input-method-function 'permanent-local t) |
941 | ||
723a427a KH |
942 | (defvar input-method-history nil |
943 | "History list for some commands that read input methods.") | |
944 | (make-variable-buffer-local 'input-method-history) | |
945 | (put 'input-method-history 'permanent-local t) | |
4ed46869 KH |
946 | |
947 | (defvar inactivate-current-input-method-function nil | |
948 | "Function to call for inactivating the current input method. | |
949 | Every input method should set this to an appropriate value when activated. | |
f17ccaee KH |
950 | This function is called with no argument. |
951 | ||
952 | This function should never change the value of `current-input-method'. | |
953 | It is set to nil by the function `inactivate-input-method'.") | |
4ed46869 KH |
954 | (make-variable-buffer-local 'inactivate-current-input-method-function) |
955 | (put 'inactivate-current-input-method-function 'permanent-local t) | |
956 | ||
957 | (defvar describe-current-input-method-function nil | |
958 | "Function to call for describing the current input method. | |
959 | This function is called with no argument.") | |
960 | (make-variable-buffer-local 'describe-current-input-method-function) | |
961 | (put 'describe-current-input-method-function 'permanent-local t) | |
962 | ||
d0b9c3ab | 963 | (defvar input-method-alist nil |
2c395d56 | 964 | "Alist of input method names vs how to use them. |
d0b9c3ab | 965 | Each element has the form: |
2c395d56 RS |
966 | (INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...) |
967 | See the function `register-input-method' for the meanings of the elements.") | |
968 | ||
f08adf27 | 969 | (defun register-input-method (input-method lang-env &rest args) |
bf42aa15 | 970 | "Register INPUT-METHOD as an input method for language environment LANG-ENV. |
f08adf27 | 971 | INPUT-METHOD and LANG-ENV are symbols or strings. |
d0b9c3ab | 972 | |
d0b9c3ab | 973 | The remaining arguments are: |
2c395d56 RS |
974 | ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARGS... |
975 | ACTIVATE-FUNC is a function to call to activate this method. | |
976 | TITLE is a string to show in the mode line when this method is active. | |
977 | DESCRIPTION is a string describing this method and what it is good for. | |
978 | The ARGS, if any, are passed as arguments to ACTIVATE-FUNC. | |
205814ee KH |
979 | All told, the arguments to ACTIVATE-FUNC are INPUT-METHOD and the ARGS. |
980 | ||
c654de1d DL |
981 | This function is mainly used in the file \"leim-list.el\" which is |
982 | created at Emacs build time, registering all Quail input methods | |
0b6cadff | 983 | contained in the Emacs distribution. |
205814ee | 984 | |
0b6cadff | 985 | In case you want to register a new Quail input method by yourself, be |
205814ee | 986 | careful to use the same input method title as given in the third |
0b6cadff DL |
987 | parameter of `quail-define-package'. (If the values are different, the |
988 | string specified in this function takes precedence.) | |
205814ee KH |
989 | |
990 | The commands `describe-input-method' and `list-input-methods' need | |
0b6cadff DL |
991 | these duplicated values to show some information about input methods |
992 | without loading the relevant Quail packages." | |
f08adf27 RS |
993 | (if (symbolp lang-env) |
994 | (setq lang-env (symbol-name lang-env))) | |
4ef06f75 KH |
995 | (if (symbolp input-method) |
996 | (setq input-method (symbol-name input-method))) | |
f08adf27 | 997 | (let ((info (cons lang-env args)) |
d0b9c3ab KH |
998 | (slot (assoc input-method input-method-alist))) |
999 | (if slot | |
1000 | (setcdr slot info) | |
1001 | (setq slot (cons input-method info)) | |
1002 | (setq input-method-alist (cons slot input-method-alist))))) | |
1003 | ||
4d5ac029 | 1004 | (defun read-input-method-name (prompt &optional default inhibit-null) |
d0b9c3ab | 1005 | "Read a name of input method from a minibuffer prompting with PROMPT. |
4d5ac029 | 1006 | If DEFAULT is non-nil, use that as the default, |
0b6cadff | 1007 | and substitute it into PROMPT at the first `%s'. |
4ef06f75 KH |
1008 | If INHIBIT-NULL is non-nil, null input signals an error. |
1009 | ||
1010 | The return value is a string." | |
4d5ac029 RS |
1011 | (if default |
1012 | (setq prompt (format prompt default))) | |
d0b9c3ab | 1013 | (let* ((completion-ignore-case t) |
c54044ff KH |
1014 | ;; As it is quite normal to change input method in the |
1015 | ;; minibuffer, we must enable it even if | |
1016 | ;; enable-recursive-minibuffers is currently nil. | |
1017 | (enable-recursive-minibuffers t) | |
723a427a KH |
1018 | ;; This binding is necessary because input-method-history is |
1019 | ;; buffer local. | |
d0b9c3ab | 1020 | (input-method (completing-read prompt input-method-alist |
87505a98 RS |
1021 | nil t nil 'input-method-history |
1022 | default))) | |
bf294e6e KH |
1023 | (if (and input-method (symbolp input-method)) |
1024 | (setq input-method (symbol-name input-method))) | |
d0b9c3ab KH |
1025 | (if (> (length input-method) 0) |
1026 | input-method | |
1027 | (if inhibit-null | |
43807b77 | 1028 | (error "No valid input method is specified"))))) |
d0b9c3ab | 1029 | |
d0b9c3ab | 1030 | (defun activate-input-method (input-method) |
2c395d56 RS |
1031 | "Switch to input method INPUT-METHOD for the current buffer. |
1032 | If some other input method is already active, turn it off first. | |
1033 | If INPUT-METHOD is nil, deactivate any current input method." | |
305a3cb6 | 1034 | (if (and input-method (symbolp input-method)) |
4ef06f75 | 1035 | (setq input-method (symbol-name input-method))) |
723a427a KH |
1036 | (if (and current-input-method |
1037 | (not (string= current-input-method input-method))) | |
305a3cb6 | 1038 | (inactivate-input-method)) |
2c395d56 | 1039 | (unless (or current-input-method (null input-method)) |
d0b9c3ab KH |
1040 | (let ((slot (assoc input-method input-method-alist))) |
1041 | (if (null slot) | |
723a427a | 1042 | (error "Can't activate input method `%s'" input-method)) |
278dd6ac | 1043 | (setq current-input-method-title nil) |
8efc03e1 KH |
1044 | (let ((func (nth 2 slot))) |
1045 | (if (functionp func) | |
1046 | (apply (nth 2 slot) input-method (nthcdr 5 slot)) | |
1047 | (if (and (consp func) (symbolp (car func)) (symbolp (cdr func))) | |
1048 | (progn | |
1049 | (require (cdr func)) | |
1050 | (apply (car func) input-method (nthcdr 5 slot))) | |
1051 | (error "Can't activate input method `%s'" input-method)))) | |
d0b9c3ab | 1052 | (setq current-input-method input-method) |
278dd6ac KH |
1053 | (or (stringp current-input-method-title) |
1054 | (setq current-input-method-title (nth 3 slot))) | |
28885c0e KH |
1055 | (unwind-protect |
1056 | (run-hooks 'input-method-activate-hook) | |
1057 | (force-mode-line-update))))) | |
15b3e511 | 1058 | |
15b3e511 | 1059 | (defun inactivate-input-method () |
f17ccaee | 1060 | "Turn off the current input method." |
723a427a KH |
1061 | (when current-input-method |
1062 | (if input-method-history | |
1063 | (unless (string= current-input-method (car input-method-history)) | |
1064 | (setq input-method-history | |
1065 | (cons current-input-method | |
1066 | (delete current-input-method input-method-history)))) | |
1067 | (setq input-method-history (list current-input-method))) | |
1068 | (unwind-protect | |
1069 | (funcall inactivate-current-input-method-function) | |
15b3e511 | 1070 | (unwind-protect |
723a427a KH |
1071 | (run-hooks 'input-method-inactivate-hook) |
1072 | (setq current-input-method nil | |
2b1ec973 | 1073 | input-method-function nil |
28885c0e KH |
1074 | current-input-method-title nil) |
1075 | (force-mode-line-update))))) | |
4ed46869 | 1076 | |
8b784951 | 1077 | (defun set-input-method (input-method) |
2c395d56 | 1078 | "Select and activate input method INPUT-METHOD for the current buffer. |
bc406911 | 1079 | This also sets the default input method to the one you specify. |
402dbbd1 EZ |
1080 | If INPUT-METHOD is nil, this function turns off the input method, and |
1081 | also causes you to be prompted for a name of an input method the next | |
1082 | time you invoke \\[toggle-input-method]. | |
1083 | ||
bc406911 EZ |
1084 | To deactivate the input method interactively, use \\[toggle-input-method]. |
1085 | To deactivate it programmatically, use \\[inactivate-input-method]." | |
d0b9c3ab | 1086 | (interactive |
723a427a | 1087 | (let* ((default (or (car input-method-history) default-input-method))) |
42395763 | 1088 | (list (read-input-method-name |
87505a98 | 1089 | (if default "Select input method (default %s): " "Select input method: ") |
42395763 | 1090 | default t)))) |
d0b9c3ab | 1091 | (activate-input-method input-method) |
f4990970 PA |
1092 | (setq default-input-method input-method) |
1093 | (when (interactive-p) | |
1094 | (customize-mark-as-set 'default-input-method)) | |
1095 | default-input-method) | |
4ed46869 KH |
1096 | |
1097 | (defun toggle-input-method (&optional arg) | |
f8ec20be RS |
1098 | "Enable or disable multilingual text input method for the current buffer. |
1099 | Only one input method can be enabled at any time in a given buffer. | |
1100 | ||
1101 | The normal action is to enable an input method if none was | |
1102 | enabled, and disable the current one otherwise. Which input method | |
1103 | to enable can be determined in various ways--either the one most | |
1104 | recently used, or the one specified by `default-input-method', or | |
1105 | as a last resort by reading the name of an input method in the | |
1106 | minibuffer. | |
1107 | ||
1108 | With a prefix argument, read an input method name with the minibuffer | |
1109 | and enable that one. The default is the most recent input method specified | |
f2979bdb | 1110 | \(not including the currently active input method, if any)." |
f8ec20be | 1111 | |
4ed46869 | 1112 | (interactive "P") |
7ddbb5bc RS |
1113 | (if (and current-input-method (not arg)) |
1114 | (inactivate-input-method) | |
1115 | (let ((default (or (car input-method-history) default-input-method))) | |
1116 | (if (and arg default (equal current-input-method default) | |
1117 | (> (length input-method-history) 1)) | |
1118 | (setq default (nth 1 input-method-history))) | |
723a427a KH |
1119 | (activate-input-method |
1120 | (if (or arg (not default)) | |
7ddbb5bc RS |
1121 | (progn |
1122 | (read-input-method-name | |
1123 | (if default "Input method (default %s): " "Input method: " ) | |
1124 | default t)) | |
723a427a | 1125 | default)) |
f4990970 PA |
1126 | (unless default-input-method |
1127 | (prog1 | |
1128 | (setq default-input-method current-input-method) | |
1129 | (when (interactive-p) | |
1130 | (customize-mark-as-set 'default-input-method))))))) | |
d0b9c3ab | 1131 | |
0855c6cd DL |
1132 | (eval-when-compile (autoload 'help-buffer "help-mode")) |
1133 | ||
d0b9c3ab | 1134 | (defun describe-input-method (input-method) |
2c395d56 | 1135 | "Describe input method INPUT-METHOD." |
d0b9c3ab KH |
1136 | (interactive |
1137 | (list (read-input-method-name | |
1138 | "Describe input method (default, current choice): "))) | |
78754934 | 1139 | (if (and input-method (symbolp input-method)) |
4ef06f75 | 1140 | (setq input-method (symbol-name input-method))) |
43125c28 RS |
1141 | (help-setup-xref (list #'describe-input-method |
1142 | (or input-method current-input-method)) | |
f80e2142 RS |
1143 | (interactive-p)) |
1144 | ||
d0b9c3ab KH |
1145 | (if (null input-method) |
1146 | (describe-current-input-method) | |
464cc130 KH |
1147 | (let ((current current-input-method)) |
1148 | (condition-case nil | |
1149 | (progn | |
1150 | (save-excursion | |
1151 | (activate-input-method input-method) | |
1152 | (describe-current-input-method)) | |
1153 | (activate-input-method current)) | |
1154 | (error | |
1155 | (activate-input-method current) | |
5f395df3 SM |
1156 | (help-setup-xref (list #'describe-input-method input-method) |
1157 | (interactive-p)) | |
1158 | (with-output-to-temp-buffer (help-buffer) | |
464cc130 KH |
1159 | (let ((elt (assoc input-method input-method-alist))) |
1160 | (princ (format | |
1161 | "Input method: %s (`%s' in mode line) for %s\n %s\n" | |
1162 | input-method (nth 3 elt) (nth 1 elt) (nth 4 elt)))))))))) | |
d0b9c3ab KH |
1163 | |
1164 | (defun describe-current-input-method () | |
f80e2142 RS |
1165 | "Describe the input method currently in use. |
1166 | This is a subroutine for `describe-input-method'." | |
4ed46869 KH |
1167 | (if current-input-method |
1168 | (if (and (symbolp describe-current-input-method-function) | |
1169 | (fboundp describe-current-input-method-function)) | |
1170 | (funcall describe-current-input-method-function) | |
1171 | (message "No way to describe the current input method `%s'" | |
f2979bdb | 1172 | current-input-method) |
4ed46869 | 1173 | (ding)) |
d0b9c3ab | 1174 | (error "No input method is activated now"))) |
4ed46869 | 1175 | |
d3459641 | 1176 | (defun read-multilingual-string (prompt &optional initial-input input-method) |
4ed46869 KH |
1177 | "Read a multilingual string from minibuffer, prompting with string PROMPT. |
1178 | The input method selected last time is activated in minibuffer. | |
15b3e511 | 1179 | If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer |
d0b9c3ab KH |
1180 | initially. |
1181 | Optional 3rd argument INPUT-METHOD specifies the input method | |
4ef06f75 KH |
1182 | to be activated instead of the one selected last time. It is a symbol |
1183 | or a string." | |
88d559ec KH |
1184 | (setq input-method |
1185 | (or input-method | |
d3459641 | 1186 | current-input-method |
88d559ec KH |
1187 | default-input-method |
1188 | (read-input-method-name "Input method: " nil t))) | |
3df60841 | 1189 | (if (and input-method (symbolp input-method)) |
4ef06f75 | 1190 | (setq input-method (symbol-name input-method))) |
305a3cb6 KH |
1191 | (let ((prev-input-method current-input-method)) |
1192 | (unwind-protect | |
1193 | (progn | |
1194 | (activate-input-method input-method) | |
1195 | (read-string prompt initial-input nil nil t)) | |
1196 | (activate-input-method prev-input-method)))) | |
4ed46869 KH |
1197 | |
1198 | ;; Variables to control behavior of input methods. All input methods | |
1199 | ;; should react to these variables. | |
1200 | ||
8efc03e1 KH |
1201 | (defcustom input-method-verbose-flag 'default |
1202 | "*A flag to control extra guidance given by input methods. | |
1203 | The value should be nil, t, `complex-only', or `default'. | |
4ed46869 | 1204 | |
cb29dfb6 | 1205 | The extra guidance is done by showing list of available keys in echo |
8efc03e1 KH |
1206 | area. When you use the input method in the minibuffer, the guidance |
1207 | is shown at the bottom short window (split from the existing window). | |
c27c4ed8 | 1208 | |
8efc03e1 KH |
1209 | If the value is t, extra guidance is always given, if the value is |
1210 | nil, extra guidance is always suppressed. | |
1211 | ||
1212 | If the value is `complex-only', only complex input methods such as | |
1213 | `chinese-py' and `japanese' give extra guidance. | |
1214 | ||
1215 | If the value is `default', complex input methods always give extra | |
1216 | guidance, but simple input methods give it only when you are not in | |
1217 | the minibuffer. | |
1218 | ||
1219 | See also the variable `input-method-highlight-flag'." | |
1220 | :type '(choice (const t) (const nil) (const complex-only) (const default)) | |
42395763 RS |
1221 | :group 'mule) |
1222 | ||
1223 | (defcustom input-method-highlight-flag t | |
1224 | "*If this flag is non-nil, input methods highlight partially-entered text. | |
1225 | For instance, while you are in the middle of a Quail input method sequence, | |
1226 | the text inserted so far is temporarily underlined. | |
8efc03e1 KH |
1227 | The underlining goes away when you finish or abort the input method sequence. |
1228 | See also the variable `input-method-verbose-flag'." | |
42395763 RS |
1229 | :type 'boolean |
1230 | :group 'mule) | |
4ed46869 KH |
1231 | |
1232 | (defvar input-method-activate-hook nil | |
f17ccaee KH |
1233 | "Normal hook run just after an input method is activated. |
1234 | ||
1235 | The variable `current-input-method' keeps the input method name | |
1236 | just activated.") | |
4ed46869 KH |
1237 | |
1238 | (defvar input-method-inactivate-hook nil | |
f17ccaee KH |
1239 | "Normal hook run just after an input method is inactivated. |
1240 | ||
1241 | The variable `current-input-method' still keeps the input method name | |
4d0e6a11 | 1242 | just inactivated.") |
4ed46869 KH |
1243 | |
1244 | (defvar input-method-after-insert-chunk-hook nil | |
1245 | "Normal hook run just after an input method insert some chunk of text.") | |
1246 | ||
dccca980 | 1247 | (defvar input-method-exit-on-first-char nil |
0b6cadff | 1248 | "This flag controls when an input method returns. |
dccca980 KH |
1249 | Usually, the input method does not return while there's a possibility |
1250 | that it may find a different translation if a user types another key. | |
39e643e2 RS |
1251 | But, it this flag is non-nil, the input method returns as soon as |
1252 | the current key sequence gets long enough to have some valid translation.") | |
dccca980 KH |
1253 | |
1254 | (defvar input-method-use-echo-area nil | |
1255 | "This flag controls how an input method shows an intermediate key sequence. | |
39e643e2 RS |
1256 | Usually, the input method inserts the intermediate key sequence, |
1257 | or candidate translations corresponding to the sequence, | |
1258 | at point in the current buffer. | |
1259 | But, if this flag is non-nil, it displays them in echo area instead.") | |
dccca980 | 1260 | |
723a427a KH |
1261 | (defvar input-method-exit-on-invalid-key nil |
1262 | "This flag controls the behaviour of an input method on invalid key input. | |
1263 | Usually, when a user types a key which doesn't start any character | |
1264 | handled by the input method, the key is handled by turning off the | |
e8dd0160 | 1265 | input method temporarily. After that key, the input method is re-enabled. |
723a427a KH |
1266 | But, if this flag is non-nil, the input method is never back on.") |
1267 | ||
4ed46869 | 1268 | \f |
8efc03e1 KH |
1269 | (defvar set-language-environment-hook nil |
1270 | "Normal hook run after some language environment is set. | |
1271 | ||
1272 | When you set some hook function here, that effect usually should not | |
1273 | be inherited to another language environment. So, you had better set | |
1274 | another function in `exit-language-environment-hook' (which see) to | |
1275 | cancel the effect.") | |
1276 | ||
1277 | (defvar exit-language-environment-hook nil | |
1278 | "Normal hook run after exiting from some language environment. | |
1279 | When this hook is run, the variable `current-language-environment' | |
1280 | is still bound to the language environment being exited. | |
1281 | ||
e8dd0160 | 1282 | This hook is mainly used for canceling the effect of |
8efc03e1 KH |
1283 | `set-language-environment-hook' (which-see).") |
1284 | ||
b0648a00 RS |
1285 | (put 'setup-specified-language-environment 'apropos-inhibit t) |
1286 | ||
15b3e511 | 1287 | (defun setup-specified-language-environment () |
f08adf27 | 1288 | "Switch to a specified language environment." |
15b3e511 | 1289 | (interactive) |
f850d782 | 1290 | (let (language-name) |
15b3e511 KH |
1291 | (if (and (symbolp last-command-event) |
1292 | (or (not (eq last-command-event 'Default)) | |
1293 | (setq last-command-event 'English)) | |
f850d782 | 1294 | (setq language-name (symbol-name last-command-event))) |
f4990970 PA |
1295 | (prog1 |
1296 | (set-language-environment language-name) | |
1297 | (customize-mark-as-set 'current-language-environment)) | |
15b3e511 | 1298 | (error "Bogus calling sequence")))) |
4ed46869 | 1299 | |
8861c593 | 1300 | (defcustom current-language-environment "English" |
94d04df6 | 1301 | "The last language environment specified with `set-language-environment'. |
ebef6d93 KH |
1302 | This variable should be set only with \\[customize], which is equivalent |
1303 | to using the function `set-language-environment'." | |
94d04df6 | 1304 | :link '(custom-manual "(emacs)Language Environments") |
dff1aa24 | 1305 | :set (lambda (symbol value) (set-language-environment value)) |
94d04df6 DL |
1306 | :get (lambda (x) |
1307 | (or (car-safe (assoc-ignore-case | |
1308 | (if (symbolp current-language-environment) | |
1309 | (symbol-name current-language-environment) | |
1310 | current-language-environment) | |
1311 | language-info-alist)) | |
1312 | "English")) | |
1313 | :type (cons 'choice (mapcar (lambda (lang) | |
1314 | (list 'const (car lang))) | |
1315 | language-info-alist)) | |
8861c593 RS |
1316 | :initialize 'custom-initialize-default |
1317 | :group 'mule | |
1318 | :type 'string) | |
f850d782 | 1319 | |
ddb5c041 KH |
1320 | (defun reset-language-environment () |
1321 | "Reset multilingual environment of Emacs to the default status. | |
1322 | ||
1323 | The default status is as follows: | |
1324 | ||
1325 | The default value of buffer-file-coding-system is nil. | |
1326 | The default coding system for process I/O is nil. | |
1327 | The default value for the command `set-terminal-coding-system' is nil. | |
1328 | The default value for the command `set-keyboard-coding-system' is nil. | |
1329 | ||
97941b05 KH |
1330 | The order of priorities of coding systems are as follows: |
1331 | utf-8 | |
1332 | iso-2022-7bit | |
1333 | iso-latin-1 | |
1334 | iso-2022-7bit-lock | |
1335 | iso-2022-8bit-ss2 | |
1336 | emacs-mule | |
1337 | raw-text" | |
ddb5c041 KH |
1338 | (interactive) |
1339 | ;; This function formerly set default-enable-multibyte-characters to t, | |
1340 | ;; but that is incorrect. It should not alter the unibyte/multibyte choice. | |
1341 | ||
97941b05 KH |
1342 | (set-coding-system-priority |
1343 | 'utf-8 | |
1344 | 'iso-2022-7bit | |
1345 | 'iso-latin-1 | |
1346 | 'iso-2022-7bit-lock | |
1347 | 'iso-2022-8bit-ss2 | |
1348 | 'emacs-mule | |
1349 | 'raw-text) | |
1350 | ||
ddb5c041 | 1351 | (set-default-coding-systems nil) |
b5edd1d1 | 1352 | (setq default-sendmail-coding-system 'iso-latin-1) |
0c47a7c8 | 1353 | (setq default-process-coding-system '(undecided . iso-latin-1)) |
b5edd1d1 | 1354 | |
ddb5c041 KH |
1355 | ;; Don't alter the terminal and keyboard coding systems here. |
1356 | ;; The terminal still supports the same coding system | |
1357 | ;; that it supported a minute ago. | |
843f91fd RS |
1358 | ;;; (set-terminal-coding-system-internal nil) |
1359 | ;;; (set-keyboard-coding-system-internal nil) | |
ddb5c041 KH |
1360 | |
1361 | (setq nonascii-translation-table nil | |
97941b05 KH |
1362 | nonascii-insert-offset 0) |
1363 | (set-primary-charset 'iso-8859-1)) | |
ddb5c041 | 1364 | |
0c47a7c8 KH |
1365 | (reset-language-environment) |
1366 | ||
40c81f74 PE |
1367 | (defun set-display-table-and-terminal-coding-system (language-name) |
1368 | "Set up the display table and terminal coding system for LANGUAGE-NAME." | |
1369 | (let ((coding (get-language-info language-name 'unibyte-display))) | |
1370 | (if coding | |
1371 | (standard-display-european-internal) | |
1372 | (standard-display-default (if (eq window-system 'pc) 128 160) 255) | |
1373 | (aset standard-display-table 146 nil)) | |
1374 | (or (eq window-system 'pc) | |
1375 | (set-terminal-coding-system coding)))) | |
1376 | ||
166246f7 | 1377 | (defun set-language-environment (language-name) |
6c05d680 RS |
1378 | "Set up multi-lingual environment for using LANGUAGE-NAME. |
1379 | This sets the coding system priority and the default input method | |
8861c593 RS |
1380 | and sometimes other things. LANGUAGE-NAME should be a string |
1381 | which is the name of a language environment. For example, \"Latin-1\" | |
1382 | specifies the character set for the major languages of Western Europe." | |
8efc03e1 | 1383 | (interactive (list (read-language-name |
ddb5c041 | 1384 | nil |
8efc03e1 | 1385 | "Set language environment (default, English): "))) |
4ef06f75 KH |
1386 | (if language-name |
1387 | (if (symbolp language-name) | |
1388 | (setq language-name (symbol-name language-name))) | |
1389 | (setq language-name "English")) | |
ddb5c041 | 1390 | (or (assoc-ignore-case language-name language-info-alist) |
f850d782 | 1391 | (error "Language environment not defined: %S" language-name)) |
8efc03e1 KH |
1392 | (if current-language-environment |
1393 | (let ((func (get-language-info current-language-environment | |
1394 | 'exit-function))) | |
e63645c2 | 1395 | (run-hooks 'exit-language-environment-hook) |
5f395df3 | 1396 | (if (functionp func) (funcall func)))) |
03c35c83 EZ |
1397 | (let ((default-eol-type (coding-system-eol-type |
1398 | default-buffer-file-coding-system))) | |
1399 | (reset-language-environment) | |
ddb5c041 | 1400 | |
9c20a8d5 DL |
1401 | ;; The fetaures might set up coding systems. |
1402 | (let ((required-features (get-language-info language-name 'features))) | |
1403 | (while required-features | |
1404 | (require (car required-features)) | |
1405 | (setq required-features (cdr required-features)))) | |
1406 | ||
03c35c83 EZ |
1407 | (setq current-language-environment language-name) |
1408 | (set-language-environment-coding-systems language-name default-eol-type)) | |
ddb5c041 KH |
1409 | (let ((input-method (get-language-info language-name 'input-method))) |
1410 | (when input-method | |
1411 | (setq default-input-method input-method) | |
1412 | (if input-method-history | |
1413 | (setq input-method-history | |
1414 | (cons input-method | |
1415 | (delete input-method input-method-history)))))) | |
97941b05 KH |
1416 | |
1417 | ;; Note: For DOS, we assumed that the charset cpXXX is already | |
1418 | ;; defined. | |
1419 | (let ((nonascii (get-language-info language-name 'nonascii-translation))) | |
1420 | (if (eq window-system 'pc) | |
1421 | (setq nonascii (intern "cp%d" dos-codepage))) | |
1422 | (or (charsetp nonascii) | |
1423 | (setq nonascii 'iso-8859-1)) | |
1424 | (set-primary-charset nonascii)) | |
ddb5c041 | 1425 | |
63283a8f | 1426 | ;; Unibyte setups if necessary. |
ddb5c041 | 1427 | (unless default-enable-multibyte-characters |
63283a8f | 1428 | ;; Syntax and case table. |
ddb5c041 KH |
1429 | (let ((syntax (get-language-info language-name 'unibyte-syntax))) |
1430 | (if syntax | |
1431 | (let ((set-case-syntax-set-multibyte nil)) | |
63283a8f KH |
1432 | (load syntax nil t)) |
1433 | ;; No information for syntax and case. Reset to the defaults. | |
1434 | (let ((syntax-table (standard-syntax-table)) | |
1435 | (case-table (standard-case-table)) | |
03c35c83 | 1436 | (ch (if (eq window-system 'pc) 128 160))) |
63283a8f KH |
1437 | (while (< ch 256) |
1438 | (modify-syntax-entry ch " " syntax-table) | |
1439 | (aset case-table ch ch) | |
1440 | (setq ch (1+ ch))) | |
1441 | (set-char-table-extra-slot case-table 0 nil) | |
1442 | (set-char-table-extra-slot case-table 1 nil) | |
1443 | (set-char-table-extra-slot case-table 2 nil)) | |
1444 | (set-standard-case-table (standard-case-table)) | |
1445 | (let ((list (buffer-list))) | |
1446 | (while list | |
1447 | (with-current-buffer (car list) | |
1448 | (set-case-table (standard-case-table))) | |
1449 | (setq list (cdr list)))))) | |
40c81f74 | 1450 | (set-display-table-and-terminal-coding-system language-name)) |
ddb5c041 KH |
1451 | |
1452 | (let ((required-features (get-language-info language-name 'features))) | |
1453 | (while required-features | |
1454 | (require (car required-features)) | |
1455 | (setq required-features (cdr required-features)))) | |
1456 | (let ((func (get-language-info language-name 'setup-function))) | |
5f395df3 | 1457 | (if (functionp func) |
ddb5c041 | 1458 | (funcall func))) |
8efc03e1 | 1459 | (run-hooks 'set-language-environment-hook) |
f850d782 | 1460 | (force-mode-line-update t)) |
4ed46869 | 1461 | |
51a8fc1d RS |
1462 | (defun standard-display-european-internal () |
1463 | ;; Actually set up direct output of non-ASCII characters. | |
03c35c83 EZ |
1464 | (standard-display-8bit (if (eq window-system 'pc) 128 160) 255) |
1465 | ;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with | |
1466 | ;; the native font, and codes 160 and 146 stand for something very | |
1467 | ;; different there. | |
1468 | (or (and (eq window-system 'pc) (not default-enable-multibyte-characters)) | |
1469 | (progn | |
1470 | ;; Make non-line-break space display as a plain space. | |
1471 | ;; Most X fonts do the wrong thing for code 160. | |
1472 | (aset standard-display-table 160 [32]) | |
1492f7ac DL |
1473 | ;; With luck, non-Latin-1 fonts are more recent and so don't |
1474 | ;; have this bug. | |
1475 | (aset standard-display-table 2208 [32]) ; Latin-1 NBSP | |
1476 | ;; Most Windows programs send out apostrophes as \222. Most X fonts | |
03c35c83 | 1477 | ;; don't contain a character at that position. Map it to the ASCII |
5f395df3 SM |
1478 | ;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK, |
1479 | ;; U+2019, normally from the windows-1252 character set. XFree 4 | |
1480 | ;; fonts probably have the appropriate glyph at this position, | |
1481 | ;; so they could use standard-display-8bit. It's better to use a | |
1482 | ;; proper windows-1252 coding system. --fx] | |
03c35c83 EZ |
1483 | (aset standard-display-table 146 [39])))) |
1484 | ||
1485 | (defun set-language-environment-coding-systems (language-name | |
1486 | &optional eol-type) | |
1487 | "Do various coding system setups for language environment LANGUAGE-NAME. | |
1488 | ||
1489 | The optional arg EOL-TYPE specifies the eol-type of the default value | |
1490 | of buffer-file-coding-system set by this function." | |
54b226f7 KH |
1491 | (let* ((priority (get-language-info language-name 'coding-priority)) |
1492 | (default-coding (car priority))) | |
97941b05 KH |
1493 | (when priority |
1494 | (set-default-coding-systems | |
1495 | (if (memq eol-type '(0 1 2 unix dos mac)) | |
1496 | (coding-system-change-eol-conversion default-coding eol-type) | |
1497 | default-coding)) | |
1498 | (setq default-sendmail-coding-system default-coding) | |
1499 | (apply 'set-coding-system-priority priority)))) | |
54b226f7 | 1500 | |
4ed46869 KH |
1501 | ;; Print all arguments with `princ', then print "\n". |
1502 | (defsubst princ-list (&rest args) | |
1503 | (while args (princ (car args)) (setq args (cdr args))) | |
1504 | (princ "\n")) | |
1505 | ||
b0648a00 RS |
1506 | (put 'describe-specified-language-support 'apropos-inhibit t) |
1507 | ||
48082651 | 1508 | ;; Print a language specific information such as input methods, |
13e82c04 | 1509 | ;; charsets, and coding systems. This function is intended to be |
48082651 | 1510 | ;; called from the menu: |
281d03ec | 1511 | ;; [menu-bar mule describe-language-environment LANGUAGE] |
48082651 KH |
1512 | ;; and should not run it by `M-x describe-current-input-method-function'. |
1513 | (defun describe-specified-language-support () | |
96db204a | 1514 | "Describe how Emacs supports the specified language environment." |
48082651 | 1515 | (interactive) |
281d03ec | 1516 | (let (language-name) |
48082651 | 1517 | (if (not (and (symbolp last-command-event) |
cda74479 DL |
1518 | (or (not (eq last-command-event 'Default)) |
1519 | (setq last-command-event 'English)) | |
281d03ec | 1520 | (setq language-name (symbol-name last-command-event)))) |
48082651 | 1521 | (error "Bogus calling sequence")) |
281d03ec RS |
1522 | (describe-language-environment language-name))) |
1523 | ||
1524 | (defun describe-language-environment (language-name) | |
1525 | "Describe how Emacs supports language environment LANGUAGE-NAME." | |
78754934 KH |
1526 | (interactive |
1527 | (list (read-language-name | |
1528 | 'documentation | |
8adfa8be | 1529 | "Describe language environment (default, current choice): "))) |
f850d782 RS |
1530 | (if (null language-name) |
1531 | (setq language-name current-language-environment)) | |
281d03ec RS |
1532 | (if (or (null language-name) |
1533 | (null (get-language-info language-name 'documentation))) | |
1534 | (error "No documentation for the specified language")) | |
4ef06f75 KH |
1535 | (if (symbolp language-name) |
1536 | (setq language-name (symbol-name language-name))) | |
464cc130 KH |
1537 | (let ((doc (get-language-info language-name 'documentation)) |
1538 | pos) | |
c3034e84 SM |
1539 | (help-setup-xref (list #'describe-language-environment language-name) |
1540 | (interactive-p)) | |
1541 | (with-output-to-temp-buffer (help-buffer) | |
464cc130 KH |
1542 | (save-excursion |
1543 | (set-buffer standard-output) | |
1544 | (insert language-name " language environment\n\n") | |
1545 | (if (stringp doc) | |
1546 | (insert doc "\n\n")) | |
e036b0a6 KH |
1547 | (condition-case nil |
1548 | (let ((str (eval (get-language-info language-name 'sample-text)))) | |
1549 | (if (stringp str) | |
1550 | (insert "Sample text:\n " str "\n\n"))) | |
1551 | (error nil)) | |
464cc130 KH |
1552 | (let ((input-method (get-language-info language-name 'input-method)) |
1553 | (l (copy-sequence input-method-alist))) | |
1554 | (insert "Input methods") | |
1555 | (when input-method | |
1556 | (insert " (default, " input-method ")") | |
1557 | (setq input-method (assoc input-method input-method-alist)) | |
1558 | (setq l (cons input-method (delete input-method l)))) | |
1559 | (insert ":\n") | |
48082651 | 1560 | (while l |
464cc130 KH |
1561 | (when (string= language-name (nth 1 (car l))) |
1562 | (insert " " (car (car l))) | |
1563 | (search-backward (car (car l))) | |
467412aa | 1564 | (help-xref-button 0 'help-input-method (car (car l))) |
464cc130 | 1565 | (goto-char (point-max)) |
2fa7e202 KH |
1566 | (insert " (\"" |
1567 | (if (stringp (nth 3 (car l))) | |
1568 | (nth 3 (car l)) | |
1569 | (car (nth 3 (car l)))) | |
1570 | "\" in mode line)\n")) | |
464cc130 KH |
1571 | (setq l (cdr l))) |
1572 | (insert "\n")) | |
1573 | (insert "Character sets:\n") | |
1574 | (let ((l (get-language-info language-name 'charset))) | |
1575 | (if (null l) | |
1576 | (insert " nothing specific to " language-name "\n") | |
1577 | (while l | |
1578 | (insert " " (symbol-name (car l))) | |
1579 | (search-backward (symbol-name (car l))) | |
467412aa | 1580 | (help-xref-button 0 'help-character-set (car l)) |
464cc130 KH |
1581 | (goto-char (point-max)) |
1582 | (insert ": " (charset-description (car l)) "\n") | |
1583 | (setq l (cdr l))))) | |
1584 | (insert "\n") | |
1585 | (insert "Coding systems:\n") | |
1586 | (let ((l (get-language-info language-name 'coding-system))) | |
1587 | (if (null l) | |
1588 | (insert " nothing specific to " language-name "\n") | |
1589 | (while l | |
1590 | (insert " " (symbol-name (car l))) | |
1591 | (search-backward (symbol-name (car l))) | |
467412aa | 1592 | (help-xref-button 0 'help-coding-system (car l)) |
464cc130 KH |
1593 | (goto-char (point-max)) |
1594 | (insert " (`" | |
1595 | (coding-system-mnemonic (car l)) | |
1596 | "' in mode line):\n\t" | |
1597 | (coding-system-doc-string (car l)) | |
1598 | "\n") | |
0855c6cd | 1599 | (let ((aliases (coding-system-aliases (car l)))) |
464cc130 KH |
1600 | (when aliases |
1601 | (insert "\t(alias:") | |
1602 | (while aliases | |
1603 | (insert " " (symbol-name (car aliases))) | |
1604 | (setq aliases (cdr aliases))) | |
1605 | (insert ")\n"))) | |
c3034e84 | 1606 | (setq l (cdr l))))))))) |
4ed46869 | 1607 | \f |
40c81f74 PE |
1608 | ;;; Locales. |
1609 | ||
0d7c5bb9 DL |
1610 | (defvar locale-translation-file-name nil |
1611 | "File name for the system's file of locale-name aliases, or nil if none.") | |
40c81f74 | 1612 | |
5f395df3 SM |
1613 | ;; The following definitions might as well be marked as constants and |
1614 | ;; purecopied, since they're normally used on startup, and probably | |
1615 | ;; should reflect the facilities of the base Emacs. | |
1616 | (defconst locale-language-names | |
1617 | (purecopy | |
1618 | '( | |
40c81f74 PE |
1619 | ;; Locale names of the form LANGUAGE[_TERRITORY][.CODESET][@MODIFIER] |
1620 | ;; as specified in the Single Unix Spec, Version 2. | |
1621 | ;; LANGUAGE is a language code taken from ISO 639:1988 (E/F) | |
1622 | ;; with additions from ISO 639/RA Newsletter No.1/1989; | |
5f395df3 SM |
1623 | ;; see Internet RFC 2165 (1997-06) and |
1624 | ;; http://www.evertype.com/standards/iso639/iso639-en.html | |
1625 | ;; TERRITORY is a country code taken from ISO 3166 | |
1626 | ;; http://www.din.de/gremien/nas/nabd/iso3166ma/codlstp1/en_listp1.html. | |
40c81f74 | 1627 | ;; CODESET and MODIFIER are implementation-dependent. |
5f395df3 | 1628 | |
40c81f74 PE |
1629 | ; aa Afar |
1630 | ; ab Abkhazian | |
6ececc4d | 1631 | ("af" . "Latin-1") ; Afrikaans |
40c81f74 | 1632 | ("am" . "Ethiopic") ; Amharic |
5f395df3 | 1633 | ; ar Arabic glibc uses 8859-6 |
40c81f74 PE |
1634 | ; as Assamese |
1635 | ; ay Aymara | |
1636 | ; az Azerbaijani | |
1637 | ; ba Bashkir | |
15f2c48a | 1638 | ("be" . "Belarusian") ; Belarusian [Byelorussian until early 1990s] |
9c20a8d5 | 1639 | ("bg" . "Bulgarian") ; Bulgarian |
40c81f74 PE |
1640 | ; bh Bihari |
1641 | ; bi Bislama | |
1642 | ; bn Bengali, Bangla | |
1643 | ("bo" . "Tibetan") | |
1644 | ("br" . "Latin-1") ; Breton | |
15f2c48a | 1645 | ("bs" . "Latin-2") ; Bosnian |
40c81f74 PE |
1646 | ("ca" . "Latin-1") ; Catalan |
1647 | ; co Corsican | |
1648 | ("cs" . "Czech") | |
15f2c48a | 1649 | ("cy" . "Welsh") ; Welsh |
40c81f74 PE |
1650 | ("da" . "Latin-1") ; Danish |
1651 | ("de" . "German") | |
1652 | ; dz Bhutani | |
1653 | ("el" . "Greek") | |
6ececc4d PE |
1654 | ;; Users who specify "en" explicitly typically want Latin-1, not ASCII. |
1655 | ("en" . "Latin-1") ; English | |
40c81f74 | 1656 | ("eo" . "Latin-3") ; Esperanto |
8c4b6822 | 1657 | ("es" . "Spanish") |
40c81f74 PE |
1658 | ("et" . "Latin-4") ; Estonian |
1659 | ("eu" . "Latin-1") ; Basque | |
15f2c48a | 1660 | ; fa Persian glibc uses utf-8 |
40c81f74 PE |
1661 | ("fi" . "Latin-1") ; Finnish |
1662 | ; fj Fiji | |
1663 | ("fo" . "Latin-1") ; Faroese | |
8d738cfd | 1664 | ("fr" . "French") ; French |
40c81f74 | 1665 | ("fy" . "Latin-1") ; Frisian |
6ececc4d PE |
1666 | ("ga" . "Latin-1") ; Irish Gaelic (new orthography) |
1667 | ("gd" . "Latin-1") ; Scots Gaelic | |
1668 | ("gl" . "Latin-1") ; Galician | |
40c81f74 PE |
1669 | ; gn Guarani |
1670 | ; gu Gujarati | |
15f2c48a | 1671 | ("gv" . "Latin-8") ; Manx Gaelic glibc uses 8859-1 |
40c81f74 PE |
1672 | ; ha Hausa |
1673 | ("he" . "Hebrew") | |
5f395df3 | 1674 | ("hi" . "Devanagari") ; Hindi glibc uses utf-8 |
40c81f74 PE |
1675 | ("hr" . "Latin-2") ; Croatian |
1676 | ("hu" . "Latin-2") ; Hungarian | |
1677 | ; hy Armenian | |
1678 | ; ia Interlingua | |
1679 | ("id" . "Latin-1") ; Indonesian | |
1680 | ; ie Interlingue | |
1681 | ; ik Inupiak | |
1682 | ("is" . "Latin-1") ; Icelandic | |
1683 | ("it" . "Latin-1") ; Italian | |
1684 | ; iu Inuktitut | |
1685 | ("ja" . "Japanese") | |
1686 | ; jw Javanese | |
9c20a8d5 | 1687 | ("ka" . "Georgian") ; Georgian |
40c81f74 | 1688 | ; kk Kazakh |
6ececc4d | 1689 | ("kl" . "Latin-1") ; Greenlandic |
40c81f74 PE |
1690 | ; km Cambodian |
1691 | ; kn Kannada | |
1692 | ("ko" . "Korean") | |
1693 | ; ks Kashmiri | |
1694 | ; ku Kurdish | |
5f395df3 | 1695 | ("kw" . "Latin-1") ; Cornish |
40c81f74 PE |
1696 | ; ky Kirghiz |
1697 | ("la" . "Latin-1") ; Latin | |
5f395df3 | 1698 | ("lb" . "Latin-1") ; Luxemburgish |
40c81f74 PE |
1699 | ; ln Lingala |
1700 | ("lo" . "Lao") ; Laothian | |
9c20a8d5 DL |
1701 | ("lt" . "Lithuanian") |
1702 | ("lv" . "Latvian") ; Latvian, Lettish | |
40c81f74 | 1703 | ; mg Malagasy |
5f395df3 | 1704 | ("mi" . "Latin-7") ; Maori |
15f2c48a | 1705 | ("mk" . "Cyrillic-ISO") ; Macedonian |
40c81f74 PE |
1706 | ; ml Malayalam |
1707 | ; mn Mongolian | |
1708 | ; mo Moldavian | |
5f395df3 SM |
1709 | ("mr" . "Devanagari") ; Marathi glibc uses utf-8 |
1710 | ("ms" . "Latin-1") ; Malay | |
40c81f74 PE |
1711 | ("mt" . "Latin-3") ; Maltese |
1712 | ; my Burmese | |
1713 | ; na Nauru | |
1714 | ("ne" . "Devanagari") ; Nepali | |
8c4b6822 | 1715 | ("nl" . "Dutch") |
40c81f74 | 1716 | ("no" . "Latin-1") ; Norwegian |
5f395df3 | 1717 | ("oc" . "Latin-1") ; Occitan |
40c81f74 PE |
1718 | ; om (Afan) Oromo |
1719 | ; or Oriya | |
1720 | ; pa Punjabi | |
1721 | ("pl" . "Latin-2") ; Polish | |
1722 | ; ps Pashto, Pushto | |
1723 | ("pt" . "Latin-1") ; Portuguese | |
1724 | ; qu Quechua | |
6ececc4d | 1725 | ("rm" . "Latin-1") ; Rhaeto-Romanic |
40c81f74 PE |
1726 | ; rn Kirundi |
1727 | ("ro" . "Romanian") | |
15f2c48a DL |
1728 | ("ru.*[_.]koi8\\(?:-r\\)?\\'" . "Cyrillic-KOI8") ; Russian |
1729 | ("ru" . "Cyrillic-ISO") ; Russian | |
40c81f74 PE |
1730 | ; rw Kinyarwanda |
1731 | ("sa" . "Devanagari") ; Sanskrit | |
1732 | ; sd Sindhi | |
5f395df3 | 1733 | ; se Northern Sami |
40c81f74 PE |
1734 | ; sg Sangho |
1735 | ("sh" . "Latin-2") ; Serbo-Croatian | |
1736 | ; si Sinhalese | |
1737 | ("sk" . "Slovak") | |
1738 | ("sl" . "Slovenian") | |
1739 | ; sm Samoan | |
1740 | ; sn Shona | |
1741 | ; so Somali | |
6ececc4d | 1742 | ("sq" . "Latin-1") ; Albanian |
40c81f74 | 1743 | ("sr" . "Latin-2") ; Serbian (Latin alphabet) |
15f2c48a | 1744 | ("sr.*@cyrillic" . "Cyrillic-ISO") ; per glibc |
40c81f74 PE |
1745 | ; ss Siswati |
1746 | ; st Sesotho | |
1747 | ; su Sundanese | |
1748 | ("sv" . "Latin-1") ; Swedish | |
1749 | ("sw" . "Latin-1") ; Swahili | |
5f395df3 SM |
1750 | ; ta Tamil glibc uses utf-8 |
1751 | ; te Telugu glibc uses utf-8 | |
15f2c48a | 1752 | ("tg" . "Tajik") |
40c81f74 PE |
1753 | ("th" . "Thai") |
1754 | ; ti Tigrinya | |
1755 | ; tk Turkmen | |
6ececc4d | 1756 | ("tl" . "Latin-1") ; Tagalog |
40c81f74 PE |
1757 | ; tn Setswana |
1758 | ; to Tonga | |
1759 | ("tr" . "Latin-5") ; Turkish | |
1760 | ; ts Tsonga | |
1761 | ; tt Tatar | |
1762 | ; tw Twi | |
1763 | ; ug Uighur | |
9c20a8d5 | 1764 | ("uk" . "Ukrainian") ; Ukrainian |
5f395df3 SM |
1765 | ; ur Urdu glibc uses utf-8 |
1766 | ("uz" . "Latin-1") ; Uzbek | |
1767 | ("vi" . "Vietnamese") ; glibc uses utf-8 | |
40c81f74 | 1768 | ; vo Volapuk |
15f2c48a | 1769 | ("wa" . "Latin-1") ; Walloon |
40c81f74 PE |
1770 | ; wo Wolof |
1771 | ; xh Xhosa | |
9c20a8d5 | 1772 | ("yi" . "Windows-1255") ; Yiddish |
40c81f74 PE |
1773 | ; yo Yoruba |
1774 | ; za Zhuang | |
5f395df3 SM |
1775 | |
1776 | ; glibc: | |
1777 | ; zh_CN.GB18030/GB18030 \ | |
5f395df3 | 1778 | ; zh_HK/BIG5-HKSCS \ |
5f395df3 | 1779 | |
40c81f74 | 1780 | ("zh.*[._]big5" . "Chinese-BIG5") |
15f2c48a DL |
1781 | ("zh.*[._].gbk" . "Chinese-GBK") |
1782 | ;; glibc has zh_TW.EUC-TW, with zh_TW defaulting to Big5 | |
40c81f74 PE |
1783 | ("zh_tw" . "Chinese-CNS") |
1784 | ("zh" . "Chinese-GB") | |
1785 | ; zu Zulu | |
1786 | ||
1787 | ;; ISO standard locales | |
1788 | ("c$" . "ASCII") | |
1789 | ("posix$" . "ASCII") | |
1790 | ||
40c81f74 PE |
1791 | ;; The "IPA" Emacs language environment does not correspond |
1792 | ;; to any ISO 639 code, so let it stand for itself. | |
1793 | ("ipa$" . "IPA") | |
1794 | ||
1795 | ;; Nonstandard or obsolete language codes | |
1796 | ("cz" . "Czech") ; e.g. Solaris 2.6 | |
1797 | ("ee" . "Latin-4") ; Estonian, e.g. X11R6.4 | |
1798 | ("iw" . "Hebrew") ; e.g. X11R6.4 | |
15f2c48a | 1799 | ("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4 |
40c81f74 | 1800 | ("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6 |
2e86ceaa | 1801 | ("jp" . "Japanese") ; e.g. MS Windows |
86d9e628 JR |
1802 | ("chs" . "Chinese-GB") ; MS Windows Chinese Simplified |
1803 | ("cht" . "Chinese-BIG5") ; MS Windows Chinese Traditional | |
367ca50f | 1804 | )) |
40c81f74 | 1805 | "List of pairs of locale regexps and language names. |
6ececc4d PE |
1806 | The first element whose locale regexp matches the start of a downcased locale |
1807 | specifies the language name corresponding to that locale. | |
40c81f74 PE |
1808 | If the language name is nil, there is no corresponding language environment.") |
1809 | ||
5f395df3 SM |
1810 | (defconst locale-charset-language-names |
1811 | (purecopy | |
1812 | '((".*8859[-_]?1\\>" . "Latin-1") | |
1813 | (".*8859[-_]?2\\>" . "Latin-2") | |
1814 | (".*8859[-_]?3\\>" . "Latin-3") | |
1815 | (".*8859[-_]?4\\>" . "Latin-4") | |
1816 | (".*8859[-_]?9\\>" . "Latin-5") | |
1817 | (".*8859[-_]?14\\>" . "Latin-8") | |
1818 | (".*8859[-_]?15\\>" . "Latin-9") | |
15f2c48a DL |
1819 | (".*utf\\(-?8\\)\\>" . "UTF-8") |
1820 | (".*@euro\\>" . "Latin-9"))) ; utf-8@euro exists, so put this last | |
6ececc4d PE |
1821 | "List of pairs of locale regexps and charset language names. |
1822 | The first element whose locale regexp matches the start of a downcased locale | |
1823 | specifies the language name whose charsets corresponds to that locale. | |
1824 | This language name is used if its charsets disagree with the charsets of | |
1825 | the language name that would otherwise be used for this locale.") | |
1826 | ||
5f395df3 SM |
1827 | (defconst locale-preferred-coding-systems |
1828 | (purecopy | |
1829 | '(("ja.*[._]euc" . japanese-iso-8bit) | |
1830 | ("ja.*[._]jis7" . iso-2022-jp) | |
1831 | ("ja.*[._]pck" . japanese-shift-jis) | |
1832 | ("ja.*[._]sjis" . japanese-shift-jis) | |
9c20a8d5 | 1833 | (".*[._]utf" . utf-8))) |
6ececc4d PE |
1834 | "List of pairs of locale regexps and preferred coding systems. |
1835 | The first element whose locale regexp matches the start of a downcased locale | |
1836 | specifies the coding system to prefer when using that locale.") | |
40c81f74 | 1837 | |
ddf6b836 SM |
1838 | (defconst standard-keyboard-coding-systems |
1839 | (purecopy | |
1840 | '(iso-latin-1 iso-latin-2 iso-latin-3 iso-latin-4 iso-latin-5 | |
1841 | iso-latin-6 iso-latin-7 iso-latin-8 iso-latin-9)) | |
1842 | "Coding systems that are commonly used for keyboards. | |
1843 | `set-locale-environment' will set the `keyboard-coding-system' if the | |
1844 | coding-system specified by the locale setting is a member of this list.") | |
1845 | ||
40c81f74 PE |
1846 | (defun locale-name-match (key alist) |
1847 | "Search for KEY in ALIST, which should be a list of regexp-value pairs. | |
1848 | Return the value corresponding to the first regexp that matches the | |
1849 | start of KEY, or nil if there is no match." | |
1850 | (let (element) | |
1851 | (while (and alist (not element)) | |
ddf6b836 | 1852 | (if (string-match (concat "\\`\\(?:" (car (car alist)) "\\)") key) |
40c81f74 PE |
1853 | (setq element (car alist))) |
1854 | (setq alist (cdr alist))) | |
1855 | (cdr element))) | |
1856 | ||
758f07de | 1857 | (defun set-locale-environment (&optional locale-name) |
40c81f74 | 1858 | "Set up multi-lingual environment for using LOCALE-NAME. |
758f07de RS |
1859 | This sets the language environment, the coding system priority, |
1860 | the default input method and sometimes other things. | |
1861 | ||
1862 | LOCALE-NAME should be a string | |
40c81f74 PE |
1863 | which is the name of a locale supported by the system; |
1864 | often it is of the form xx_XX.CODE, where xx is a language, | |
1865 | XX is a country, and CODE specifies a character set and coding system. | |
1866 | For example, the locale name \"ja_JP.EUC\" might name a locale | |
1867 | for Japanese in Japan using the `japanese-iso-8bit' coding-system. | |
1868 | ||
dc853354 DL |
1869 | If LOCALE-NAME is nil, its value is looked up via `locale-codeset' |
1870 | using nl_langinfo(3), if that function is available in the system's | |
1871 | library, otherwise it is simply taken from the environment variables | |
1872 | LC_ALL, LC_CTYPE and LANG \(the first one that is set). | |
40c81f74 PE |
1873 | |
1874 | The locale names supported by your system can typically be found in a | |
0812c1e8 | 1875 | directory named `/usr/share/locale' or `/usr/lib/locale'. LOCALE-NAME |
758f07de | 1876 | will be translated according to the table specified by |
0812c1e8 DL |
1877 | `locale-translation-file-name'. |
1878 | ||
1879 | See also `locale-charset-language-names', `locale-language-names', | |
1880 | `locale-preferred-coding-systems' and `locale-coding-system'." | |
758f07de RS |
1881 | (interactive "sSet environment for locale: ") |
1882 | ||
0d7c5bb9 DL |
1883 | ;; Do this at runtime for the sake of binaries possibly transported |
1884 | ;; to a system without X. | |
1885 | (setq locale-translation-file-name | |
1886 | (let ((files | |
1887 | '("/usr/lib/X11/locale/locale.alias" ; e.g. X11R6.4 | |
1888 | "/usr/X11R6/lib/X11/locale/locale.alias" ; e.g. RedHat 4.2 | |
1889 | "/usr/openwin/lib/locale/locale.alias" ; e.g. Solaris 2.6 | |
1890 | ;; | |
1891 | ;; The following name appears after the X-related names above, | |
1892 | ;; since the X-related names are what X actually uses. | |
1893 | "/usr/share/locale/locale.alias" ; GNU/Linux sans X | |
1894 | ))) | |
1895 | (while (and files (not (file-exists-p (car files)))) | |
1896 | (setq files (cdr files))) | |
1897 | (car files))) | |
1898 | ||
dc853354 | 1899 | (let ((locale (or locale-name (locale-codeset)))) |
7008ccac GM |
1900 | |
1901 | (unless locale | |
1902 | ;; Use the first of these three environment variables | |
1903 | ;; that has a nonempty value. | |
1904 | (let ((vars '("LC_ALL" "LC_CTYPE" "LANG"))) | |
1905 | (while (and vars (not (setq locale (getenv (car vars))))) | |
1906 | (setq vars (cdr vars))))) | |
1907 | ||
1908 | (when locale | |
1909 | ||
1910 | ;; Translate "swedish" into "sv_SE.ISO8859-1", and so on, | |
1911 | ;; using the translation file that many systems have. | |
1912 | (when locale-translation-file-name | |
1913 | (with-temp-buffer | |
1914 | (insert-file-contents locale-translation-file-name) | |
1915 | (when (re-search-forward | |
1916 | (concat "^" (regexp-quote locale) ":?[ \t]+") nil t) | |
1917 | (setq locale (buffer-substring (point) (line-end-position)))))) | |
1918 | ||
1919 | ;; Leave the system locales alone if the caller did not specify | |
1920 | ;; an explicit locale name, as their defaults are set from | |
1921 | ;; LC_MESSAGES and LC_TIME, not LC_CTYPE, and the user might not | |
1922 | ;; want to set them to the same value as LC_CTYPE. | |
1923 | (when locale-name | |
1924 | (setq system-messages-locale locale) | |
1925 | (setq system-time-locale locale)) | |
1926 | ||
1927 | (setq locale (downcase locale)) | |
1928 | ||
1929 | (let ((language-name | |
1930 | (locale-name-match locale locale-language-names)) | |
1931 | (charset-language-name | |
1932 | (locale-name-match locale locale-charset-language-names)) | |
1933 | (coding-system | |
1934 | (locale-name-match locale locale-preferred-coding-systems))) | |
1935 | ||
5f395df3 | 1936 | ;; Give preference to charset-language-name over language-name. |
7008ccac GM |
1937 | (if (and charset-language-name |
1938 | (not | |
1939 | (equal (get-language-info language-name 'charset) | |
1940 | (get-language-info charset-language-name 'charset)))) | |
1941 | (setq language-name charset-language-name)) | |
1942 | ||
1943 | (when language-name | |
1944 | ||
1945 | ;; Set up for this character set. This is now the right way | |
1946 | ;; to do it for both unibyte and multibyte modes. | |
1947 | (set-language-environment language-name) | |
1948 | ||
1949 | ;; If default-enable-multibyte-characters is nil, | |
1950 | ;; we are using single-byte characters, | |
1951 | ;; so the display table and terminal coding system are irrelevant. | |
1952 | (when default-enable-multibyte-characters | |
1953 | (set-display-table-and-terminal-coding-system language-name)) | |
1954 | ||
38b7e160 DL |
1955 | ;;; encoded-kbd-mode doesn't work properly at present, and i don't |
1956 | ;;; think this is the right thing to do anyhow. -- fx | |
1957 | ;;; ;; Set the `keyboard-coding-system' if appropriate. | |
1958 | ;;; (let ((kcs (or coding-system | |
1959 | ;;; (car (get-language-info language-name | |
1960 | ;;; 'coding-system))))) | |
1961 | ;;; (if (memq kcs standard-keyboard-coding-systems) | |
1962 | ;;; (set-keyboard-coding-system kcs))) | |
ddf6b836 | 1963 | |
7008ccac GM |
1964 | (setq locale-coding-system |
1965 | (car (get-language-info language-name 'coding-priority)))) | |
1966 | ||
1967 | (when coding-system | |
1968 | (prefer-coding-system coding-system) | |
1969 | (setq locale-coding-system coding-system)))))) | |
40c81f74 | 1970 | \f |
4ed46869 KH |
1971 | ;;; Character code property |
1972 | (put 'char-code-property-table 'char-table-extra-slots 0) | |
1973 | ||
1974 | (defvar char-code-property-table | |
1975 | (make-char-table 'char-code-property-table) | |
1976 | "Char-table containing a property list of each character code. | |
1977 | ||
1978 | See also the documentation of `get-char-code-property' and | |
96db204a | 1979 | `put-char-code-property'.") |
4ed46869 KH |
1980 | |
1981 | (defun get-char-code-property (char propname) | |
1982 | "Return the value of CHAR's PROPNAME property in `char-code-property-table'." | |
1983 | (let ((plist (aref char-code-property-table char))) | |
1984 | (if (listp plist) | |
1985 | (car (cdr (memq propname plist)))))) | |
1986 | ||
1987 | (defun put-char-code-property (char propname value) | |
1988 | "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. | |
1989 | It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." | |
1990 | (let ((plist (aref char-code-property-table char))) | |
1991 | (if plist | |
1992 | (let ((slot (memq propname plist))) | |
1993 | (if slot | |
1994 | (setcar (cdr slot) value) | |
1995 | (nconc plist (list propname value)))) | |
1996 | (aset char-code-property-table char (list propname value))))) | |
1997 | ||
a127b764 KH |
1998 | \f |
1999 | ;; Pretty description of encoded string | |
2000 | ||
2001 | ;; Alist of ISO 2022 control code vs the corresponding mnemonic string. | |
2002 | (defvar iso-2022-control-alist | |
2003 | '((?\x1b . "ESC") | |
2004 | (?\x0e . "SO") | |
2005 | (?\x0f . "SI") | |
2006 | (?\x8e . "SS2") | |
2007 | (?\x8f . "SS3") | |
2008 | (?\x9b . "CSI"))) | |
2009 | ||
2010 | (defun encoded-string-description (str coding-system) | |
2011 | "Return a pretty description of STR that is encoded by CODING-SYSTEM." | |
2012 | (setq str (string-as-unibyte str)) | |
993b2a7d | 2013 | (mapconcat |
8c9d55a9 | 2014 | (if (and coding-system (eq (coding-system-type coding-system) 2)) |
993b2a7d KH |
2015 | ;; Try to get a pretty description for ISO 2022 escape sequences. |
2016 | (function (lambda (x) (or (cdr (assq x iso-2022-control-alist)) | |
2017 | (format "%02X" x)))) | |
5de75f53 | 2018 | (function (lambda (x) (format "0x%02X" x)))) |
993b2a7d | 2019 | str " ")) |
a127b764 KH |
2020 | |
2021 | (defun encode-coding-char (char coding-system) | |
2022 | "Encode CHAR by CODING-SYSTEM and return the resulting string. | |
2023 | If CODING-SYSTEM can't safely encode CHAR, return nil." | |
bc304a20 DL |
2024 | (let ((str1 (string-as-multibyte (string char))) |
2025 | (str2 (string-as-multibyte (string char char))) | |
a127b764 | 2026 | enc1 enc2 i1 i2) |
bc304a20 DL |
2027 | (when (memq (coding-system-base coding-system) |
2028 | (find-coding-systems-string str1)) | |
a127b764 KH |
2029 | ;; We must find the encoded string of CHAR. But, just encoding |
2030 | ;; CHAR will put extra control sequences (usually to designate | |
bc304a20 | 2031 | ;; ASCII charset) at the tail if type of CODING is ISO 2022. |
a127b764 KH |
2032 | ;; To exclude such tailing bytes, we at first encode one-char |
2033 | ;; string and two-char string, then check how many bytes at the | |
2034 | ;; tail of both encoded strings are the same. | |
2035 | ||
bd953173 | 2036 | (setq enc1 (encode-coding-string str1 coding-system) |
a127b764 | 2037 | i1 (length enc1) |
bd953173 | 2038 | enc2 (encode-coding-string str2 coding-system) |
a127b764 KH |
2039 | i2 (length enc2)) |
2040 | (while (and (> i1 0) (= (aref enc1 (1- i1)) (aref enc2 (1- i2)))) | |
2041 | (setq i1 (1- i1) i2 (1- i2))) | |
2042 | ||
2043 | ;; Now (substring enc1 i1) and (substring enc2 i2) are the same, | |
2044 | ;; and they are the extra control sequences at the tail to | |
2045 | ;; exclude. | |
2046 | (substring enc2 0 i2)))) | |
2047 | ||
d2f613a0 DL |
2048 | ;; Backwards compatibility. These might be better with :init-value t, |
2049 | ;; but that breaks loadup. | |
2050 | (define-minor-mode unify-8859-on-encoding-mode | |
2051 | "Obsolete." | |
2052 | :group 'mule | |
2053 | :global t) | |
2054 | (define-minor-mode unify-8859-on-decoding-mode | |
2055 | "Obsolete." | |
2056 | :group 'mule | |
2057 | :global t) | |
a127b764 | 2058 | |
4ed46869 | 2059 | ;;; mule-cmds.el ends here |