Commit | Line | Data |
---|---|---|
4ed46869 KH |
1 | ;;; mule-cmds.el --- Commands for mulitilingual environment |
2 | ||
3 | ;; Copyright (C) 1995 Free Software Foundation, Inc. | |
4 | ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | |
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 | ||
15b3e511 | 29 | (defvar mule-keymap nil |
4ed46869 | 30 | "Keymap for MULE (Multilingual environment) specific commands.") |
15b3e511 | 31 | (define-prefix-command 'mule-keymap) |
4ed46869 | 32 | |
8f81f784 | 33 | ;; Keep "C-x C-m ..." for mule specific commands. |
15b3e511 | 34 | (define-key ctl-x-map "\C-m" 'mule-keymap) |
ef8a8c8c | 35 | |
4ed46869 KH |
36 | (define-key mule-keymap "m" 'toggle-enable-multibyte-characters) |
37 | (define-key mule-keymap "f" 'set-buffer-file-coding-system) | |
38 | (define-key mule-keymap "t" 'set-terminal-coding-system) | |
15b3e511 KH |
39 | (define-key mule-keymap "k" 'set-keyboard-coding-system) |
40 | (define-key mule-keymap "p" 'set-buffer-process-coding-system) | |
0cbb4194 | 41 | (define-key mule-keymap "\C-\\" 'select-input-method) |
15b3e511 | 42 | (define-key mule-keymap "c" 'universal-coding-system-argument) |
4ed46869 | 43 | |
281d03ec | 44 | (define-key help-map "\C-L" 'describe-language-environment) |
4ed46869 KH |
45 | (define-key help-map "\C-\\" 'describe-input-method) |
46 | (define-key help-map "C" 'describe-current-coding-system) | |
47 | (define-key help-map "h" 'view-hello-file) | |
48 | ||
15b3e511 KH |
49 | (defvar mule-menu-keymap nil |
50 | "Keymap for MULE (Multilingual environment) menu specific commands.") | |
51 | (define-prefix-command 'mule-menu-keymap) | |
52 | ||
53 | (define-key global-map [menu-bar mule] (cons "Mule" mule-menu-keymap)) | |
54 | ||
55 | (setq menu-bar-final-items (cons 'mule menu-bar-final-items)) | |
56 | ||
281d03ec RS |
57 | (defvar describe-language-environment-map nil) |
58 | (define-prefix-command 'describe-language-environment-map) | |
15b3e511 KH |
59 | |
60 | (defvar setup-language-environment-map nil) | |
61 | (define-prefix-command 'setup-language-environment-map) | |
62 | ||
63 | (defvar set-coding-system-map nil) | |
64 | (define-prefix-command 'set-coding-system-map) | |
65 | ||
66 | (define-key-after mule-menu-keymap [toggle-mule] | |
67 | '("Toggle MULE facility" . toggle-enable-multibyte-characters) | |
68 | t) | |
281d03ec RS |
69 | (define-key-after mule-menu-keymap [describe-language-environment] |
70 | '("Describe language environment" . describe-language-environment-map) | |
15b3e511 KH |
71 | t) |
72 | (define-key-after mule-menu-keymap [set-language-environment] | |
73 | '("Set language environment" . setup-language-environment-map) | |
74 | t) | |
75 | (define-key-after mule-menu-keymap [separator-mule] | |
76 | '("--") | |
77 | t) | |
78 | (define-key-after mule-menu-keymap [toggle-input-method] | |
79 | '("Toggle input method" . toggle-input-method) | |
80 | t) | |
81 | (define-key-after mule-menu-keymap [select-input-method] | |
82 | '("Select input method" . select-input-method) | |
83 | t) | |
84 | (define-key-after mule-menu-keymap [describe-input-method] | |
85 | '("Describe input method" . describe-input-method) | |
86 | t) | |
87 | (define-key-after mule-menu-keymap [separator-input-method] | |
88 | '("--") | |
89 | t) | |
90 | (define-key-after mule-menu-keymap [describe-current-coding-system] | |
91 | '("Describe coding systems" . describe-current-coding-system) | |
92 | t) | |
93 | (define-key-after mule-menu-keymap [set-various-coding-system] | |
94 | '("Set coding systems" . set-coding-system-map) | |
95 | t) | |
96 | (define-key-after mule-menu-keymap [separator-coding-system] | |
97 | '("--") | |
98 | t) | |
99 | (define-key-after mule-menu-keymap [mule-diag] | |
100 | '("Show diagnosis for MULE" . mule-diag) | |
101 | t) | |
102 | (define-key-after mule-menu-keymap [view-hello-file] | |
103 | '("Show many languages" . view-hello-file) | |
104 | t) | |
105 | ||
106 | (define-key-after set-coding-system-map [set-buffer-file-coding-system] | |
107 | '("Buffer file" . set-buffer-file-coding-system) | |
108 | t) | |
109 | (define-key-after set-coding-system-map [set-terminal-coding-system] | |
110 | '("Terminal" . set-terminal-coding-system) | |
111 | t) | |
112 | (define-key-after set-coding-system-map [set-keyboard-coding-system] | |
113 | '("Keyboard" . set-keyboard-coding-system) | |
114 | t) | |
115 | (define-key-after set-coding-system-map [set-buffer-process-coding-system] | |
116 | '("Buffer process" . set-buffer-process-coding-system) | |
117 | t) | |
118 | ||
119 | (define-key setup-language-environment-map | |
120 | [Default] '("Default" . setup-specified-language-environment)) | |
4ed46869 KH |
121 | |
122 | ;; These are meaningless when running under X. | |
4ed46869 KH |
123 | (put 'set-terminal-coding-system 'menu-enable |
124 | '(null window-system)) | |
15b3e511 KH |
125 | (put 'set-keyboard-coding-system 'menu-enable |
126 | '(null window-system)) | |
4ed46869 | 127 | |
4ed46869 KH |
128 | ;; This should be a single character key binding because users use it |
129 | ;; very frequently while editing multilingual text. Now we can use | |
130 | ;; only two such keys: "\C-\\" and "\C-^", but the latter is not | |
131 | ;; convenient because it requires shifting on most keyboards. An | |
132 | ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' | |
133 | ;; but it won't be used that frequently. | |
134 | (define-key global-map "\C-\\" 'toggle-input-method) | |
135 | ||
136 | (defun toggle-enable-multibyte-characters (&optional arg) | |
137 | "Change whether this buffer enables multibyte characters. | |
138 | With arg, make them enable iff arg is positive." | |
139 | (interactive "P") | |
140 | (setq enable-multibyte-characters | |
141 | (if (null arg) (null enable-multibyte-characters) | |
142 | (> (prefix-numeric-value arg) 0))) | |
143 | (force-mode-line-update)) | |
144 | ||
145 | (defun view-hello-file () | |
146 | "Display the HELLO file which list up many languages and characters." | |
147 | (interactive) | |
8f81f784 KH |
148 | ;; We have to decode the file in any environment. |
149 | (let ((default-enable-multibyte-characters t) | |
150 | (coding-system-for-read 'iso-2022-7)) | |
151 | (find-file-read-only (expand-file-name "HELLO" data-directory)))) | |
4ed46869 | 152 | |
15b3e511 KH |
153 | (defun universal-coding-system-argument () |
154 | "Execute an I/O command using the specified coding system." | |
155 | (interactive) | |
156 | (let* ((coding-system (read-coding-system "Coding system: ")) | |
157 | (keyseq (read-key-sequence | |
158 | (format "With coding system %s:" coding-system))) | |
159 | (cmd (key-binding keyseq))) | |
160 | (let ((coding-system-for-read coding-system) | |
161 | (coding-system-for-write coding-system)) | |
162 | (message "") | |
163 | (call-interactively cmd)))) | |
164 | ||
4ed46869 KH |
165 | \f |
166 | ;;; Language support staffs. | |
167 | ||
168 | (defvar primary-language "English" | |
169 | "Name of a user's primary language. | |
170 | Emacs provide various language supports based on this variable.") | |
171 | ||
172 | (defvar language-info-alist nil | |
173 | "Alist of language names vs the corresponding information of various kind. | |
174 | Each element looks like: | |
175 | (LANGUAGE-NAME . ((KEY . INFO) ...)) | |
176 | where LANGUAGE-NAME is a string, | |
177 | KEY is a symbol denoting the kind of information, | |
178 | INFO is any Lisp object which contains the actual information related | |
179 | to KEY.") | |
180 | ||
181 | (defun get-language-info (language-name key) | |
182 | "Return the information for LANGUAGE-NAME of the kind KEY. | |
183 | LANGUAGE-NAME is a string. | |
184 | KEY is a symbol denoting the kind of required information." | |
15b3e511 | 185 | (let ((lang-slot (assoc-ignore-case language-name language-info-alist))) |
4ed46869 KH |
186 | (if lang-slot |
187 | (cdr (assq key (cdr lang-slot)))))) | |
188 | ||
4ed46869 KH |
189 | (defun set-language-info (language-name key info) |
190 | "Set for LANGUAGE-NAME the information INFO under KEY. | |
191 | LANGUAGE-NAME is a string | |
192 | KEY is a symbol denoting the kind of information. | |
193 | INFO is any Lisp object which contains the actual information. | |
194 | ||
195 | Currently, the following KEYs are used by Emacs: | |
281d03ec | 196 | |
4ed46869 | 197 | charset: list of symbols whose values are charsets specific to the language. |
281d03ec | 198 | |
4ed46869 | 199 | coding-system: list of coding systems specific to the langauge. |
281d03ec | 200 | |
4ed46869 | 201 | tutorial: a tutorial file name written in the language. |
281d03ec | 202 | |
4ed46869 | 203 | sample-text: one line short text containing characters of the language. |
281d03ec | 204 | |
4ed46869 | 205 | input-method: alist of input method names for the language vs information |
281d03ec RS |
206 | for activating them. Use `register-input-method' (which see) |
207 | to add a new input method to the alist. | |
208 | ||
15b3e511 | 209 | documentation: t or a string describing how Emacs supports the language. |
281d03ec RS |
210 | If a string is specified, it is shown before any other information |
211 | of the language by the command `describe-language-environment'. | |
212 | ||
13e82c04 | 213 | setup-function: a function to call for setting up environment |
281d03ec | 214 | convenient for a user of the language. |
15b3e511 KH |
215 | |
216 | If KEY is documentation or setup-function, you can also specify | |
217 | a cons cell as INFO, in which case, the car part should be | |
218 | a normal value as INFO for KEY (as described above), | |
219 | and the cdr part should be a symbol whose value is a menu keymap | |
220 | in which an entry for the language is defined. But, only the car part | |
221 | is actually set as the information. | |
13e82c04 | 222 | |
281d03ec RS |
223 | We will define more KEYs in the future. To avoid conflict, |
224 | if you want to use your own KEY values, make them start with `user-'." | |
4ed46869 KH |
225 | (let (lang-slot key-slot) |
226 | (setq lang-slot (assoc language-name language-info-alist)) | |
227 | (if (null lang-slot) ; If no slot for the language, add it. | |
228 | (setq lang-slot (list language-name) | |
229 | language-info-alist (cons lang-slot language-info-alist))) | |
230 | (setq key-slot (assq key lang-slot)) | |
231 | (if (null key-slot) ; If no slot for the key, add it. | |
232 | (progn | |
233 | (setq key-slot (list key)) | |
234 | (setcdr lang-slot (cons key-slot (cdr lang-slot))))) | |
4ed46869 | 235 | ;; Setup menu. |
48082651 | 236 | (cond ((eq key 'documentation) |
15b3e511 KH |
237 | (define-key-after |
238 | (if (consp info) | |
239 | (prog1 (symbol-value (cdr info)) | |
240 | (setq info (car info))) | |
281d03ec | 241 | describe-language-environment-map) |
ef8a8c8c | 242 | (vector (intern language-name)) |
48082651 | 243 | (cons language-name 'describe-specified-language-support) |
13e82c04 | 244 | t)) |
ef8a8c8c | 245 | ((eq key 'setup-function) |
15b3e511 KH |
246 | (define-key-after |
247 | (if (consp info) | |
248 | (prog1 (symbol-value (cdr info)) | |
249 | (setq info (car info))) | |
250 | setup-language-environment-map) | |
ef8a8c8c | 251 | (vector (intern language-name)) |
15b3e511 | 252 | (cons language-name 'setup-specified-language-environment) |
13e82c04 | 253 | t))) |
15b3e511 KH |
254 | |
255 | (setcdr key-slot info) | |
4ed46869 KH |
256 | )) |
257 | ||
258 | (defun set-language-info-alist (language-name alist) | |
259 | "Set for LANGUAGE-NAME the information in ALIST. | |
260 | ALIST is an alist of KEY and INFO. See the documentation of | |
261 | `set-langauge-info' for the meanings of KEY and INFO." | |
262 | (while alist | |
263 | (set-language-info language-name (car (car alist)) (cdr (car alist))) | |
264 | (setq alist (cdr alist)))) | |
265 | ||
266 | (defun read-language-name (key prompt &optional initial-input) | |
267 | "Read language name which has information for KEY, prompting with PROMPT." | |
268 | (let* ((completion-ignore-case t) | |
269 | (name (completing-read prompt | |
270 | language-info-alist | |
271 | (function (lambda (elm) (assq key elm))) | |
272 | t | |
273 | initial-input))) | |
13e82c04 KH |
274 | (if (and (> (length name) 0) |
275 | (get-language-info name key)) | |
276 | name))) | |
4ed46869 KH |
277 | \f |
278 | ;;; Multilingual input methods. | |
279 | ||
280 | (defvar current-input-method nil | |
281 | "The current input method for multilingual text. | |
282 | The value is a cons of language name and input method name. | |
283 | If nil, it means no input method is activated now.") | |
284 | (make-variable-buffer-local 'current-input-method) | |
285 | (put 'current-input-method 'permanent-local t) | |
286 | ||
287 | (defvar current-input-method-title nil | |
288 | "Title string of the current input method shown in mode line. | |
13e82c04 | 289 | Every input method should set this to an appropriate value when activated.") |
4ed46869 KH |
290 | (make-variable-buffer-local 'current-input-method-title) |
291 | (put 'current-input-method-title 'permanent-local t) | |
292 | ||
293 | (defvar default-input-method nil | |
294 | "Default input method. | |
295 | The default input method is the one activated automatically by the command | |
296 | `toggle-input-method' (\\[toggle-input-method]). | |
297 | The value is a cons of language name and input method name.") | |
15b3e511 KH |
298 | (make-variable-buffer-local 'default-input-method) |
299 | (put 'default-input-method 'permanent-local t) | |
4ed46869 KH |
300 | |
301 | (defvar default-input-method-title nil | |
302 | "Title string of the default input method.") | |
15b3e511 KH |
303 | (make-variable-buffer-local 'default-input-method-title) |
304 | (put 'default-input-method-title 'permanent-local t) | |
4ed46869 KH |
305 | |
306 | (defvar previous-input-method nil | |
307 | "Input method selected previously. | |
308 | This is the one selected before the current input method is selected. | |
309 | See also the documentation of `default-input-method'.") | |
15b3e511 KH |
310 | (make-variable-buffer-local 'previous-input-method) |
311 | (put 'previous-input-method 'permanent-local t) | |
4ed46869 KH |
312 | |
313 | (defvar inactivate-current-input-method-function nil | |
314 | "Function to call for inactivating the current input method. | |
315 | Every input method should set this to an appropriate value when activated. | |
316 | This function is called with no argument.") | |
317 | (make-variable-buffer-local 'inactivate-current-input-method-function) | |
318 | (put 'inactivate-current-input-method-function 'permanent-local t) | |
319 | ||
320 | (defvar describe-current-input-method-function nil | |
321 | "Function to call for describing the current input method. | |
322 | This function is called with no argument.") | |
323 | (make-variable-buffer-local 'describe-current-input-method-function) | |
324 | (put 'describe-current-input-method-function 'permanent-local t) | |
325 | ||
326 | (defun register-input-method (language-name input-method) | |
327 | "Register INPUT-METHOD as an input method of LANGUAGE-NAME. | |
328 | LANGUAGE-NAME is a string. | |
329 | INPUT-METHOD is a list of the form: | |
330 | (METHOD-NAME ACTIVATE-FUNC ARG ...) | |
331 | where METHOD-NAME is the name of this method, | |
332 | ACTIVATE-FUNC is the function to call for activating this method. | |
333 | Arguments for the function are METHOD-NAME and ARGs." | |
334 | (let ((slot (get-language-info language-name 'input-method)) | |
335 | method-slot) | |
336 | (if (null slot) | |
337 | (set-language-info language-name 'input-method (list input-method)) | |
338 | (setq method-slot (assoc (car input-method) slot)) | |
339 | (if method-slot | |
340 | (setcdr method-slot (cdr input-method)) | |
341 | (set-language-info language-name 'input-method | |
342 | (cons input-method slot)))))) | |
343 | ||
344 | (defun read-language-and-input-method-name () | |
15b3e511 KH |
345 | "Read a language name and the corresponding input method from a minibuffer. |
346 | Return a list of those names." | |
347 | (let* ((default-val (or previous-input-method default-input-method)) | |
348 | (language-name (read-language-name | |
349 | 'input-method "Language: " | |
350 | (if default-val (cons (car default-val) 0))))) | |
4ed46869 KH |
351 | (if (null language-name) |
352 | (error "No input method for the specified language")) | |
15b3e511 KH |
353 | (if (not (string= language-name (car default-val))) |
354 | ;; Now the default value has no meaning. | |
355 | (setq default-val nil)) | |
4ed46869 | 356 | (let* ((completion-ignore-case t) |
ef8a8c8c KH |
357 | (key-slot (cdr (assq 'input-method |
358 | (assoc language-name language-info-alist)))) | |
4ed46869 | 359 | (method-name |
ef8a8c8c | 360 | (completing-read "Input method: " key-slot nil t |
15b3e511 | 361 | (if default-val (cons (cdr default-val) 0))))) |
4ed46869 KH |
362 | (if (= (length method-name) 0) |
363 | (error "No input method specified")) | |
ef8a8c8c | 364 | (list language-name |
15b3e511 KH |
365 | (car (assoc-ignore-case method-name key-slot)))))) |
366 | ||
367 | ;; Actvate input method METHOD-NAME for langauge LANGUAGE-NAME. | |
368 | (defun activate-input-method (language-name method-name) | |
369 | (if (and current-input-method | |
370 | (or (not (string= (car current-input-method) language-name)) | |
371 | (not (string= (cdr current-input-method) method-name)))) | |
372 | (inactivate-input-method)) | |
373 | (or current-input-method | |
374 | (let* ((key-slot (get-language-info language-name 'input-method)) | |
375 | (method-slot (cdr (assoc method-name key-slot)))) | |
376 | (if (null method-slot) | |
377 | (error "Invalid input method `%s' for %s" | |
378 | method-name language-name)) | |
379 | (apply (car method-slot) method-name (cdr method-slot)) | |
380 | (setq current-input-method (cons language-name method-name)) | |
381 | (if (not (equal default-input-method current-input-method)) | |
382 | (progn | |
383 | (setq previous-input-method default-input-method) | |
384 | (setq default-input-method current-input-method) | |
385 | (setq default-input-method-title current-input-method-title)))))) | |
386 | ||
387 | ;; Inactivate the current input method. | |
388 | (defun inactivate-input-method () | |
389 | (if current-input-method | |
390 | (unwind-protect | |
391 | (funcall inactivate-current-input-method-function) | |
392 | (setq current-input-method nil)))) | |
4ed46869 KH |
393 | |
394 | (defun select-input-method (language-name method-name) | |
395 | "Select and activate input method METHOD-NAME for inputting LANGUAGE-NAME. | |
15b3e511 KH |
396 | Both the default and local values of default-input-method are |
397 | set to the selected input method. | |
398 | ||
4ed46869 KH |
399 | The information for activating METHOD-NAME is stored |
400 | in `language-info-alist' under the key 'input-method. | |
401 | The format of the information has the form: | |
402 | ((METHOD-NAME ACTIVATE-FUNC ARG ...) ...) | |
403 | where ACTIVATE-FUNC is a function to call for activating this method. | |
404 | Arguments for the function are METHOD-NAME and ARGs." | |
405 | (interactive (read-language-and-input-method-name)) | |
15b3e511 KH |
406 | (activate-input-method language-name method-name) |
407 | (setq-default default-input-method default-input-method) | |
408 | (setq-default default-input-method-title default-input-method-title)) | |
4ed46869 KH |
409 | |
410 | (defun toggle-input-method (&optional arg) | |
15b3e511 KH |
411 | "Turn on or off a multilingual text input method for the current buffer. |
412 | With arg, turn on an input method specified interactively. | |
413 | Without arg, if some input method is currently activated, turn it off, | |
414 | else turn on default-input-method (which see). | |
415 | In the latter case, if default-input-method is nil, select an input method | |
416 | interactively." | |
4ed46869 KH |
417 | (interactive "P") |
418 | (if arg | |
15b3e511 KH |
419 | (let ((input-method (read-language-and-input-method-name))) |
420 | (activate-input-method (car input-method) (nth 1 input-method))) | |
421 | (if current-input-method | |
422 | (inactivate-input-method) | |
423 | (if default-input-method | |
424 | (activate-input-method (car default-input-method) | |
4ed46869 | 425 | (cdr default-input-method)) |
15b3e511 KH |
426 | (let ((input-method (read-language-and-input-method-name))) |
427 | (activate-input-method (car input-method) (nth 1 input-method))))))) | |
4ed46869 KH |
428 | |
429 | (defun describe-input-method () | |
430 | "Describe the current input method." | |
431 | (interactive) | |
432 | (if current-input-method | |
433 | (if (and (symbolp describe-current-input-method-function) | |
434 | (fboundp describe-current-input-method-function)) | |
435 | (funcall describe-current-input-method-function) | |
436 | (message "No way to describe the current input method `%s'" | |
437 | (cdr current-input-method)) | |
438 | (ding)) | |
439 | (message "No input method is activated now") | |
440 | (ding))) | |
441 | ||
442 | (defun read-multilingual-string (prompt &optional initial-input | |
443 | language-name method-name) | |
444 | "Read a multilingual string from minibuffer, prompting with string PROMPT. | |
445 | The input method selected last time is activated in minibuffer. | |
15b3e511 KH |
446 | If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer |
447 | initially | |
4ed46869 KH |
448 | Optional 3rd and 4th arguments LANGUAGE-NAME and METHOD-NAME specify |
449 | the input method to be activated instead of the one selected last time." | |
15b3e511 | 450 | (let ((default-input-method default-input-method)) |
4ed46869 | 451 | (if (and language-name method-name) |
15b3e511 KH |
452 | (setq default-input-method (cons language-name method-name)) |
453 | (or default-input-method | |
454 | (let ((lang-and-input-method (read-language-and-input-method-name))) | |
455 | (setq default-input-method (cons (car lang-and-input-method) | |
456 | (nth 1 lang-and-input-method)))))) | |
457 | (let ((minibuffer-setup-hook '(toggle-input-method))) | |
458 | (read-string prompt initial-input)))) | |
4ed46869 KH |
459 | |
460 | ;; Variables to control behavior of input methods. All input methods | |
461 | ;; should react to these variables. | |
462 | ||
463 | (defvar input-method-tersely-flag nil | |
464 | "*If this flag is non-nil, input method works rather tersely. | |
465 | ||
466 | For instance, Quail input method does not show guidance buffer while | |
467 | inputting at minibuffer if this flag is t.") | |
468 | ||
469 | (defvar input-method-activate-hook nil | |
470 | "Normal hook run just after an input method is activated.") | |
471 | ||
472 | (defvar input-method-inactivate-hook nil | |
473 | "Normal hook run just after an input method is inactivated.") | |
474 | ||
475 | (defvar input-method-after-insert-chunk-hook nil | |
476 | "Normal hook run just after an input method insert some chunk of text.") | |
477 | ||
478 | \f | |
15b3e511 KH |
479 | (defun setup-specified-language-environment () |
480 | "Setup multi-lingual environment convenient for the specified language." | |
481 | (interactive) | |
482 | (let (language-name func) | |
483 | (if (and (symbolp last-command-event) | |
484 | (or (not (eq last-command-event 'Default)) | |
485 | (setq last-command-event 'English)) | |
486 | (setq language-name (symbol-name last-command-event)) | |
487 | (setq func (get-language-info language-name 'setup-function))) | |
488 | (progn | |
489 | (funcall func) | |
490 | (force-mode-line-update t)) | |
491 | (error "Bogus calling sequence")))) | |
4ed46869 | 492 | |
166246f7 RS |
493 | ;;;###autoload |
494 | (defun set-language-environment (language-name) | |
6c05d680 RS |
495 | "Set up multi-lingual environment for using LANGUAGE-NAME. |
496 | This sets the coding system priority and the default input method | |
497 | and sometimes other things." | |
4ed46869 | 498 | (interactive (list (read-language-name 'setup-function "Language: "))) |
15b3e511 KH |
499 | (if (or (null language-name) |
500 | (null (get-language-info language-name 'setup-function))) | |
501 | (error "No way to setup environment for the specified language")) | |
502 | (let ((last-command-event (intern language-name))) | |
503 | (setup-specified-language-environment))) | |
4ed46869 KH |
504 | |
505 | ;; Print all arguments with `princ', then print "\n". | |
506 | (defsubst princ-list (&rest args) | |
507 | (while args (princ (car args)) (setq args (cdr args))) | |
508 | (princ "\n")) | |
509 | ||
48082651 | 510 | ;; Print a language specific information such as input methods, |
13e82c04 | 511 | ;; charsets, and coding systems. This function is intended to be |
48082651 | 512 | ;; called from the menu: |
281d03ec | 513 | ;; [menu-bar mule describe-language-environment LANGUAGE] |
48082651 KH |
514 | ;; and should not run it by `M-x describe-current-input-method-function'. |
515 | (defun describe-specified-language-support () | |
516 | "Describe how Emacs supports the specified langugage." | |
517 | (interactive) | |
281d03ec | 518 | (let (language-name) |
48082651 | 519 | (if (not (and (symbolp last-command-event) |
281d03ec | 520 | (setq language-name (symbol-name last-command-event)))) |
48082651 | 521 | (error "Bogus calling sequence")) |
281d03ec RS |
522 | (describe-language-environment language-name))) |
523 | ||
524 | (defun describe-language-environment (language-name) | |
525 | "Describe how Emacs supports language environment LANGUAGE-NAME." | |
526 | (interactive (list (read-language-name 'documentation "Language: "))) | |
527 | (if (or (null language-name) | |
528 | (null (get-language-info language-name 'documentation))) | |
529 | (error "No documentation for the specified language")) | |
530 | (let ((doc (get-language-info language-name 'documentation))) | |
48082651 | 531 | (with-output-to-temp-buffer "*Help*" |
13e82c04 | 532 | (if (stringp doc) |
15b3e511 | 533 | (princ-list doc)) |
281d03ec | 534 | (terpri) |
15b3e511 KH |
535 | (let ((str (get-language-info language-name 'sample-text))) |
536 | (if (stringp str) | |
537 | (progn | |
281d03ec | 538 | (princ "Sample text:\n") |
15b3e511 | 539 | (princ-list " " str)))) |
281d03ec RS |
540 | (terpri) |
541 | (princ "Input methods:\n") | |
15b3e511 KH |
542 | (let ((l (get-language-info language-name 'input-method))) |
543 | (while l | |
544 | (princ-list " " (car (car l))) | |
545 | (setq l (cdr l)))) | |
281d03ec RS |
546 | (terpri) |
547 | (princ "Character sets:\n") | |
15b3e511 KH |
548 | (let ((l (get-language-info language-name 'charset))) |
549 | (if (null l) | |
550 | (princ-list " nothing specific to " language-name) | |
551 | (while l | |
552 | (princ-list " " (car l) ": " | |
553 | (charset-description (car l))) | |
554 | (setq l (cdr l))))) | |
281d03ec RS |
555 | (terpri) |
556 | (princ "Coding systems:\n") | |
15b3e511 KH |
557 | (let ((l (get-language-info language-name 'coding-system))) |
558 | (if (null l) | |
559 | (princ-list " nothing specific to " language-name) | |
48082651 | 560 | (while l |
281d03ec RS |
561 | (princ (format " %s (`%c' in mode line):\n\t%s\n" |
562 | (car l) | |
563 | (coding-system-mnemonic (car l)) | |
a904b20b | 564 | (coding-system-doc-string (car l)))) |
15b3e511 | 565 | (setq l (cdr l)))))))) |
4ed46869 KH |
566 | \f |
567 | ;;; Charset property | |
568 | ||
569 | (defsubst get-charset-property (charset propname) | |
570 | "Return the value of CHARSET's PROPNAME property. | |
571 | This is the last value stored with | |
572 | `(put-charset-property CHARSET PROPNAME VALUE)'." | |
573 | (plist-get (charset-plist charset) propname)) | |
574 | ||
575 | (defsubst put-charset-property (charset propname value) | |
576 | "Store CHARSETS's PROPNAME property with value VALUE. | |
577 | It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." | |
578 | (set-charset-plist charset | |
579 | (plist-put (charset-plist charset) propname value))) | |
580 | ||
581 | ;;; Character code property | |
582 | (put 'char-code-property-table 'char-table-extra-slots 0) | |
583 | ||
584 | (defvar char-code-property-table | |
585 | (make-char-table 'char-code-property-table) | |
586 | "Char-table containing a property list of each character code. | |
587 | ||
588 | See also the documentation of `get-char-code-property' and | |
589 | `put-char-code-property'") | |
590 | ||
591 | (defun get-char-code-property (char propname) | |
592 | "Return the value of CHAR's PROPNAME property in `char-code-property-table'." | |
593 | (let ((plist (aref char-code-property-table char))) | |
594 | (if (listp plist) | |
595 | (car (cdr (memq propname plist)))))) | |
596 | ||
597 | (defun put-char-code-property (char propname value) | |
598 | "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. | |
599 | It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." | |
600 | (let ((plist (aref char-code-property-table char))) | |
601 | (if plist | |
602 | (let ((slot (memq propname plist))) | |
603 | (if slot | |
604 | (setcar (cdr slot) value) | |
605 | (nconc plist (list propname value)))) | |
606 | (aset char-code-property-table char (list propname value))))) | |
607 | ||
608 | ;;; mule-cmds.el ends here |