Commit | Line | Data |
---|---|---|
4ed46869 KH |
1 | ;;; mule-cmds.el --- Commands for mulitilingual environment |
2 | ||
4ed46869 | 3 | ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
fa526c4a | 4 | ;; Licensed to the Free Software Foundation. |
4ed46869 KH |
5 | |
6 | ;; Keywords: mule, multilingual | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
369314dc KH |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
4ed46869 KH |
24 | |
25 | ;;; Code: | |
26 | ||
27 | ;;; MULE related key bindings and menus. | |
28 | ||
0709d285 | 29 | (defvar mule-keymap (make-sparse-keymap) |
4ed46869 | 30 | "Keymap for MULE (Multilingual environment) specific commands.") |
4ed46869 | 31 | |
8f81f784 | 32 | ;; Keep "C-x C-m ..." for mule specific commands. |
0709d285 | 33 | (define-key ctl-x-map "\C-m" mule-keymap) |
ef8a8c8c | 34 | |
4ed46869 KH |
35 | (define-key mule-keymap "f" 'set-buffer-file-coding-system) |
36 | (define-key mule-keymap "t" 'set-terminal-coding-system) | |
15b3e511 KH |
37 | (define-key mule-keymap "k" 'set-keyboard-coding-system) |
38 | (define-key mule-keymap "p" 'set-buffer-process-coding-system) | |
7624ebb9 KH |
39 | (define-key mule-keymap "x" 'set-selection-coding-system) |
40 | (define-key mule-keymap "X" 'set-next-selection-coding-system) | |
8b784951 | 41 | (define-key mule-keymap "\C-\\" 'set-input-method) |
15b3e511 | 42 | (define-key mule-keymap "c" 'universal-coding-system-argument) |
b4fba33f | 43 | (define-key mule-keymap "l" 'set-language-environment) |
4ed46869 | 44 | |
281d03ec | 45 | (define-key help-map "\C-L" 'describe-language-environment) |
ac4a3a2d | 46 | (define-key help-map "L" 'describe-language-environment) |
4ed46869 | 47 | (define-key help-map "\C-\\" 'describe-input-method) |
ac4a3a2d | 48 | (define-key help-map "I" 'describe-input-method) |
d0b9c3ab | 49 | (define-key help-map "C" 'describe-coding-system) |
4ed46869 KH |
50 | (define-key help-map "h" 'view-hello-file) |
51 | ||
0709d285 | 52 | (defvar mule-menu-keymap (make-sparse-keymap "Mule") |
15b3e511 | 53 | "Keymap for MULE (Multilingual environment) menu specific commands.") |
15b3e511 | 54 | |
ef6675c8 RS |
55 | (define-key global-map [menu-bar mule] |
56 | `(menu-item "Mule" ,mule-menu-keymap | |
57 | :visible default-enable-multibyte-characters)) | |
15b3e511 KH |
58 | |
59 | (setq menu-bar-final-items (cons 'mule menu-bar-final-items)) | |
60 | ||
dcad02bc EZ |
61 | (defvar describe-language-environment-map |
62 | (make-sparse-keymap "Describe Language Environment")) | |
15b3e511 | 63 | |
dcad02bc EZ |
64 | (defvar setup-language-environment-map |
65 | (make-sparse-keymap "Set Language Environment")) | |
15b3e511 | 66 | |
dcad02bc EZ |
67 | (defvar set-coding-system-map |
68 | (make-sparse-keymap "Set Coding System")) | |
15b3e511 | 69 | |
281d03ec | 70 | (define-key-after mule-menu-keymap [describe-language-environment] |
dcad02bc | 71 | (cons "Describe Language Environment" describe-language-environment-map) |
15b3e511 KH |
72 | t) |
73 | (define-key-after mule-menu-keymap [set-language-environment] | |
dcad02bc | 74 | (cons "Set Language Environment" setup-language-environment-map) |
15b3e511 | 75 | t) |
a61f401d | 76 | (define-key-after mule-menu-keymap [mouse-set-font] |
8e02924a | 77 | '("Set Font/Fontset" . mouse-set-font) |
a61f401d | 78 | t) |
15b3e511 KH |
79 | (define-key-after mule-menu-keymap [separator-mule] |
80 | '("--") | |
81 | t) | |
82 | (define-key-after mule-menu-keymap [toggle-input-method] | |
8e02924a | 83 | '("Toggle Input Method" . toggle-input-method) |
15b3e511 | 84 | t) |
8b784951 KH |
85 | (define-key-after mule-menu-keymap [set-input-method] |
86 | '("Select Input Method" . set-input-method) | |
15b3e511 KH |
87 | t) |
88 | (define-key-after mule-menu-keymap [describe-input-method] | |
8e02924a | 89 | '("Describe Input Method" . describe-input-method) |
15b3e511 KH |
90 | t) |
91 | (define-key-after mule-menu-keymap [separator-input-method] | |
92 | '("--") | |
93 | t) | |
d0b9c3ab | 94 | (define-key-after mule-menu-keymap [describe-coding-system] |
8e02924a | 95 | '("Describe Coding Systems" . describe-coding-system) |
15b3e511 KH |
96 | t) |
97 | (define-key-after mule-menu-keymap [set-various-coding-system] | |
dcad02bc | 98 | (cons "Set Coding System" set-coding-system-map) |
15b3e511 KH |
99 | t) |
100 | (define-key-after mule-menu-keymap [separator-coding-system] | |
101 | '("--") | |
102 | t) | |
103 | (define-key-after mule-menu-keymap [mule-diag] | |
8e02924a | 104 | '("Show All of MULE Status" . mule-diag) |
15b3e511 KH |
105 | t) |
106 | (define-key-after mule-menu-keymap [view-hello-file] | |
8e02924a | 107 | '("Show Script Examples" . view-hello-file) |
15b3e511 KH |
108 | t) |
109 | ||
110 | (define-key-after set-coding-system-map [set-buffer-file-coding-system] | |
8e02924a | 111 | '("Buffer File" . set-buffer-file-coding-system) |
15b3e511 | 112 | t) |
3a151e98 RS |
113 | (define-key-after set-coding-system-map [universal-coding-system-argument] |
114 | '("Next Command" . universal-coding-system-argument) | |
115 | t) | |
15b3e511 KH |
116 | (define-key-after set-coding-system-map [set-terminal-coding-system] |
117 | '("Terminal" . set-terminal-coding-system) | |
118 | t) | |
119 | (define-key-after set-coding-system-map [set-keyboard-coding-system] | |
120 | '("Keyboard" . set-keyboard-coding-system) | |
121 | t) | |
122 | (define-key-after set-coding-system-map [set-buffer-process-coding-system] | |
8e02924a | 123 | '("Buffer Process" . set-buffer-process-coding-system) |
15b3e511 | 124 | t) |
7624ebb9 KH |
125 | (define-key-after set-coding-system-map [set-selection-coding-system] |
126 | '("X Selection" . set-selection-coding-system) | |
127 | t) | |
128 | (define-key-after set-coding-system-map [set-next-selection-coding-system] | |
129 | '("Next X Selection" . set-next-selection-coding-system) | |
130 | t) | |
15b3e511 KH |
131 | (define-key setup-language-environment-map |
132 | [Default] '("Default" . setup-specified-language-environment)) | |
4ed46869 | 133 | |
03c35c83 | 134 | ;; These are meaningless when running under X and W32. |
4ed46869 | 135 | (put 'set-terminal-coding-system 'menu-enable |
03c35c83 | 136 | '(or (not window-system) (eq window-system 'pc))) |
15b3e511 | 137 | (put 'set-keyboard-coding-system 'menu-enable |
03c35c83 | 138 | '(or (not window-system) (eq window-system 'pc))) |
d0b9c3ab KH |
139 | ;; This is meaningless when the current buffer has no process. |
140 | (put 'set-buffer-process-coding-system 'menu-enable | |
141 | '(get-buffer-process (current-buffer))) | |
7624ebb9 KH |
142 | ;; These are meaningless when running under terminal. |
143 | (put 'set-selection-coding-system 'menu-enable | |
144 | 'window-system) | |
145 | (put 'set-next-selection-coding-system 'menu-enable | |
146 | 'window-system) | |
4ed46869 | 147 | |
4ed46869 KH |
148 | ;; This should be a single character key binding because users use it |
149 | ;; very frequently while editing multilingual text. Now we can use | |
150 | ;; only two such keys: "\C-\\" and "\C-^", but the latter is not | |
151 | ;; convenient because it requires shifting on most keyboards. An | |
152 | ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' | |
153 | ;; but it won't be used that frequently. | |
154 | (define-key global-map "\C-\\" 'toggle-input-method) | |
155 | ||
a2ad45b9 RS |
156 | ;;; This is no good because people often type Shift-SPC |
157 | ;;; meaning to type SPC. -- rms. | |
158 | ;;; ;; Here's an alternative key binding for X users (Shift-SPACE). | |
159 | ;;; (define-key global-map [?\S- ] 'toggle-input-method) | |
b4fba33f | 160 | |
26d87040 EZ |
161 | (defun coding-system-change-eol-conversion (coding-system eol-type) |
162 | "Return a coding system which differs from CODING-SYSTEM in eol conversion. | |
163 | The returned coding system converts end-of-line by EOL-TYPE | |
164 | but text as the same way as CODING-SYSTEM. | |
165 | EOL-TYPE should be `unix', `dos', `mac', or nil. | |
166 | If EOL-TYPE is nil, the returned coding system detects | |
167 | how end-of-line is formatted automatically while decoding. | |
168 | ||
169 | EOL-TYPE can be specified by an integer 0, 1, or 2. | |
170 | They means `unix', `dos', and `mac' respectively." | |
171 | (if (symbolp eol-type) | |
172 | (setq eol-type (cond ((eq eol-type 'unix) 0) | |
173 | ((eq eol-type 'dos) 1) | |
174 | ((eq eol-type 'mac) 2) | |
175 | (t eol-type)))) | |
176 | (let ((orig-eol-type (coding-system-eol-type coding-system))) | |
177 | (if (vectorp orig-eol-type) | |
178 | (if (not eol-type) | |
179 | coding-system | |
180 | (aref orig-eol-type eol-type)) | |
181 | (let ((base (coding-system-base coding-system))) | |
182 | (if (not eol-type) | |
183 | base | |
184 | (if (= eol-type orig-eol-type) | |
185 | coding-system | |
186 | (setq orig-eol-type (coding-system-eol-type base)) | |
187 | (if (vectorp orig-eol-type) | |
188 | (aref orig-eol-type eol-type)))))))) | |
189 | ||
190 | (defun coding-system-change-text-conversion (coding-system coding) | |
191 | "Return a coding system which differs from CODING-SYSTEM in text conversion. | |
192 | The returned coding system converts text by CODING | |
193 | but end-of-line as the same way as CODING-SYSTEM. | |
194 | If CODING is nil, the returned coding system detects | |
195 | how text is formatted automatically while decoding." | |
196 | (if (not coding) | |
197 | (coding-system-base coding-system) | |
198 | (let ((eol-type (coding-system-eol-type coding-system))) | |
199 | (coding-system-change-eol-conversion | |
200 | coding | |
201 | (if (numberp eol-type) (aref [unix dos mac] eol-type)))))) | |
202 | ||
4ed46869 | 203 | (defun toggle-enable-multibyte-characters (&optional arg) |
6998e1a1 RS |
204 | "Change whether this buffer uses multibyte characters. |
205 | With arg, use multibyte characters if the arg is positive. | |
206 | ||
207 | Note that this command does not convert the byte contents of | |
208 | the buffer; it only changes the way those bytes are interpreted. | |
209 | In general, therefore, this command *changes* the sequence of | |
210 | characters that the current buffer contains. | |
211 | ||
212 | We suggest you avoid using use this command unless you know what you | |
213 | are doing. If you use it by mistake, and the buffer is now displayed | |
214 | wrong, use this command again to toggle back to the right mode." | |
4ed46869 | 215 | (interactive "P") |
b7079457 RS |
216 | (let ((new-flag |
217 | (if (null arg) (null enable-multibyte-characters) | |
218 | (> (prefix-numeric-value arg) 0)))) | |
219 | (set-buffer-multibyte new-flag)) | |
4ed46869 KH |
220 | (force-mode-line-update)) |
221 | ||
222 | (defun view-hello-file () | |
223 | "Display the HELLO file which list up many languages and characters." | |
224 | (interactive) | |
8f81f784 KH |
225 | ;; We have to decode the file in any environment. |
226 | (let ((default-enable-multibyte-characters t) | |
95fa03b4 | 227 | (coding-system-for-read 'iso-2022-7bit)) |
8f81f784 | 228 | (find-file-read-only (expand-file-name "HELLO" data-directory)))) |
4ed46869 | 229 | |
15b3e511 KH |
230 | (defun universal-coding-system-argument () |
231 | "Execute an I/O command using the specified coding system." | |
232 | (interactive) | |
34104362 KH |
233 | (let* ((default (and buffer-file-coding-system |
234 | (not (eq (coding-system-type buffer-file-coding-system) | |
235 | t)) | |
236 | buffer-file-coding-system)) | |
237 | (coding-system (read-coding-system | |
238 | (if default | |
239 | (format "Coding system for following command (default, %s): " default) | |
240 | "Coding system for following command: ") | |
241 | default)) | |
15b3e511 | 242 | (keyseq (read-key-sequence |
e14a8f4c | 243 | (format "Command to execute with %s:" coding-system))) |
15b3e511 KH |
244 | (cmd (key-binding keyseq))) |
245 | (let ((coding-system-for-read coding-system) | |
246 | (coding-system-for-write coding-system)) | |
247 | (message "") | |
248 | (call-interactively cmd)))) | |
249 | ||
de94d711 | 250 | (defun set-default-coding-systems (coding-system) |
0c3154d2 | 251 | "Set default value of various coding systems to CODING-SYSTEM. |
387136f6 | 252 | This sets the following coding systems: |
0c3154d2 | 253 | o coding system of a newly created buffer |
8efc03e1 KH |
254 | o default coding system for subprocess I/O |
255 | This also sets the following values: | |
387136f6 | 256 | o default value used as file-name-coding-system for converting file names. |
03c35c83 EZ |
257 | o default value for the command `set-terminal-coding-system' (not on MSDOS) |
258 | o default value for the command `set-keyboard-coding-system'." | |
de94d711 KH |
259 | (check-coding-system coding-system) |
260 | (setq-default buffer-file-coding-system coding-system) | |
716184d4 RS |
261 | (if default-enable-multibyte-characters |
262 | (setq default-file-name-coding-system coding-system)) | |
03c35c83 EZ |
263 | ;; If coding-system is nil, honor that on MS-DOS as well, so |
264 | ;; that they could reset the terminal coding system. | |
265 | (unless (and (eq window-system 'pc) coding-system) | |
266 | (setq default-terminal-coding-system coding-system)) | |
de94d711 KH |
267 | (setq default-keyboard-coding-system coding-system) |
268 | (setq default-process-coding-system (cons coding-system coding-system))) | |
269 | ||
45d08cb2 KH |
270 | (defalias 'update-iso-coding-systems 'update-coding-systems-internal) |
271 | (make-obsolete 'update-iso-coding-systems 'update-coding-systems-internal) | |
272 | ||
0c3154d2 KH |
273 | (defun prefer-coding-system (coding-system) |
274 | "Add CODING-SYSTEM at the front of the priority list for automatic detection. | |
387136f6 | 275 | This also sets the following coding systems: |
0c3154d2 | 276 | o coding system of a newly created buffer |
8efc03e1 KH |
277 | o default coding system for subprocess I/O |
278 | This also sets the following values: | |
387136f6 | 279 | o default value used as file-name-coding-system for converting file names. |
03c35c83 EZ |
280 | o default value for the command `set-terminal-coding-system' (not on MSDOS) |
281 | o default value for the command `set-keyboard-coding-system' | |
282 | ||
bd3ac67e EZ |
283 | If CODING-SYSTEM specifies a certain type of EOL conversion, the coding |
284 | systems set by this function will use that type of EOL conversion. | |
285 | ||
03c35c83 EZ |
286 | This command does not change the default value of terminal coding system |
287 | for MS-DOS terminal, because DOS terminals only support a single coding | |
288 | system, and Emacs automatically sets the default to that coding system at | |
289 | startup." | |
0c3154d2 KH |
290 | (interactive "zPrefer coding system: ") |
291 | (if (not (and coding-system (coding-system-p coding-system))) | |
292 | (error "Invalid coding system `%s'" coding-system)) | |
293 | (let ((coding-category (coding-system-category coding-system)) | |
bd3ac67e EZ |
294 | (base (coding-system-base coding-system)) |
295 | (eol-type (coding-system-eol-type coding-system))) | |
0c3154d2 KH |
296 | (if (not coding-category) |
297 | ;; CODING-SYSTEM is no-conversion or undecided. | |
298 | (error "Can't prefer the coding system `%s'" coding-system)) | |
8efc03e1 | 299 | (set coding-category (or base coding-system)) |
45d08cb2 | 300 | (update-coding-systems-internal) |
812cad80 | 301 | (or (eq coding-category (car coding-category-list)) |
0c3154d2 | 302 | ;; We must change the order. |
812cad80 | 303 | (set-coding-priority (list coding-category))) |
8efc03e1 KH |
304 | (if (and base (interactive-p)) |
305 | (message "Highest priority is set to %s (base of %s)" | |
306 | base coding-system)) | |
bd3ac67e | 307 | ;; If they asked for specific EOL conversion, honor that. |
6f9dc4fd | 308 | (if (memq eol-type '(0 1 2)) |
bd3ac67e EZ |
309 | (setq coding-system |
310 | (coding-system-change-eol-conversion base eol-type)) | |
311 | (setq coding-system base)) | |
312 | (set-default-coding-systems coding-system))) | |
0c3154d2 | 313 | |
2c395d56 | 314 | (defun find-coding-systems-region-subset-p (list1 list2) |
54b226f7 KH |
315 | "Return non-nil if all elements in LIST1 are included in LIST2. |
316 | Comparison done with EQ." | |
317 | (catch 'tag | |
318 | (while list1 | |
319 | (or (memq (car list1) list2) | |
320 | (throw 'tag nil)) | |
321 | (setq list1 (cdr list1))) | |
322 | t)) | |
323 | ||
3fc7dfe5 | 324 | (defun find-coding-systems-region (from to) |
54b226f7 KH |
325 | "Return a list of proper coding systems to encode a text between FROM and TO. |
326 | All coding systems in the list can safely encode any multibyte characters | |
327 | in the text. | |
328 | ||
e8dd0160 | 329 | If the text contains no multibyte characters, return a list of a single |
3fc7dfe5 KH |
330 | element `undecided'." |
331 | (find-coding-systems-for-charsets (find-charset-region from to))) | |
54b226f7 | 332 | |
3fc7dfe5 KH |
333 | (defun find-coding-systems-string (string) |
334 | "Return a list of proper coding systems to encode STRING. | |
335 | All coding systems in the list can safely encode any multibyte characters | |
336 | in STRING. | |
337 | ||
e8dd0160 | 338 | If STRING contains no multibyte characters, return a list of a single |
3fc7dfe5 KH |
339 | element `undecided'." |
340 | (find-coding-systems-for-charsets (find-charset-string string))) | |
341 | ||
342 | (defun find-coding-systems-for-charsets (charsets) | |
343 | "Return a list of proper coding systems to encode characters of CHARSETS. | |
344 | CHARSETS is a list of character sets." | |
345 | (if (or (null charsets) | |
346 | (and (= (length charsets) 1) | |
347 | (eq 'ascii (car charsets)))) | |
348 | '(undecided) | |
2a17b638 | 349 | (setq charsets (delq 'composition charsets)) |
251d4f4b | 350 | (let ((l (coding-system-list 'base-only)) |
34104362 | 351 | (charset-prefered-codings |
3fc7dfe5 KH |
352 | (mapcar (function |
353 | (lambda (x) | |
251d4f4b KH |
354 | (if (eq x 'unknown) |
355 | 'raw-text | |
356 | (get-charset-property x 'prefered-coding-system)))) | |
3fc7dfe5 | 357 | charsets)) |
34104362 KH |
358 | (priorities (mapcar (function (lambda (x) (symbol-value x))) |
359 | coding-category-list)) | |
3fc7dfe5 | 360 | codings coding safe) |
251d4f4b KH |
361 | (if (memq 'unknown charsets) |
362 | ;; The region contains invalid multibyte characters. | |
363 | (setq l '(raw-text))) | |
3fc7dfe5 KH |
364 | (while l |
365 | (setq coding (car l) l (cdr l)) | |
251d4f4b | 366 | (if (and (setq safe (coding-system-get coding 'safe-charsets)) |
3fc7dfe5 | 367 | (or (eq safe t) |
2c395d56 | 368 | (find-coding-systems-region-subset-p charsets safe))) |
3fc7dfe5 | 369 | ;; We put the higher priority to coding systems included |
34104362 KH |
370 | ;; in CHARSET-PREFERED-CODINGS, and within them, put the |
371 | ;; higher priority to coding systems which support smaller | |
3fc7dfe5 KH |
372 | ;; number of charsets. |
373 | (let ((priority | |
34104362 KH |
374 | (+ (if (coding-system-get coding 'mime-charset) 4096 0) |
375 | (lsh (length (memq coding priorities)) 7) | |
376 | (if (memq coding charset-prefered-codings) 64 0) | |
377 | (if (> (coding-system-type coding) 0) 32 0) | |
378 | (if (consp safe) (- 32 (length safe)) 0)))) | |
3fc7dfe5 KH |
379 | (setq codings (cons (cons priority coding) codings))))) |
380 | (mapcar 'cdr | |
381 | (sort codings (function (lambda (x y) (> (car x) (car y)))))) | |
382 | ))) | |
54b226f7 | 383 | |
51ed58ea KH |
384 | (defun find-multibyte-characters (from to &optional maxcount excludes) |
385 | "Find multibyte characters in the region specified by FROM and TO. | |
386 | If FROM is a string, find multibyte characters in the string. | |
387 | The return value is an alist of the following format: | |
388 | ((CHARSET COUNT CHAR ...) ...) | |
389 | where | |
390 | CHARSET is a character set, | |
391 | COUNT is a number of characters, | |
392 | CHARs are found characters of the character set. | |
393 | Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list. | |
251d4f4b KH |
394 | Optional 4th arg EXCLUDE is a list of character sets to be ignored. |
395 | ||
396 | For invalid characters, CHARs are actually strings." | |
51ed58ea KH |
397 | (let ((chars nil) |
398 | charset char) | |
399 | (if (stringp from) | |
400 | (let ((idx 0)) | |
401 | (while (setq idx (string-match "[^\000-\177]" from idx)) | |
402 | (setq char (aref from idx) | |
403 | charset (char-charset char)) | |
251d4f4b KH |
404 | (if (eq charset 'unknown) |
405 | (setq char (match-string 0))) | |
406 | (if (or (eq charset 'unknown) | |
407 | (not (or (eq excludes t) (memq charset excludes)))) | |
51ed58ea KH |
408 | (let ((slot (assq charset chars))) |
409 | (if slot | |
410 | (if (not (memq char (nthcdr 2 slot))) | |
411 | (let ((count (nth 1 slot))) | |
412 | (setcar (cdr slot) (1+ count)) | |
413 | (if (or (not maxcount) (< count maxcount)) | |
414 | (nconc slot (list char))))) | |
415 | (setq chars (cons (list charset 1 char) chars))))) | |
416 | (setq idx (1+ idx)))) | |
417 | (save-excursion | |
418 | (goto-char from) | |
419 | (while (re-search-forward "[^\000-\177]" to t) | |
420 | (setq char (preceding-char) | |
421 | charset (char-charset char)) | |
251d4f4b KH |
422 | (if (eq charset 'unknown) |
423 | (setq char (match-string 0))) | |
424 | (if (or (eq charset 'unknown) | |
425 | (not (or (eq excludes t) (memq charset excludes)))) | |
51ed58ea KH |
426 | (let ((slot (assq charset chars))) |
427 | (if slot | |
251d4f4b | 428 | (if (not (member char (nthcdr 2 slot))) |
51ed58ea KH |
429 | (let ((count (nth 1 slot))) |
430 | (setcar (cdr slot) (1+ count)) | |
431 | (if (or (not maxcount) (< count maxcount)) | |
432 | (nconc slot (list char))))) | |
433 | (setq chars (cons (list charset 1 char) chars)))))))) | |
434 | (nreverse chars))) | |
435 | ||
c83c4f60 RS |
436 | (defvar last-coding-system-specified nil |
437 | "Most recent coding system explicitly specified by the user when asked. | |
438 | This variable is set whenever Emacs asks the user which coding system | |
439 | to use in order to write a file. If you set it to nil explicitly, | |
440 | then call `write-region', then afterward this variable will be non-nil | |
441 | only if the user was explicitly asked and specified a coding system.") | |
442 | ||
54b226f7 | 443 | (defun select-safe-coding-system (from to &optional default-coding-system) |
d5266ddf KH |
444 | "Ask a user to select a safe coding system from candidates. |
445 | The candidates of coding systems which can safely encode a text | |
446 | between FROM and TO are shown in a popup window. | |
54b226f7 KH |
447 | |
448 | Optional arg DEFAULT-CODING-SYSTEM specifies a coding system to be | |
449 | checked at first. If omitted, buffer-file-coding-system of the | |
450 | current buffer is used. | |
451 | ||
d5266ddf KH |
452 | If the text can be encoded safely by DEFAULT-CODING-SYSTEM, it is |
453 | returned without any user interaction. | |
54b226f7 KH |
454 | |
455 | Kludgy feature: if FROM is a string, the string is the target text, | |
456 | and TO is ignored." | |
457 | (or default-coding-system | |
458 | (setq default-coding-system buffer-file-coding-system)) | |
51ed58ea KH |
459 | (let* ((charsets (if (stringp from) (find-charset-string from) |
460 | (find-charset-region from to))) | |
461 | (safe-coding-systems (find-coding-systems-for-charsets charsets))) | |
251d4f4b KH |
462 | (if (or (not enable-multibyte-characters) |
463 | (eq (car safe-coding-systems) 'undecided) | |
902e3f77 | 464 | (eq default-coding-system 'no-conversion) |
54b226f7 KH |
465 | (and default-coding-system |
466 | (memq (coding-system-base default-coding-system) | |
467 | safe-coding-systems))) | |
468 | default-coding-system | |
469 | ||
34104362 KH |
470 | ;; At first, change each coding system to the corresponding |
471 | ;; mime-charset name if it is also a coding system. | |
472 | (let ((l safe-coding-systems) | |
473 | mime-charset) | |
474 | (while l | |
475 | (setq mime-charset (coding-system-get (car l) 'mime-charset)) | |
476 | (if (and mime-charset (coding-system-p mime-charset)) | |
477 | (setcar l mime-charset)) | |
478 | (setq l (cdr l)))) | |
479 | ||
51ed58ea KH |
480 | (let ((non-safe-chars (find-multibyte-characters |
481 | from to 3 | |
482 | (and default-coding-system | |
483 | (coding-system-get default-coding-system | |
484 | 'safe-charsets)))) | |
485 | overlays) | |
486 | (save-excursion | |
487 | ;; Highlight characters that default-coding-system can't encode. | |
488 | (when (integerp from) | |
489 | (goto-char from) | |
490 | (let ((found nil)) | |
491 | (while (and (not found) | |
492 | (re-search-forward "[^\000-\177]" to t)) | |
493 | (setq found (assq (char-charset (preceding-char)) | |
494 | non-safe-chars)))) | |
495 | (beginning-of-line) | |
496 | (set-window-start (selected-window) (point)) | |
497 | (save-excursion | |
265519e3 RS |
498 | (while (and (< (length overlays) 256) |
499 | (re-search-forward "[^\000-\177]" to t)) | |
51ed58ea KH |
500 | (let* ((char (preceding-char)) |
501 | (charset (char-charset char))) | |
502 | (when (assq charset non-safe-chars) | |
503 | (setq overlays (cons (make-overlay (1- (point)) (point)) | |
504 | overlays)) | |
505 | (overlay-put (car overlays) 'face 'highlight)))))) | |
506 | ||
507 | ;; At last, ask a user to select a proper coding system. | |
508 | (unwind-protect | |
509 | (save-window-excursion | |
510 | ;; At first, show a helpful message. | |
511 | (with-output-to-temp-buffer "*Warning*" | |
512 | (save-excursion | |
513 | (set-buffer standard-output) | |
514 | (insert "The target text contains the following non ASCII character(s):\n") | |
515 | (let ((len (length non-safe-chars)) | |
516 | (shown 0)) | |
517 | (while (and non-safe-chars (< shown 3)) | |
518 | (when (> (length (car non-safe-chars)) 2) | |
519 | (setq shown (1+ shown)) | |
520 | (insert (format "%25s: " (car (car non-safe-chars)))) | |
521 | (let ((l (nthcdr 2 (car non-safe-chars)))) | |
522 | (while l | |
251d4f4b KH |
523 | (if (or (stringp (car l)) (char-valid-p (car l))) |
524 | (insert (car l))) | |
51ed58ea KH |
525 | (setq l (cdr l)))) |
526 | (if (> (nth 1 (car non-safe-chars)) 3) | |
527 | (insert "...")) | |
528 | (insert "\n")) | |
529 | (setq non-safe-chars (cdr non-safe-chars))) | |
530 | (if (< shown len) | |
531 | (insert (format "%27s\n" "...")))) | |
532 | (insert (format "\ | |
533 | These can't be encoded safely by the coding system %s. | |
54b226f7 KH |
534 | |
535 | Please select one from the following safe coding systems:\n" | |
51ed58ea KH |
536 | default-coding-system)) |
537 | (let ((pos (point)) | |
538 | (fill-prefix " ")) | |
539 | (mapcar (function (lambda (x) (princ " ") (princ x))) | |
540 | safe-coding-systems) | |
541 | (fill-region-as-paragraph pos (point))))) | |
542 | ||
543 | ;; Read a coding system. | |
544 | (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x))) | |
545 | safe-coding-systems)) | |
546 | (name (completing-read | |
547 | (format "Select coding system (default %s): " | |
548 | (car safe-coding-systems)) | |
549 | safe-names nil t nil nil | |
550 | (car (car safe-names))))) | |
551 | (setq last-coding-system-specified (intern name)) | |
552 | (if (integerp (coding-system-eol-type default-coding-system)) | |
553 | (setq last-coding-system-specified | |
554 | (coding-system-change-eol-conversion | |
555 | last-coding-system-specified | |
556 | (coding-system-eol-type default-coding-system)))) | |
557 | last-coding-system-specified)) | |
558 | (kill-buffer "*Warning*") | |
559 | (while overlays | |
560 | (delete-overlay (car overlays)) | |
561 | (setq overlays (cdr overlays))))))))) | |
54b226f7 KH |
562 | |
563 | (setq select-safe-coding-system-function 'select-safe-coding-system) | |
564 | ||
46babb23 KH |
565 | (defun select-message-coding-system () |
566 | "Return a coding system to encode the outgoing message of the current buffer. | |
567 | It at first tries the first coding system found in these variables | |
568 | in this order: | |
569 | (1) local value of `buffer-file-coding-system' | |
570 | (2) value of `sendmail-coding-system' | |
571 | (3) value of `default-buffer-file-coding-system' | |
572 | (4) value of `default-sendmail-coding-system' | |
573 | If the found coding system can't encode the current buffer, | |
574 | or none of them are bound to a coding system, | |
48e41165 | 575 | it asks the user to select a proper coding system." |
46babb23 KH |
576 | (let ((coding (or (and (local-variable-p 'buffer-file-coding-system) |
577 | buffer-file-coding-system) | |
578 | sendmail-coding-system | |
579 | default-buffer-file-coding-system | |
580 | default-sendmail-coding-system))) | |
581 | (if (eq coding 'no-conversion) | |
582 | ;; We should never use no-conversion for outgoing mails. | |
583 | (setq coding nil)) | |
584 | (if (fboundp select-safe-coding-system-function) | |
585 | (funcall select-safe-coding-system-function | |
586 | (point-min) (point-max) coding) | |
587 | coding))) | |
4ed46869 | 588 | \f |
03c35c83 | 589 | ;;; Language support stuff. |
4ed46869 | 590 | |
4ed46869 | 591 | (defvar language-info-alist nil |
2c395d56 | 592 | "Alist of language environment definitions. |
4ed46869 KH |
593 | Each element looks like: |
594 | (LANGUAGE-NAME . ((KEY . INFO) ...)) | |
2c395d56 RS |
595 | where LANGUAGE-NAME is a string, the name of the language environment, |
596 | KEY is a symbol denoting the kind of information, and | |
597 | INFO is the data associated with KEY. | |
598 | Meaningful values for KEY include | |
599 | ||
600 | documentation value is documentation of what this language environment | |
601 | is meant for, and how to use it. | |
602 | charset value is a list of the character sets used by this | |
603 | language environment. | |
604 | sample-text value is one line of text, | |
605 | written using those character sets, | |
606 | appropriate for this language environment. | |
607 | setup-function value is a function to call to switch to this | |
608 | language environment. | |
609 | exit-function value is a function to call to leave this | |
610 | language environment. | |
611 | coding-system value is a list of coding systems that are good | |
612 | for saving text written in this language environment. | |
613 | This list serves as suggestions to the user; | |
614 | in effect, as a kind of documentation. | |
615 | coding-priority value is a list of coding systems for this language | |
616 | environment, in order of decreasing priority. | |
617 | This is used to set up the coding system priority | |
45d08cb2 | 618 | list when you switch to this language environment. |
ddb5c041 | 619 | nonascii-translation |
7624ebb9 | 620 | value is a translation table to be set in the |
45d08cb2 | 621 | variable `nonascii-translation-table' in this |
7624ebb9 KH |
622 | language environment, or a character set from |
623 | which `nonascii-insert-offset' is calculated. | |
45d08cb2 | 624 | charset-origin-alist |
7624ebb9 | 625 | value is an alist to be set in the variable |
ddb5c041 KH |
626 | `charset-origin-alist' in this language environment. |
627 | input-method value is a default input method for this language | |
628 | environment. | |
7624ebb9 KH |
629 | features value is a list of features requested in this |
630 | language environment. | |
ddb5c041 KH |
631 | |
632 | The following keys take effect only when multibyte characters are | |
633 | globally disabled, i.e. the value of `default-enable-multibyte-characters' | |
634 | is nil. | |
635 | ||
636 | unibyte-syntax value is a library name to load to set | |
e8dd0160 | 637 | unibyte 8-bit character syntaxes for this |
ddb5c041 KH |
638 | language environment. |
639 | ||
640 | unibyte-display value is a coding system to encode characters | |
641 | for the terminal. Characters in the range | |
642 | of 160 to 255 display not as octal escapes, | |
643 | but as non-ASCII characters in this language | |
644 | environment.") | |
2c395d56 RS |
645 | |
646 | (defun get-language-info (lang-env key) | |
647 | "Return information listed under KEY for language environment LANG-ENV. | |
648 | KEY is a symbol denoting the kind of information. | |
649 | For a list of useful values for KEY and their meanings, | |
650 | see `language-info-alist'." | |
651 | (if (symbolp lang-env) | |
652 | (setq lang-env (symbol-name lang-env))) | |
653 | (let ((lang-slot (assoc-ignore-case lang-env language-info-alist))) | |
4ed46869 KH |
654 | (if lang-slot |
655 | (cdr (assq key (cdr lang-slot)))))) | |
656 | ||
f08adf27 | 657 | (defun set-language-info (lang-env key info) |
2c395d56 RS |
658 | "Modify part of the definition of language environment LANG-ENV. |
659 | Specifically, this stores the information INFO under KEY | |
660 | in the definition of this language environment. | |
4ed46869 | 661 | KEY is a symbol denoting the kind of information. |
2c395d56 | 662 | INFO is the value for that information. |
281d03ec | 663 | |
2c395d56 | 664 | For a list of useful values for KEY and their meanings, |
f08adf27 | 665 | see `language-info-alist'." |
2c395d56 RS |
666 | (if (symbolp lang-env) |
667 | (setq lang-env (symbol-name lang-env))) | |
4ed46869 | 668 | (let (lang-slot key-slot) |
2c395d56 | 669 | (setq lang-slot (assoc lang-env language-info-alist)) |
4ed46869 | 670 | (if (null lang-slot) ; If no slot for the language, add it. |
2c395d56 | 671 | (setq lang-slot (list lang-env) |
4ed46869 KH |
672 | language-info-alist (cons lang-slot language-info-alist))) |
673 | (setq key-slot (assq key lang-slot)) | |
674 | (if (null key-slot) ; If no slot for the key, add it. | |
675 | (progn | |
676 | (setq key-slot (list key)) | |
677 | (setcdr lang-slot (cons key-slot (cdr lang-slot))))) | |
f08adf27 | 678 | (setcdr key-slot info))) |
4ed46869 | 679 | |
2c395d56 RS |
680 | (defun set-language-info-alist (lang-env alist &optional parents) |
681 | "Store ALIST as the definition of language environment LANG-ENV. | |
682 | ALIST is an alist of KEY and INFO values. See the documentation of | |
7624ebb9 | 683 | `set-language-info' for the meanings of KEY and INFO. |
54b226f7 | 684 | |
2c395d56 RS |
685 | Optional arg PARENTS is a list of parent menu names; it specifies |
686 | where to put this language environment in the | |
687 | Describe Language Environment and Set Language Environment menus. | |
688 | For example, (\"European\") means to put this language environment | |
689 | in the European submenu in each of those two menus." | |
690 | (if (symbolp lang-env) | |
691 | (setq lang-env (symbol-name lang-env))) | |
54b226f7 KH |
692 | (let ((describe-map describe-language-environment-map) |
693 | (setup-map setup-language-environment-map)) | |
694 | (if parents | |
695 | (let ((l parents) | |
696 | map parent-symbol parent) | |
697 | (while l | |
698 | (if (symbolp (setq parent-symbol (car l))) | |
699 | (setq parent (symbol-name parent)) | |
700 | (setq parent parent-symbol parent-symbol (intern parent))) | |
701 | (setq map (lookup-key describe-map (vector parent-symbol))) | |
702 | (if (not map) | |
703 | (progn | |
704 | (setq map (intern (format "describe-%s-environment-map" | |
705 | (downcase parent)))) | |
706 | (define-prefix-command map) | |
707 | (define-key-after describe-map (vector parent-symbol) | |
708 | (cons parent map) t))) | |
709 | (setq describe-map (symbol-value map)) | |
710 | (setq map (lookup-key setup-map (vector parent-symbol))) | |
711 | (if (not map) | |
712 | (progn | |
713 | (setq map (intern (format "setup-%s-environment-map" | |
714 | (downcase parent)))) | |
715 | (define-prefix-command map) | |
716 | (define-key-after setup-map (vector parent-symbol) | |
717 | (cons parent map) t))) | |
718 | (setq setup-map (symbol-value map)) | |
719 | (setq l (cdr l))))) | |
f08adf27 RS |
720 | |
721 | ;; Set up menu items for this language env. | |
7624ebb9 | 722 | (let ((doc (assq 'documentation alist))) |
f08adf27 RS |
723 | (when doc |
724 | (define-key-after describe-map (vector (intern lang-env)) | |
7624ebb9 KH |
725 | (cons lang-env 'describe-specified-language-support) t))) |
726 | (define-key-after setup-map (vector (intern lang-env)) | |
727 | (cons lang-env 'setup-specified-language-environment) t) | |
f08adf27 | 728 | |
54b226f7 | 729 | (while alist |
f08adf27 | 730 | (set-language-info lang-env (car (car alist)) (cdr (car alist))) |
54b226f7 | 731 | (setq alist (cdr alist))))) |
4ed46869 | 732 | |
ae302641 | 733 | (defun read-language-name (key prompt &optional default) |
2c395d56 | 734 | "Read a language environment name which has information for KEY. |
ddb5c041 | 735 | If KEY is nil, read any language environment. |
2c395d56 RS |
736 | Prompt with PROMPT. DEFAULT is the default choice of language environment. |
737 | This returns a language environment name as a string." | |
4ed46869 KH |
738 | (let* ((completion-ignore-case t) |
739 | (name (completing-read prompt | |
740 | language-info-alist | |
ddb5c041 KH |
741 | (and key |
742 | (function (lambda (elm) (assq key elm)))) | |
ae302641 | 743 | t nil nil default))) |
13e82c04 | 744 | (if (and (> (length name) 0) |
ddb5c041 KH |
745 | (or (not key) |
746 | (get-language-info name key))) | |
13e82c04 | 747 | name))) |
4ed46869 KH |
748 | \f |
749 | ;;; Multilingual input methods. | |
750 | ||
d0b9c3ab KH |
751 | (defconst leim-list-file-name "leim-list.el" |
752 | "Name of LEIM list file. | |
753 | This file contains a list of libraries of Emacs input methods (LEIM) | |
754 | in the format of Lisp expression for registering each input method. | |
755 | Emacs loads this file at startup time.") | |
756 | ||
757 | (defvar leim-list-header (format "\ | |
758 | ;;; %s -- list of LEIM (Library of Emacs Input Method) | |
759 | ;; | |
760 | ;; This file contains a list of LEIM (Library of Emacs Input Method) | |
e8dd0160 | 761 | ;; in the same directory as this file. Loading this file registers |
d0b9c3ab KH |
762 | ;; the whole input methods in Emacs. |
763 | ;; | |
d33d5fbe | 764 | ;; Each entry has the form: |
d0b9c3ab KH |
765 | ;; (register-input-method |
766 | ;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC | |
767 | ;; TITLE DESCRIPTION | |
768 | ;; ARG ...) | |
769 | ;; See the function `register-input-method' for the meanings of arguments. | |
770 | ;; | |
771 | ;; If this directory is included in load-path, Emacs automatically | |
772 | ;; loads this file at startup time. | |
773 | ||
774 | " | |
775 | leim-list-file-name) | |
776 | "Header to be inserted in LEIM list file.") | |
777 | ||
e55e92ee | 778 | (defvar leim-list-entry-regexp "^(register-input-method" |
d0b9c3ab KH |
779 | "Regexp matching head of each entry in LEIM list file. |
780 | See also the variable `leim-list-header'") | |
781 | ||
782 | (defvar update-leim-list-functions | |
783 | '(quail-update-leim-list-file) | |
784 | "List of functions to call to update LEIM list file. | |
785 | Each function is called with one arg, LEIM directory name.") | |
786 | ||
a337fe7f RS |
787 | (defun update-leim-list-file (&rest dirs) |
788 | "Update LEIM list file in directories DIRS." | |
d0b9c3ab KH |
789 | (let ((functions update-leim-list-functions)) |
790 | (while functions | |
a337fe7f | 791 | (apply (car functions) dirs) |
d0b9c3ab KH |
792 | (setq functions (cdr functions))))) |
793 | ||
4ed46869 KH |
794 | (defvar current-input-method nil |
795 | "The current input method for multilingual text. | |
96db204a | 796 | If nil, that means no input method is activated now.") |
4ed46869 KH |
797 | (make-variable-buffer-local 'current-input-method) |
798 | (put 'current-input-method 'permanent-local t) | |
799 | ||
800 | (defvar current-input-method-title nil | |
d0b9c3ab | 801 | "Title string of the current input method shown in mode line.") |
4ed46869 KH |
802 | (make-variable-buffer-local 'current-input-method-title) |
803 | (put 'current-input-method-title 'permanent-local t) | |
804 | ||
b4fba33f | 805 | (defcustom default-input-method nil |
8861c593 | 806 | "*Default input method for multilingual text (a string). |
b4fba33f | 807 | This is the input method activated automatically by the command |
9b10b5a3 | 808 | `toggle-input-method' (\\[toggle-input-method])." |
8861c593 | 809 | :group 'mule |
83a03f4d | 810 | :type '(choice (const nil) string)) |
b4fba33f | 811 | |
723a427a KH |
812 | (defvar input-method-history nil |
813 | "History list for some commands that read input methods.") | |
814 | (make-variable-buffer-local 'input-method-history) | |
815 | (put 'input-method-history 'permanent-local t) | |
4ed46869 KH |
816 | |
817 | (defvar inactivate-current-input-method-function nil | |
818 | "Function to call for inactivating the current input method. | |
819 | Every input method should set this to an appropriate value when activated. | |
f17ccaee KH |
820 | This function is called with no argument. |
821 | ||
822 | This function should never change the value of `current-input-method'. | |
823 | It is set to nil by the function `inactivate-input-method'.") | |
4ed46869 KH |
824 | (make-variable-buffer-local 'inactivate-current-input-method-function) |
825 | (put 'inactivate-current-input-method-function 'permanent-local t) | |
826 | ||
827 | (defvar describe-current-input-method-function nil | |
828 | "Function to call for describing the current input method. | |
829 | This function is called with no argument.") | |
830 | (make-variable-buffer-local 'describe-current-input-method-function) | |
831 | (put 'describe-current-input-method-function 'permanent-local t) | |
832 | ||
d0b9c3ab | 833 | (defvar input-method-alist nil |
2c395d56 | 834 | "Alist of input method names vs how to use them. |
d0b9c3ab | 835 | Each element has the form: |
2c395d56 RS |
836 | (INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...) |
837 | See the function `register-input-method' for the meanings of the elements.") | |
838 | ||
f08adf27 | 839 | (defun register-input-method (input-method lang-env &rest args) |
2c395d56 | 840 | "Register INPUT-METHOD as an input method for language environment ENV. |
f08adf27 | 841 | INPUT-METHOD and LANG-ENV are symbols or strings. |
d0b9c3ab | 842 | |
d0b9c3ab | 843 | The remaining arguments are: |
2c395d56 RS |
844 | ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARGS... |
845 | ACTIVATE-FUNC is a function to call to activate this method. | |
846 | TITLE is a string to show in the mode line when this method is active. | |
847 | DESCRIPTION is a string describing this method and what it is good for. | |
848 | The ARGS, if any, are passed as arguments to ACTIVATE-FUNC. | |
205814ee KH |
849 | All told, the arguments to ACTIVATE-FUNC are INPUT-METHOD and the ARGS. |
850 | ||
851 | This function is mainly used in the file \"leim-list.el\" which is | |
852 | created at building time of emacs, registering all quail input methods | |
853 | contained in the emacs distribution. | |
854 | ||
855 | In case you want to register a new quail input method by yourself, be | |
856 | careful to use the same input method title as given in the third | |
857 | parameter of `quail-define-package' (if the values are different, the | |
858 | string specified in this function takes precedence). | |
859 | ||
860 | The commands `describe-input-method' and `list-input-methods' need | |
861 | this duplicated values to show some information about input methods | |
862 | without loading the affected quail packages." | |
f08adf27 RS |
863 | (if (symbolp lang-env) |
864 | (setq lang-env (symbol-name lang-env))) | |
4ef06f75 KH |
865 | (if (symbolp input-method) |
866 | (setq input-method (symbol-name input-method))) | |
f08adf27 | 867 | (let ((info (cons lang-env args)) |
d0b9c3ab KH |
868 | (slot (assoc input-method input-method-alist))) |
869 | (if slot | |
870 | (setcdr slot info) | |
871 | (setq slot (cons input-method info)) | |
872 | (setq input-method-alist (cons slot input-method-alist))))) | |
873 | ||
4d5ac029 | 874 | (defun read-input-method-name (prompt &optional default inhibit-null) |
d0b9c3ab | 875 | "Read a name of input method from a minibuffer prompting with PROMPT. |
4d5ac029 RS |
876 | If DEFAULT is non-nil, use that as the default, |
877 | and substitute it into PROMPT at the first `%s'. | |
4ef06f75 KH |
878 | If INHIBIT-NULL is non-nil, null input signals an error. |
879 | ||
880 | The return value is a string." | |
4d5ac029 RS |
881 | (if default |
882 | (setq prompt (format prompt default))) | |
d0b9c3ab | 883 | (let* ((completion-ignore-case t) |
723a427a KH |
884 | ;; This binding is necessary because input-method-history is |
885 | ;; buffer local. | |
d0b9c3ab | 886 | (input-method (completing-read prompt input-method-alist |
87505a98 RS |
887 | nil t nil 'input-method-history |
888 | default))) | |
d0b9c3ab KH |
889 | (if (> (length input-method) 0) |
890 | input-method | |
891 | (if inhibit-null | |
43807b77 | 892 | (error "No valid input method is specified"))))) |
d0b9c3ab | 893 | |
d0b9c3ab | 894 | (defun activate-input-method (input-method) |
2c395d56 RS |
895 | "Switch to input method INPUT-METHOD for the current buffer. |
896 | If some other input method is already active, turn it off first. | |
897 | If INPUT-METHOD is nil, deactivate any current input method." | |
305a3cb6 | 898 | (if (and input-method (symbolp input-method)) |
4ef06f75 | 899 | (setq input-method (symbol-name input-method))) |
723a427a KH |
900 | (if (and current-input-method |
901 | (not (string= current-input-method input-method))) | |
305a3cb6 | 902 | (inactivate-input-method)) |
2c395d56 | 903 | (unless (or current-input-method (null input-method)) |
d0b9c3ab KH |
904 | (let ((slot (assoc input-method input-method-alist))) |
905 | (if (null slot) | |
723a427a | 906 | (error "Can't activate input method `%s'" input-method)) |
8efc03e1 KH |
907 | (let ((func (nth 2 slot))) |
908 | (if (functionp func) | |
909 | (apply (nth 2 slot) input-method (nthcdr 5 slot)) | |
910 | (if (and (consp func) (symbolp (car func)) (symbolp (cdr func))) | |
911 | (progn | |
912 | (require (cdr func)) | |
913 | (apply (car func) input-method (nthcdr 5 slot))) | |
914 | (error "Can't activate input method `%s'" input-method)))) | |
d0b9c3ab | 915 | (setq current-input-method input-method) |
723a427a | 916 | (setq current-input-method-title (nth 3 slot)) |
28885c0e KH |
917 | (unwind-protect |
918 | (run-hooks 'input-method-activate-hook) | |
919 | (force-mode-line-update))))) | |
15b3e511 | 920 | |
15b3e511 | 921 | (defun inactivate-input-method () |
f17ccaee | 922 | "Turn off the current input method." |
723a427a KH |
923 | (when current-input-method |
924 | (if input-method-history | |
925 | (unless (string= current-input-method (car input-method-history)) | |
926 | (setq input-method-history | |
927 | (cons current-input-method | |
928 | (delete current-input-method input-method-history)))) | |
929 | (setq input-method-history (list current-input-method))) | |
930 | (unwind-protect | |
931 | (funcall inactivate-current-input-method-function) | |
15b3e511 | 932 | (unwind-protect |
723a427a KH |
933 | (run-hooks 'input-method-inactivate-hook) |
934 | (setq current-input-method nil | |
28885c0e KH |
935 | current-input-method-title nil) |
936 | (force-mode-line-update))))) | |
4ed46869 | 937 | |
8b784951 | 938 | (defun set-input-method (input-method) |
2c395d56 RS |
939 | "Select and activate input method INPUT-METHOD for the current buffer. |
940 | This also sets the default input method to the one you specify." | |
d0b9c3ab | 941 | (interactive |
723a427a | 942 | (let* ((default (or (car input-method-history) default-input-method))) |
42395763 | 943 | (list (read-input-method-name |
87505a98 | 944 | (if default "Select input method (default %s): " "Select input method: ") |
42395763 | 945 | default t)))) |
d0b9c3ab | 946 | (activate-input-method input-method) |
42395763 | 947 | (setq default-input-method input-method)) |
4ed46869 KH |
948 | |
949 | (defun toggle-input-method (&optional arg) | |
15b3e511 | 950 | "Turn on or off a multilingual text input method for the current buffer. |
723a427a | 951 | |
7ddbb5bc RS |
952 | With no prefix argument, if some input method is currently activated, |
953 | turn it off. Otherwise, activate an input method--the one most recently used, | |
954 | or the one specified in `default-input-method', or one read from the | |
955 | minibuffer. | |
723a427a | 956 | |
7ddbb5bc RS |
957 | With a prefix arg, read an input method from minibuffer and turn it on. |
958 | The default is the most recent input method specified | |
959 | \(not including the currently active input method, if any). | |
723a427a KH |
960 | |
961 | When there's no input method to turn on, turn on what read from minibuffer." | |
4ed46869 | 962 | (interactive "P") |
7ddbb5bc RS |
963 | (if (and current-input-method (not arg)) |
964 | (inactivate-input-method) | |
965 | (let ((default (or (car input-method-history) default-input-method))) | |
966 | (if (and arg default (equal current-input-method default) | |
967 | (> (length input-method-history) 1)) | |
968 | (setq default (nth 1 input-method-history))) | |
723a427a KH |
969 | (activate-input-method |
970 | (if (or arg (not default)) | |
7ddbb5bc RS |
971 | (progn |
972 | (read-input-method-name | |
973 | (if default "Input method (default %s): " "Input method: " ) | |
974 | default t)) | |
723a427a KH |
975 | default)) |
976 | (or default-input-method | |
977 | (setq default-input-method current-input-method))))) | |
d0b9c3ab KH |
978 | |
979 | (defun describe-input-method (input-method) | |
2c395d56 | 980 | "Describe input method INPUT-METHOD." |
d0b9c3ab KH |
981 | (interactive |
982 | (list (read-input-method-name | |
983 | "Describe input method (default, current choice): "))) | |
78754934 | 984 | (if (and input-method (symbolp input-method)) |
4ef06f75 | 985 | (setq input-method (symbol-name input-method))) |
d0b9c3ab KH |
986 | (if (null input-method) |
987 | (describe-current-input-method) | |
988 | (with-output-to-temp-buffer "*Help*" | |
989 | (let ((elt (assoc input-method input-method-alist))) | |
990 | (princ (format "Input method: %s (`%s' in mode line) for %s\n %s\n" | |
991 | input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))) | |
992 | ||
993 | (defun describe-current-input-method () | |
96db204a | 994 | "Describe the input method currently in use." |
4ed46869 KH |
995 | (if current-input-method |
996 | (if (and (symbolp describe-current-input-method-function) | |
997 | (fboundp describe-current-input-method-function)) | |
998 | (funcall describe-current-input-method-function) | |
999 | (message "No way to describe the current input method `%s'" | |
1000 | (cdr current-input-method)) | |
1001 | (ding)) | |
d0b9c3ab | 1002 | (error "No input method is activated now"))) |
4ed46869 | 1003 | |
d3459641 | 1004 | (defun read-multilingual-string (prompt &optional initial-input input-method) |
4ed46869 KH |
1005 | "Read a multilingual string from minibuffer, prompting with string PROMPT. |
1006 | The input method selected last time is activated in minibuffer. | |
15b3e511 | 1007 | If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer |
d0b9c3ab KH |
1008 | initially. |
1009 | Optional 3rd argument INPUT-METHOD specifies the input method | |
4ef06f75 KH |
1010 | to be activated instead of the one selected last time. It is a symbol |
1011 | or a string." | |
88d559ec KH |
1012 | (setq input-method |
1013 | (or input-method | |
d3459641 | 1014 | current-input-method |
88d559ec KH |
1015 | default-input-method |
1016 | (read-input-method-name "Input method: " nil t))) | |
3df60841 | 1017 | (if (and input-method (symbolp input-method)) |
4ef06f75 | 1018 | (setq input-method (symbol-name input-method))) |
305a3cb6 KH |
1019 | (let ((prev-input-method current-input-method)) |
1020 | (unwind-protect | |
1021 | (progn | |
1022 | (activate-input-method input-method) | |
1023 | (read-string prompt initial-input nil nil t)) | |
1024 | (activate-input-method prev-input-method)))) | |
4ed46869 KH |
1025 | |
1026 | ;; Variables to control behavior of input methods. All input methods | |
1027 | ;; should react to these variables. | |
1028 | ||
8efc03e1 KH |
1029 | (defcustom input-method-verbose-flag 'default |
1030 | "*A flag to control extra guidance given by input methods. | |
1031 | The value should be nil, t, `complex-only', or `default'. | |
4ed46869 | 1032 | |
cb29dfb6 | 1033 | The extra guidance is done by showing list of available keys in echo |
8efc03e1 KH |
1034 | area. When you use the input method in the minibuffer, the guidance |
1035 | is shown at the bottom short window (split from the existing window). | |
c27c4ed8 | 1036 | |
8efc03e1 KH |
1037 | If the value is t, extra guidance is always given, if the value is |
1038 | nil, extra guidance is always suppressed. | |
1039 | ||
1040 | If the value is `complex-only', only complex input methods such as | |
1041 | `chinese-py' and `japanese' give extra guidance. | |
1042 | ||
1043 | If the value is `default', complex input methods always give extra | |
1044 | guidance, but simple input methods give it only when you are not in | |
1045 | the minibuffer. | |
1046 | ||
1047 | See also the variable `input-method-highlight-flag'." | |
1048 | :type '(choice (const t) (const nil) (const complex-only) (const default)) | |
42395763 RS |
1049 | :group 'mule) |
1050 | ||
1051 | (defcustom input-method-highlight-flag t | |
1052 | "*If this flag is non-nil, input methods highlight partially-entered text. | |
1053 | For instance, while you are in the middle of a Quail input method sequence, | |
1054 | the text inserted so far is temporarily underlined. | |
8efc03e1 KH |
1055 | The underlining goes away when you finish or abort the input method sequence. |
1056 | See also the variable `input-method-verbose-flag'." | |
42395763 RS |
1057 | :type 'boolean |
1058 | :group 'mule) | |
4ed46869 KH |
1059 | |
1060 | (defvar input-method-activate-hook nil | |
f17ccaee KH |
1061 | "Normal hook run just after an input method is activated. |
1062 | ||
1063 | The variable `current-input-method' keeps the input method name | |
1064 | just activated.") | |
4ed46869 KH |
1065 | |
1066 | (defvar input-method-inactivate-hook nil | |
f17ccaee KH |
1067 | "Normal hook run just after an input method is inactivated. |
1068 | ||
1069 | The variable `current-input-method' still keeps the input method name | |
4d0e6a11 | 1070 | just inactivated.") |
4ed46869 KH |
1071 | |
1072 | (defvar input-method-after-insert-chunk-hook nil | |
1073 | "Normal hook run just after an input method insert some chunk of text.") | |
1074 | ||
dccca980 KH |
1075 | (defvar input-method-exit-on-first-char nil |
1076 | "This flag controls a timing when an input method returns. | |
1077 | Usually, the input method does not return while there's a possibility | |
1078 | that it may find a different translation if a user types another key. | |
39e643e2 RS |
1079 | But, it this flag is non-nil, the input method returns as soon as |
1080 | the current key sequence gets long enough to have some valid translation.") | |
dccca980 KH |
1081 | |
1082 | (defvar input-method-use-echo-area nil | |
1083 | "This flag controls how an input method shows an intermediate key sequence. | |
39e643e2 RS |
1084 | Usually, the input method inserts the intermediate key sequence, |
1085 | or candidate translations corresponding to the sequence, | |
1086 | at point in the current buffer. | |
1087 | But, if this flag is non-nil, it displays them in echo area instead.") | |
dccca980 | 1088 | |
723a427a KH |
1089 | (defvar input-method-exit-on-invalid-key nil |
1090 | "This flag controls the behaviour of an input method on invalid key input. | |
1091 | Usually, when a user types a key which doesn't start any character | |
1092 | handled by the input method, the key is handled by turning off the | |
e8dd0160 | 1093 | input method temporarily. After that key, the input method is re-enabled. |
723a427a KH |
1094 | But, if this flag is non-nil, the input method is never back on.") |
1095 | ||
4ed46869 | 1096 | \f |
8efc03e1 KH |
1097 | (defvar set-language-environment-hook nil |
1098 | "Normal hook run after some language environment is set. | |
1099 | ||
1100 | When you set some hook function here, that effect usually should not | |
1101 | be inherited to another language environment. So, you had better set | |
1102 | another function in `exit-language-environment-hook' (which see) to | |
1103 | cancel the effect.") | |
1104 | ||
1105 | (defvar exit-language-environment-hook nil | |
1106 | "Normal hook run after exiting from some language environment. | |
1107 | When this hook is run, the variable `current-language-environment' | |
1108 | is still bound to the language environment being exited. | |
1109 | ||
e8dd0160 | 1110 | This hook is mainly used for canceling the effect of |
8efc03e1 KH |
1111 | `set-language-environment-hook' (which-see).") |
1112 | ||
b0648a00 RS |
1113 | (put 'setup-specified-language-environment 'apropos-inhibit t) |
1114 | ||
15b3e511 | 1115 | (defun setup-specified-language-environment () |
f08adf27 | 1116 | "Switch to a specified language environment." |
15b3e511 | 1117 | (interactive) |
f850d782 | 1118 | (let (language-name) |
15b3e511 KH |
1119 | (if (and (symbolp last-command-event) |
1120 | (or (not (eq last-command-event 'Default)) | |
1121 | (setq last-command-event 'English)) | |
f850d782 RS |
1122 | (setq language-name (symbol-name last-command-event))) |
1123 | (set-language-environment language-name) | |
15b3e511 | 1124 | (error "Bogus calling sequence")))) |
4ed46869 | 1125 | |
8861c593 | 1126 | (defcustom current-language-environment "English" |
94d04df6 DL |
1127 | "The last language environment specified with `set-language-environment'. |
1128 | This variable should only be set with Customize, which is equivalent | |
1129 | to using `set-language-environment'." | |
1130 | :link '(custom-manual "(emacs)Language Environments") | |
dff1aa24 | 1131 | :set (lambda (symbol value) (set-language-environment value)) |
94d04df6 DL |
1132 | :get (lambda (x) |
1133 | (or (car-safe (assoc-ignore-case | |
1134 | (if (symbolp current-language-environment) | |
1135 | (symbol-name current-language-environment) | |
1136 | current-language-environment) | |
1137 | language-info-alist)) | |
1138 | "English")) | |
1139 | :type (cons 'choice (mapcar (lambda (lang) | |
1140 | (list 'const (car lang))) | |
1141 | language-info-alist)) | |
8861c593 RS |
1142 | :initialize 'custom-initialize-default |
1143 | :group 'mule | |
1144 | :type 'string) | |
f850d782 | 1145 | |
ddb5c041 KH |
1146 | (defun reset-language-environment () |
1147 | "Reset multilingual environment of Emacs to the default status. | |
1148 | ||
1149 | The default status is as follows: | |
1150 | ||
1151 | The default value of buffer-file-coding-system is nil. | |
1152 | The default coding system for process I/O is nil. | |
1153 | The default value for the command `set-terminal-coding-system' is nil. | |
1154 | The default value for the command `set-keyboard-coding-system' is nil. | |
1155 | ||
1156 | The order of priorities of coding categories and the coding system | |
1157 | bound to each category are as follows | |
1158 | coding category coding system | |
1159 | -------------------------------------------------- | |
1160 | coding-category-iso-8-2 iso-latin-1 | |
1161 | coding-category-iso-8-1 iso-latin-1 | |
1162 | coding-category-iso-7-tight iso-2022-jp | |
1163 | coding-category-iso-7 iso-2022-7bit | |
1164 | coding-category-iso-7-else iso-2022-7bit-lock | |
1165 | coding-category-iso-8-else iso-2022-8bit-ss2 | |
1166 | coding-category-emacs-mule emacs-mule | |
1167 | coding-category-raw-text raw-text | |
1168 | coding-category-sjis japanese-shift-jis | |
1169 | coding-category-big5 chinese-big5 | |
1170 | coding-category-ccl nil | |
e8dd0160 | 1171 | coding-category-binary no-conversion |
ddb5c041 KH |
1172 | " |
1173 | (interactive) | |
1174 | ;; This function formerly set default-enable-multibyte-characters to t, | |
1175 | ;; but that is incorrect. It should not alter the unibyte/multibyte choice. | |
1176 | ||
1177 | (setq coding-category-iso-7-tight 'iso-2022-jp | |
1178 | coding-category-iso-7 'iso-2022-7bit | |
1179 | coding-category-iso-8-1 'iso-latin-1 | |
1180 | coding-category-iso-8-2 'iso-latin-1 | |
1181 | coding-category-iso-7-else 'iso-2022-7bit-lock | |
1182 | coding-category-iso-8-else 'iso-2022-8bit-ss2 | |
1183 | coding-category-emacs-mule 'emacs-mule | |
1184 | coding-category-raw-text 'raw-text | |
1185 | coding-category-sjis 'japanese-shift-jis | |
1186 | coding-category-big5 'chinese-big5 | |
1187 | coding-category-ccl nil | |
1188 | coding-category-binary 'no-conversion) | |
1189 | ||
1190 | (set-coding-priority | |
1191 | '(coding-category-iso-8-1 | |
1192 | coding-category-iso-8-2 | |
1193 | coding-category-iso-7-tight | |
1194 | coding-category-iso-7 | |
1195 | coding-category-iso-7-else | |
1196 | coding-category-iso-8-else | |
1197 | coding-category-emacs-mule | |
1198 | coding-category-raw-text | |
1199 | coding-category-sjis | |
1200 | coding-category-big5 | |
1201 | coding-category-ccl | |
1202 | coding-category-binary)) | |
1203 | ||
91693d18 KH |
1204 | (update-coding-systems-internal) |
1205 | ||
ddb5c041 KH |
1206 | (set-default-coding-systems nil) |
1207 | ;; Don't alter the terminal and keyboard coding systems here. | |
1208 | ;; The terminal still supports the same coding system | |
1209 | ;; that it supported a minute ago. | |
1210 | ;;; (set-terminal-coding-system-internal nil) | |
1211 | ;;; (set-keyboard-coding-system-internal nil) | |
1212 | ||
1213 | (setq nonascii-translation-table nil | |
1214 | nonascii-insert-offset 0)) | |
1215 | ||
166246f7 | 1216 | (defun set-language-environment (language-name) |
6c05d680 RS |
1217 | "Set up multi-lingual environment for using LANGUAGE-NAME. |
1218 | This sets the coding system priority and the default input method | |
8861c593 RS |
1219 | and sometimes other things. LANGUAGE-NAME should be a string |
1220 | which is the name of a language environment. For example, \"Latin-1\" | |
1221 | specifies the character set for the major languages of Western Europe." | |
8efc03e1 | 1222 | (interactive (list (read-language-name |
ddb5c041 | 1223 | nil |
8efc03e1 | 1224 | "Set language environment (default, English): "))) |
4ef06f75 KH |
1225 | (if language-name |
1226 | (if (symbolp language-name) | |
1227 | (setq language-name (symbol-name language-name))) | |
1228 | (setq language-name "English")) | |
ddb5c041 | 1229 | (or (assoc-ignore-case language-name language-info-alist) |
f850d782 | 1230 | (error "Language environment not defined: %S" language-name)) |
8efc03e1 KH |
1231 | (if current-language-environment |
1232 | (let ((func (get-language-info current-language-environment | |
1233 | 'exit-function))) | |
e63645c2 KH |
1234 | (run-hooks 'exit-language-environment-hook) |
1235 | (if (fboundp func) (funcall func)))) | |
03c35c83 EZ |
1236 | (let ((default-eol-type (coding-system-eol-type |
1237 | default-buffer-file-coding-system))) | |
1238 | (reset-language-environment) | |
ddb5c041 | 1239 | |
03c35c83 EZ |
1240 | (setq current-language-environment language-name) |
1241 | (set-language-environment-coding-systems language-name default-eol-type)) | |
ddb5c041 KH |
1242 | (let ((input-method (get-language-info language-name 'input-method))) |
1243 | (when input-method | |
1244 | (setq default-input-method input-method) | |
1245 | (if input-method-history | |
1246 | (setq input-method-history | |
1247 | (cons input-method | |
1248 | (delete input-method input-method-history)))))) | |
1249 | (let ((nonascii (get-language-info language-name 'nonascii-translation))) | |
03c35c83 EZ |
1250 | (cond |
1251 | ((char-table-p nonascii) | |
1252 | (setq nonascii-translation-table nonascii)) | |
1253 | ((eq window-system 'pc) | |
1254 | ;; DOS terminals' default is to use a special non-ASCII translation | |
1255 | ;; table as appropriate for the installed codepage. | |
1256 | (setq | |
1257 | nonascii-translation-table (symbol-value | |
1258 | (intern | |
1259 | (concat "cp" | |
1260 | dos-codepage | |
1261 | "-nonascii-translation-table"))))) | |
1262 | ((charsetp nonascii) | |
1263 | (setq nonascii-insert-offset (- (make-char nonascii) 128))))) | |
ddb5c041 | 1264 | |
45d08cb2 KH |
1265 | (setq charset-origin-alist |
1266 | (get-language-info language-name 'charset-origin-alist)) | |
ddb5c041 | 1267 | |
63283a8f | 1268 | ;; Unibyte setups if necessary. |
ddb5c041 | 1269 | (unless default-enable-multibyte-characters |
63283a8f | 1270 | ;; Syntax and case table. |
ddb5c041 KH |
1271 | (let ((syntax (get-language-info language-name 'unibyte-syntax))) |
1272 | (if syntax | |
1273 | (let ((set-case-syntax-set-multibyte nil)) | |
63283a8f KH |
1274 | (load syntax nil t)) |
1275 | ;; No information for syntax and case. Reset to the defaults. | |
1276 | (let ((syntax-table (standard-syntax-table)) | |
1277 | (case-table (standard-case-table)) | |
03c35c83 | 1278 | (ch (if (eq window-system 'pc) 128 160))) |
63283a8f KH |
1279 | (while (< ch 256) |
1280 | (modify-syntax-entry ch " " syntax-table) | |
1281 | (aset case-table ch ch) | |
1282 | (setq ch (1+ ch))) | |
1283 | (set-char-table-extra-slot case-table 0 nil) | |
1284 | (set-char-table-extra-slot case-table 1 nil) | |
1285 | (set-char-table-extra-slot case-table 2 nil)) | |
1286 | (set-standard-case-table (standard-case-table)) | |
1287 | (let ((list (buffer-list))) | |
1288 | (while list | |
1289 | (with-current-buffer (car list) | |
1290 | (set-case-table (standard-case-table))) | |
1291 | (setq list (cdr list)))))) | |
1292 | ;; Display table and coding system for terminal. | |
ddb5c041 KH |
1293 | (let ((coding (get-language-info language-name 'unibyte-display))) |
1294 | (if coding | |
03c35c83 EZ |
1295 | (standard-display-european-internal) |
1296 | (standard-display-default (if (eq window-system 'pc) 128 160) 255) | |
1297 | (aset standard-display-table 146 nil)) | |
1298 | (or (eq window-system 'pc) | |
1299 | (set-terminal-coding-system coding)))) | |
ddb5c041 KH |
1300 | |
1301 | (let ((required-features (get-language-info language-name 'features))) | |
1302 | (while required-features | |
1303 | (require (car required-features)) | |
1304 | (setq required-features (cdr required-features)))) | |
1305 | (let ((func (get-language-info language-name 'setup-function))) | |
1306 | (if (fboundp func) | |
1307 | (funcall func))) | |
8efc03e1 | 1308 | (run-hooks 'set-language-environment-hook) |
f850d782 | 1309 | (force-mode-line-update t)) |
4ed46869 | 1310 | |
51a8fc1d RS |
1311 | (defun standard-display-european-internal () |
1312 | ;; Actually set up direct output of non-ASCII characters. | |
03c35c83 EZ |
1313 | (standard-display-8bit (if (eq window-system 'pc) 128 160) 255) |
1314 | ;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with | |
1315 | ;; the native font, and codes 160 and 146 stand for something very | |
1316 | ;; different there. | |
1317 | (or (and (eq window-system 'pc) (not default-enable-multibyte-characters)) | |
1318 | (progn | |
1319 | ;; Make non-line-break space display as a plain space. | |
1320 | ;; Most X fonts do the wrong thing for code 160. | |
1321 | (aset standard-display-table 160 [32]) | |
1322 | ;; Most Windows programs send out apostrophe's as \222. Most X fonts | |
1323 | ;; don't contain a character at that position. Map it to the ASCII | |
1324 | ;; apostrophe. | |
1325 | (aset standard-display-table 146 [39])))) | |
1326 | ||
1327 | (defun set-language-environment-coding-systems (language-name | |
1328 | &optional eol-type) | |
1329 | "Do various coding system setups for language environment LANGUAGE-NAME. | |
1330 | ||
1331 | The optional arg EOL-TYPE specifies the eol-type of the default value | |
1332 | of buffer-file-coding-system set by this function." | |
54b226f7 KH |
1333 | (let* ((priority (get-language-info language-name 'coding-priority)) |
1334 | (default-coding (car priority))) | |
1335 | (if priority | |
1336 | (let ((categories (mapcar 'coding-system-category priority))) | |
03c35c83 EZ |
1337 | (set-default-coding-systems |
1338 | (if (memq eol-type '(0 1 2 unix dos mac)) | |
1339 | (coding-system-change-eol-conversion default-coding eol-type) | |
1340 | default-coding)) | |
46babb23 | 1341 | (setq default-sendmail-coding-system default-coding) |
54b226f7 KH |
1342 | (set-coding-priority categories) |
1343 | (while priority | |
1344 | (set (car categories) (car priority)) | |
1345 | (setq priority (cdr priority) categories (cdr categories))) | |
45d08cb2 | 1346 | (update-coding-systems-internal))))) |
54b226f7 | 1347 | |
4ed46869 KH |
1348 | ;; Print all arguments with `princ', then print "\n". |
1349 | (defsubst princ-list (&rest args) | |
1350 | (while args (princ (car args)) (setq args (cdr args))) | |
1351 | (princ "\n")) | |
1352 | ||
b0648a00 RS |
1353 | (put 'describe-specified-language-support 'apropos-inhibit t) |
1354 | ||
48082651 | 1355 | ;; Print a language specific information such as input methods, |
13e82c04 | 1356 | ;; charsets, and coding systems. This function is intended to be |
48082651 | 1357 | ;; called from the menu: |
281d03ec | 1358 | ;; [menu-bar mule describe-language-environment LANGUAGE] |
48082651 KH |
1359 | ;; and should not run it by `M-x describe-current-input-method-function'. |
1360 | (defun describe-specified-language-support () | |
96db204a | 1361 | "Describe how Emacs supports the specified language environment." |
48082651 | 1362 | (interactive) |
281d03ec | 1363 | (let (language-name) |
48082651 | 1364 | (if (not (and (symbolp last-command-event) |
281d03ec | 1365 | (setq language-name (symbol-name last-command-event)))) |
48082651 | 1366 | (error "Bogus calling sequence")) |
281d03ec RS |
1367 | (describe-language-environment language-name))) |
1368 | ||
1369 | (defun describe-language-environment (language-name) | |
1370 | "Describe how Emacs supports language environment LANGUAGE-NAME." | |
78754934 KH |
1371 | (interactive |
1372 | (list (read-language-name | |
1373 | 'documentation | |
8adfa8be | 1374 | "Describe language environment (default, current choice): "))) |
f850d782 RS |
1375 | (if (null language-name) |
1376 | (setq language-name current-language-environment)) | |
281d03ec RS |
1377 | (if (or (null language-name) |
1378 | (null (get-language-info language-name 'documentation))) | |
1379 | (error "No documentation for the specified language")) | |
4ef06f75 KH |
1380 | (if (symbolp language-name) |
1381 | (setq language-name (symbol-name language-name))) | |
281d03ec | 1382 | (let ((doc (get-language-info language-name 'documentation))) |
48082651 | 1383 | (with-output-to-temp-buffer "*Help*" |
a33c9d6f | 1384 | (princ-list language-name " language environment" "\n") |
13e82c04 | 1385 | (if (stringp doc) |
d0b9c3ab KH |
1386 | (progn |
1387 | (princ-list doc) | |
1388 | (terpri))) | |
15b3e511 KH |
1389 | (let ((str (get-language-info language-name 'sample-text))) |
1390 | (if (stringp str) | |
1391 | (progn | |
281d03ec | 1392 | (princ "Sample text:\n") |
d0b9c3ab KH |
1393 | (princ-list " " str) |
1394 | (terpri)))) | |
ddb5c041 | 1395 | (let ((input-method (get-language-info language-name 'input-method)) |
00a069c6 | 1396 | (l (copy-sequence input-method-alist))) |
ddb5c041 KH |
1397 | (princ "Input methods") |
1398 | (when input-method | |
1399 | (princ (format " (default, %s)" input-method)) | |
1400 | (setq input-method (assoc input-method input-method-alist)) | |
1401 | (setq l (cons input-method (delete input-method l)))) | |
1402 | (princ ":\n") | |
15b3e511 | 1403 | (while l |
d0b9c3ab KH |
1404 | (if (string= language-name (nth 1 (car l))) |
1405 | (princ-list " " (car (car l)) | |
1406 | (format " (`%s' in mode line)" (nth 3 (car l))))) | |
15b3e511 | 1407 | (setq l (cdr l)))) |
281d03ec RS |
1408 | (terpri) |
1409 | (princ "Character sets:\n") | |
15b3e511 KH |
1410 | (let ((l (get-language-info language-name 'charset))) |
1411 | (if (null l) | |
1412 | (princ-list " nothing specific to " language-name) | |
1413 | (while l | |
1414 | (princ-list " " (car l) ": " | |
1415 | (charset-description (car l))) | |
1416 | (setq l (cdr l))))) | |
281d03ec RS |
1417 | (terpri) |
1418 | (princ "Coding systems:\n") | |
15b3e511 KH |
1419 | (let ((l (get-language-info language-name 'coding-system))) |
1420 | (if (null l) | |
1421 | (princ-list " nothing specific to " language-name) | |
48082651 | 1422 | (while l |
281d03ec RS |
1423 | (princ (format " %s (`%c' in mode line):\n\t%s\n" |
1424 | (car l) | |
1425 | (coding-system-mnemonic (car l)) | |
a904b20b | 1426 | (coding-system-doc-string (car l)))) |
8efc03e1 KH |
1427 | (let ((aliases (coding-system-get (car l) 'alias-coding-systems))) |
1428 | (when aliases | |
1429 | (princ "\t") | |
1430 | (princ (cons 'alias: (cdr aliases))) | |
1431 | (terpri))) | |
15b3e511 | 1432 | (setq l (cdr l)))))))) |
4ed46869 KH |
1433 | \f |
1434 | ;;; Charset property | |
1435 | ||
251d4f4b | 1436 | (defun get-charset-property (charset propname) |
4ed46869 KH |
1437 | "Return the value of CHARSET's PROPNAME property. |
1438 | This is the last value stored with | |
96db204a | 1439 | (put-charset-property CHARSET PROPNAME VALUE)." |
251d4f4b KH |
1440 | (and (not (eq charset 'composition)) |
1441 | (plist-get (charset-plist charset) propname))) | |
4ed46869 | 1442 | |
251d4f4b | 1443 | (defun put-charset-property (charset propname value) |
4ed46869 KH |
1444 | "Store CHARSETS's PROPNAME property with value VALUE. |
1445 | It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." | |
1300d43f KH |
1446 | (or (eq charset 'composition) |
1447 | (set-charset-plist charset | |
1448 | (plist-put (charset-plist charset) propname value)))) | |
4ed46869 KH |
1449 | |
1450 | ;;; Character code property | |
1451 | (put 'char-code-property-table 'char-table-extra-slots 0) | |
1452 | ||
1453 | (defvar char-code-property-table | |
1454 | (make-char-table 'char-code-property-table) | |
1455 | "Char-table containing a property list of each character code. | |
1456 | ||
1457 | See also the documentation of `get-char-code-property' and | |
96db204a | 1458 | `put-char-code-property'.") |
4ed46869 KH |
1459 | |
1460 | (defun get-char-code-property (char propname) | |
1461 | "Return the value of CHAR's PROPNAME property in `char-code-property-table'." | |
1462 | (let ((plist (aref char-code-property-table char))) | |
1463 | (if (listp plist) | |
1464 | (car (cdr (memq propname plist)))))) | |
1465 | ||
1466 | (defun put-char-code-property (char propname value) | |
1467 | "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. | |
1468 | It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." | |
1469 | (let ((plist (aref char-code-property-table char))) | |
1470 | (if plist | |
1471 | (let ((slot (memq propname plist))) | |
1472 | (if slot | |
1473 | (setcar (cdr slot) value) | |
1474 | (nconc plist (list propname value)))) | |
1475 | (aset char-code-property-table char (list propname value))))) | |
1476 | ||
1477 | ;;; mule-cmds.el ends here |