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 | ||
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) |
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 | ||
15b3e511 KH |
52 | (defvar mule-menu-keymap nil |
53 | "Keymap for MULE (Multilingual environment) menu specific commands.") | |
54 | (define-prefix-command 'mule-menu-keymap) | |
55 | ||
56 | (define-key global-map [menu-bar mule] (cons "Mule" mule-menu-keymap)) | |
57 | ||
58 | (setq menu-bar-final-items (cons 'mule menu-bar-final-items)) | |
59 | ||
281d03ec RS |
60 | (defvar describe-language-environment-map nil) |
61 | (define-prefix-command 'describe-language-environment-map) | |
15b3e511 KH |
62 | |
63 | (defvar setup-language-environment-map nil) | |
64 | (define-prefix-command 'setup-language-environment-map) | |
65 | ||
66 | (defvar set-coding-system-map nil) | |
67 | (define-prefix-command 'set-coding-system-map) | |
68 | ||
69 | (define-key-after mule-menu-keymap [toggle-mule] | |
8e02924a | 70 | '("Toggle Multibyte Characters" . toggle-enable-multibyte-characters) |
15b3e511 | 71 | t) |
281d03ec | 72 | (define-key-after mule-menu-keymap [describe-language-environment] |
8e02924a | 73 | '("Describe Language Environment" . describe-language-environment-map) |
15b3e511 KH |
74 | t) |
75 | (define-key-after mule-menu-keymap [set-language-environment] | |
8e02924a | 76 | '("Set Language Environment" . setup-language-environment-map) |
15b3e511 | 77 | t) |
a61f401d | 78 | (define-key-after mule-menu-keymap [mouse-set-font] |
8e02924a | 79 | '("Set Font/Fontset" . mouse-set-font) |
a61f401d | 80 | t) |
15b3e511 KH |
81 | (define-key-after mule-menu-keymap [separator-mule] |
82 | '("--") | |
83 | t) | |
84 | (define-key-after mule-menu-keymap [toggle-input-method] | |
8e02924a | 85 | '("Toggle Input Method" . toggle-input-method) |
15b3e511 KH |
86 | t) |
87 | (define-key-after mule-menu-keymap [select-input-method] | |
8e02924a | 88 | '("Select Input Method" . select-input-method) |
15b3e511 KH |
89 | t) |
90 | (define-key-after mule-menu-keymap [describe-input-method] | |
8e02924a | 91 | '("Describe Input Method" . describe-input-method) |
15b3e511 KH |
92 | t) |
93 | (define-key-after mule-menu-keymap [separator-input-method] | |
94 | '("--") | |
95 | t) | |
d0b9c3ab | 96 | (define-key-after mule-menu-keymap [describe-coding-system] |
8e02924a | 97 | '("Describe Coding Systems" . describe-coding-system) |
15b3e511 KH |
98 | t) |
99 | (define-key-after mule-menu-keymap [set-various-coding-system] | |
8e02924a | 100 | '("Set Coding System" . set-coding-system-map) |
15b3e511 KH |
101 | t) |
102 | (define-key-after mule-menu-keymap [separator-coding-system] | |
103 | '("--") | |
104 | t) | |
105 | (define-key-after mule-menu-keymap [mule-diag] | |
8e02924a | 106 | '("Show All of MULE Status" . mule-diag) |
15b3e511 KH |
107 | t) |
108 | (define-key-after mule-menu-keymap [view-hello-file] | |
8e02924a | 109 | '("Show Script Examples" . view-hello-file) |
15b3e511 KH |
110 | t) |
111 | ||
112 | (define-key-after set-coding-system-map [set-buffer-file-coding-system] | |
8e02924a | 113 | '("Buffer File" . set-buffer-file-coding-system) |
15b3e511 KH |
114 | t) |
115 | (define-key-after set-coding-system-map [set-terminal-coding-system] | |
116 | '("Terminal" . set-terminal-coding-system) | |
117 | t) | |
118 | (define-key-after set-coding-system-map [set-keyboard-coding-system] | |
119 | '("Keyboard" . set-keyboard-coding-system) | |
120 | t) | |
121 | (define-key-after set-coding-system-map [set-buffer-process-coding-system] | |
8e02924a | 122 | '("Buffer Process" . set-buffer-process-coding-system) |
15b3e511 KH |
123 | t) |
124 | ||
125 | (define-key setup-language-environment-map | |
126 | [Default] '("Default" . setup-specified-language-environment)) | |
4ed46869 KH |
127 | |
128 | ;; These are meaningless when running under X. | |
4ed46869 | 129 | (put 'set-terminal-coding-system 'menu-enable |
9ba344f7 | 130 | '(not (eq window-system 'x))) |
15b3e511 | 131 | (put 'set-keyboard-coding-system 'menu-enable |
9ba344f7 | 132 | '(not (eq window-system 'x))) |
d0b9c3ab KH |
133 | ;; This is meaningless when the current buffer has no process. |
134 | (put 'set-buffer-process-coding-system 'menu-enable | |
135 | '(get-buffer-process (current-buffer))) | |
4ed46869 | 136 | |
4ed46869 KH |
137 | ;; This should be a single character key binding because users use it |
138 | ;; very frequently while editing multilingual text. Now we can use | |
139 | ;; only two such keys: "\C-\\" and "\C-^", but the latter is not | |
140 | ;; convenient because it requires shifting on most keyboards. An | |
141 | ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' | |
142 | ;; but it won't be used that frequently. | |
143 | (define-key global-map "\C-\\" 'toggle-input-method) | |
144 | ||
a2ad45b9 RS |
145 | ;;; This is no good because people often type Shift-SPC |
146 | ;;; meaning to type SPC. -- rms. | |
147 | ;;; ;; Here's an alternative key binding for X users (Shift-SPACE). | |
148 | ;;; (define-key global-map [?\S- ] 'toggle-input-method) | |
b4fba33f | 149 | |
4ed46869 KH |
150 | (defun toggle-enable-multibyte-characters (&optional arg) |
151 | "Change whether this buffer enables multibyte characters. | |
152 | With arg, make them enable iff arg is positive." | |
153 | (interactive "P") | |
154 | (setq enable-multibyte-characters | |
155 | (if (null arg) (null enable-multibyte-characters) | |
156 | (> (prefix-numeric-value arg) 0))) | |
157 | (force-mode-line-update)) | |
158 | ||
159 | (defun view-hello-file () | |
160 | "Display the HELLO file which list up many languages and characters." | |
161 | (interactive) | |
8f81f784 KH |
162 | ;; We have to decode the file in any environment. |
163 | (let ((default-enable-multibyte-characters t) | |
95fa03b4 | 164 | (coding-system-for-read 'iso-2022-7bit)) |
8f81f784 | 165 | (find-file-read-only (expand-file-name "HELLO" data-directory)))) |
4ed46869 | 166 | |
15b3e511 KH |
167 | (defun universal-coding-system-argument () |
168 | "Execute an I/O command using the specified coding system." | |
169 | (interactive) | |
170 | (let* ((coding-system (read-coding-system "Coding system: ")) | |
171 | (keyseq (read-key-sequence | |
172 | (format "With coding system %s:" coding-system))) | |
173 | (cmd (key-binding keyseq))) | |
174 | (let ((coding-system-for-read coding-system) | |
175 | (coding-system-for-write coding-system)) | |
176 | (message "") | |
177 | (call-interactively cmd)))) | |
178 | ||
de94d711 | 179 | (defun set-default-coding-systems (coding-system) |
0c3154d2 KH |
180 | "Set default value of various coding systems to CODING-SYSTEM. |
181 | The follwing coding systems are set: | |
182 | o coding system of a newly created buffer | |
183 | o default coding system for terminal output | |
184 | o default coding system for keyboard input | |
185 | o default coding system for subprocess I/O" | |
de94d711 KH |
186 | (check-coding-system coding-system) |
187 | (setq-default buffer-file-coding-system coding-system) | |
188 | (setq default-terminal-coding-system coding-system) | |
189 | (setq default-keyboard-coding-system coding-system) | |
190 | (setq default-process-coding-system (cons coding-system coding-system))) | |
191 | ||
0c3154d2 KH |
192 | (defun prefer-coding-system (coding-system) |
193 | "Add CODING-SYSTEM at the front of the priority list for automatic detection. | |
194 | This also sets the following coding systems to CODING-SYSTEM: | |
195 | o coding system of a newly created buffer | |
196 | o default coding system for terminal output | |
197 | o default coding system for keyboard input | |
198 | o default coding system for subprocess I/O" | |
199 | (interactive "zPrefer coding system: ") | |
200 | (if (not (and coding-system (coding-system-p coding-system))) | |
201 | (error "Invalid coding system `%s'" coding-system)) | |
202 | (let ((coding-category (coding-system-category coding-system)) | |
203 | (parent (coding-system-parent coding-system))) | |
204 | (if (not coding-category) | |
205 | ;; CODING-SYSTEM is no-conversion or undecided. | |
206 | (error "Can't prefer the coding system `%s'" coding-system)) | |
207 | (set coding-category (or parent coding-system)) | |
208 | (if (not (eq coding-category (car coding-category-list))) | |
209 | ;; We must change the order. | |
210 | (setq coding-category-list | |
211 | (cons coding-category | |
212 | (delq coding-category coding-category-list)))) | |
213 | (if (and parent (interactive-p)) | |
214 | (message "Highest priority is set to %s (parent of %s)" | |
215 | parent coding-system)) | |
216 | (set-default-coding-systems (or parent coding-system)))) | |
217 | ||
4ed46869 KH |
218 | \f |
219 | ;;; Language support staffs. | |
220 | ||
4ed46869 KH |
221 | (defvar language-info-alist nil |
222 | "Alist of language names vs the corresponding information of various kind. | |
223 | Each element looks like: | |
224 | (LANGUAGE-NAME . ((KEY . INFO) ...)) | |
225 | where LANGUAGE-NAME is a string, | |
226 | KEY is a symbol denoting the kind of information, | |
227 | INFO is any Lisp object which contains the actual information related | |
228 | to KEY.") | |
229 | ||
230 | (defun get-language-info (language-name key) | |
231 | "Return the information for LANGUAGE-NAME of the kind KEY. | |
232 | LANGUAGE-NAME is a string. | |
233 | KEY is a symbol denoting the kind of required information." | |
15b3e511 | 234 | (let ((lang-slot (assoc-ignore-case language-name language-info-alist))) |
4ed46869 KH |
235 | (if lang-slot |
236 | (cdr (assq key (cdr lang-slot)))))) | |
237 | ||
4ed46869 KH |
238 | (defun set-language-info (language-name key info) |
239 | "Set for LANGUAGE-NAME the information INFO under KEY. | |
240 | LANGUAGE-NAME is a string | |
241 | KEY is a symbol denoting the kind of information. | |
242 | INFO is any Lisp object which contains the actual information. | |
243 | ||
244 | Currently, the following KEYs are used by Emacs: | |
281d03ec | 245 | |
4ed46869 | 246 | charset: list of symbols whose values are charsets specific to the language. |
281d03ec | 247 | |
4ed46869 | 248 | coding-system: list of coding systems specific to the langauge. |
281d03ec | 249 | |
4ed46869 | 250 | tutorial: a tutorial file name written in the language. |
281d03ec | 251 | |
4ed46869 | 252 | sample-text: one line short text containing characters of the language. |
281d03ec | 253 | |
15b3e511 | 254 | documentation: t or a string describing how Emacs supports the language. |
281d03ec RS |
255 | If a string is specified, it is shown before any other information |
256 | of the language by the command `describe-language-environment'. | |
257 | ||
13e82c04 | 258 | setup-function: a function to call for setting up environment |
281d03ec | 259 | convenient for a user of the language. |
15b3e511 KH |
260 | |
261 | If KEY is documentation or setup-function, you can also specify | |
262 | a cons cell as INFO, in which case, the car part should be | |
263 | a normal value as INFO for KEY (as described above), | |
264 | and the cdr part should be a symbol whose value is a menu keymap | |
265 | in which an entry for the language is defined. But, only the car part | |
266 | is actually set as the information. | |
13e82c04 | 267 | |
281d03ec RS |
268 | We will define more KEYs in the future. To avoid conflict, |
269 | if you want to use your own KEY values, make them start with `user-'." | |
4ed46869 KH |
270 | (let (lang-slot key-slot) |
271 | (setq lang-slot (assoc language-name language-info-alist)) | |
272 | (if (null lang-slot) ; If no slot for the language, add it. | |
273 | (setq lang-slot (list language-name) | |
274 | language-info-alist (cons lang-slot language-info-alist))) | |
275 | (setq key-slot (assq key lang-slot)) | |
276 | (if (null key-slot) ; If no slot for the key, add it. | |
277 | (progn | |
278 | (setq key-slot (list key)) | |
279 | (setcdr lang-slot (cons key-slot (cdr lang-slot))))) | |
4ed46869 | 280 | ;; Setup menu. |
48082651 | 281 | (cond ((eq key 'documentation) |
15b3e511 KH |
282 | (define-key-after |
283 | (if (consp info) | |
284 | (prog1 (symbol-value (cdr info)) | |
285 | (setq info (car info))) | |
281d03ec | 286 | describe-language-environment-map) |
ef8a8c8c | 287 | (vector (intern language-name)) |
48082651 | 288 | (cons language-name 'describe-specified-language-support) |
13e82c04 | 289 | t)) |
ef8a8c8c | 290 | ((eq key 'setup-function) |
15b3e511 KH |
291 | (define-key-after |
292 | (if (consp info) | |
293 | (prog1 (symbol-value (cdr info)) | |
294 | (setq info (car info))) | |
295 | setup-language-environment-map) | |
ef8a8c8c | 296 | (vector (intern language-name)) |
15b3e511 | 297 | (cons language-name 'setup-specified-language-environment) |
13e82c04 | 298 | t))) |
15b3e511 KH |
299 | |
300 | (setcdr key-slot info) | |
4ed46869 KH |
301 | )) |
302 | ||
303 | (defun set-language-info-alist (language-name alist) | |
304 | "Set for LANGUAGE-NAME the information in ALIST. | |
305 | ALIST is an alist of KEY and INFO. See the documentation of | |
306 | `set-langauge-info' for the meanings of KEY and INFO." | |
307 | (while alist | |
308 | (set-language-info language-name (car (car alist)) (cdr (car alist))) | |
309 | (setq alist (cdr alist)))) | |
310 | ||
311 | (defun read-language-name (key prompt &optional initial-input) | |
312 | "Read language name which has information for KEY, prompting with PROMPT." | |
313 | (let* ((completion-ignore-case t) | |
314 | (name (completing-read prompt | |
315 | language-info-alist | |
316 | (function (lambda (elm) (assq key elm))) | |
317 | t | |
318 | initial-input))) | |
13e82c04 KH |
319 | (if (and (> (length name) 0) |
320 | (get-language-info name key)) | |
321 | name))) | |
4ed46869 KH |
322 | \f |
323 | ;;; Multilingual input methods. | |
324 | ||
d0b9c3ab KH |
325 | (defconst leim-list-file-name "leim-list.el" |
326 | "Name of LEIM list file. | |
327 | This file contains a list of libraries of Emacs input methods (LEIM) | |
328 | in the format of Lisp expression for registering each input method. | |
329 | Emacs loads this file at startup time.") | |
330 | ||
331 | (defvar leim-list-header (format "\ | |
332 | ;;; %s -- list of LEIM (Library of Emacs Input Method) | |
333 | ;; | |
334 | ;; This file contains a list of LEIM (Library of Emacs Input Method) | |
335 | ;; in the same directory as this file. Loading this file registeres | |
336 | ;; the whole input methods in Emacs. | |
337 | ;; | |
d33d5fbe | 338 | ;; Each entry has the form: |
d0b9c3ab KH |
339 | ;; (register-input-method |
340 | ;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC | |
341 | ;; TITLE DESCRIPTION | |
342 | ;; ARG ...) | |
343 | ;; See the function `register-input-method' for the meanings of arguments. | |
344 | ;; | |
345 | ;; If this directory is included in load-path, Emacs automatically | |
346 | ;; loads this file at startup time. | |
347 | ||
348 | " | |
349 | leim-list-file-name) | |
350 | "Header to be inserted in LEIM list file.") | |
351 | ||
e55e92ee | 352 | (defvar leim-list-entry-regexp "^(register-input-method" |
d0b9c3ab KH |
353 | "Regexp matching head of each entry in LEIM list file. |
354 | See also the variable `leim-list-header'") | |
355 | ||
356 | (defvar update-leim-list-functions | |
357 | '(quail-update-leim-list-file) | |
358 | "List of functions to call to update LEIM list file. | |
359 | Each function is called with one arg, LEIM directory name.") | |
360 | ||
361 | (defun update-leim-list-file (dir) | |
362 | "Update LEIM list file in directory DIR." | |
363 | (let ((functions update-leim-list-functions)) | |
364 | (while functions | |
365 | (funcall (car functions) (expand-file-name dir)) | |
366 | (setq functions (cdr functions))))) | |
367 | ||
368 | (defun update-all-leim-list-files () | |
369 | "Update all the LEIM list files." | |
370 | (interactive) | |
371 | (let ((l load-path)) | |
372 | (while l | |
373 | (if (string-match "leim" (car l)) | |
374 | (update-leim-list-file (car l))) | |
375 | (setq l (cdr l))))) | |
376 | ||
4ed46869 KH |
377 | (defvar current-input-method nil |
378 | "The current input method for multilingual text. | |
96db204a | 379 | If nil, that means no input method is activated now.") |
4ed46869 KH |
380 | (make-variable-buffer-local 'current-input-method) |
381 | (put 'current-input-method 'permanent-local t) | |
382 | ||
383 | (defvar current-input-method-title nil | |
d0b9c3ab | 384 | "Title string of the current input method shown in mode line.") |
4ed46869 KH |
385 | (make-variable-buffer-local 'current-input-method-title) |
386 | (put 'current-input-method-title 'permanent-local t) | |
387 | ||
b4fba33f KH |
388 | (defcustom default-input-method nil |
389 | "*Default input method for multilingual text. | |
390 | This is the input method activated automatically by the command | |
9b10b5a3 | 391 | `toggle-input-method' (\\[toggle-input-method])." |
b4fba33f KH |
392 | :group 'mule) |
393 | ||
723a427a KH |
394 | (defvar input-method-history nil |
395 | "History list for some commands that read input methods.") | |
396 | (make-variable-buffer-local 'input-method-history) | |
397 | (put 'input-method-history 'permanent-local t) | |
4ed46869 KH |
398 | |
399 | (defvar inactivate-current-input-method-function nil | |
400 | "Function to call for inactivating the current input method. | |
401 | Every input method should set this to an appropriate value when activated. | |
f17ccaee KH |
402 | This function is called with no argument. |
403 | ||
404 | This function should never change the value of `current-input-method'. | |
405 | It is set to nil by the function `inactivate-input-method'.") | |
4ed46869 KH |
406 | (make-variable-buffer-local 'inactivate-current-input-method-function) |
407 | (put 'inactivate-current-input-method-function 'permanent-local t) | |
408 | ||
409 | (defvar describe-current-input-method-function nil | |
410 | "Function to call for describing the current input method. | |
411 | This function is called with no argument.") | |
412 | (make-variable-buffer-local 'describe-current-input-method-function) | |
413 | (put 'describe-current-input-method-function 'permanent-local t) | |
414 | ||
d0b9c3ab KH |
415 | (defvar input-method-alist nil |
416 | "Alist of input method names vs the corresponding information to use it. | |
417 | Each element has the form: | |
418 | (INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC TITLE DESCRIPTION ...) | |
419 | See the function `register-input-method' for the meanings of each elements.") | |
420 | ||
421 | (defun register-input-method (input-method language-name &rest args) | |
422 | "Register INPUT-METHOD as an input method for LANGUAGE-NAME. | |
423 | INPUT-METHOD and LANGUAGE-NAME are strings. | |
424 | The remaining arguments are: | |
425 | ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARG ... | |
426 | where, | |
427 | ACTIVATE-FUNC is a function to call for activating this method. | |
428 | TITLE is a string shown in mode-line while this method is active, | |
429 | DESCRIPTION is a string describing about this method, | |
430 | Arguments to ACTIVATE-FUNC are INPUT-METHOD and ARGs." | |
431 | (let ((info (cons language-name args)) | |
432 | (slot (assoc input-method input-method-alist))) | |
433 | (if slot | |
434 | (setcdr slot info) | |
435 | (setq slot (cons input-method info)) | |
436 | (setq input-method-alist (cons slot input-method-alist))))) | |
437 | ||
4d5ac029 | 438 | (defun read-input-method-name (prompt &optional default inhibit-null) |
d0b9c3ab | 439 | "Read a name of input method from a minibuffer prompting with PROMPT. |
4d5ac029 RS |
440 | If DEFAULT is non-nil, use that as the default, |
441 | and substitute it into PROMPT at the first `%s'. | |
d0b9c3ab | 442 | If INHIBIT-NULL is non-nil, null input signals an error." |
4d5ac029 RS |
443 | (if default |
444 | (setq prompt (format prompt default))) | |
d0b9c3ab | 445 | (let* ((completion-ignore-case t) |
723a427a KH |
446 | ;; This binding is necessary because input-method-history is |
447 | ;; buffer local. | |
448 | (minibuffer-history input-method-history) | |
d0b9c3ab | 449 | (input-method (completing-read prompt input-method-alist |
4d5ac029 | 450 | nil t nil nil default))) |
d0b9c3ab KH |
451 | (if (> (length input-method) 0) |
452 | input-method | |
453 | (if inhibit-null | |
43807b77 | 454 | (error "No valid input method is specified"))))) |
d0b9c3ab | 455 | |
d0b9c3ab | 456 | (defun activate-input-method (input-method) |
f17ccaee KH |
457 | "Turn INPUT-METHOD on. |
458 | If some input method is already on, turn it off at first." | |
723a427a KH |
459 | (if (and current-input-method |
460 | (not (string= current-input-method input-method))) | |
42395763 RS |
461 | (inactivate-input-method)) |
462 | (unless current-input-method | |
d0b9c3ab KH |
463 | (let ((slot (assoc input-method input-method-alist))) |
464 | (if (null slot) | |
723a427a | 465 | (error "Can't activate input method `%s'" input-method)) |
d0b9c3ab KH |
466 | (apply (nth 2 slot) input-method (nthcdr 5 slot)) |
467 | (setq current-input-method input-method) | |
723a427a KH |
468 | (setq current-input-method-title (nth 3 slot)) |
469 | (run-hooks 'input-method-activate-hook)))) | |
15b3e511 | 470 | |
15b3e511 | 471 | (defun inactivate-input-method () |
f17ccaee | 472 | "Turn off the current input method." |
723a427a KH |
473 | (when current-input-method |
474 | (if input-method-history | |
475 | (unless (string= current-input-method (car input-method-history)) | |
476 | (setq input-method-history | |
477 | (cons current-input-method | |
478 | (delete current-input-method input-method-history)))) | |
479 | (setq input-method-history (list current-input-method))) | |
480 | (unwind-protect | |
481 | (funcall inactivate-current-input-method-function) | |
15b3e511 | 482 | (unwind-protect |
723a427a KH |
483 | (run-hooks 'input-method-inactivate-hook) |
484 | (setq current-input-method nil | |
485 | current-input-method-title nil))))) | |
4ed46869 | 486 | |
d0b9c3ab | 487 | (defun select-input-method (input-method) |
723a427a KH |
488 | "Select and turn on INPUT-METHOD. |
489 | This sets the default input method to what you specify, | |
490 | and turn it on for the current buffer." | |
d0b9c3ab | 491 | (interactive |
723a427a | 492 | (let* ((default (or (car input-method-history) default-input-method))) |
b4fba33f | 493 | (if (not enable-multibyte-characters) |
4d5ac029 | 494 | (error "Can't activate an input method while multibyte characters are disabled")) |
42395763 | 495 | (list (read-input-method-name |
723a427a | 496 | (if default "Input method (default %s): " "Input method: ") |
42395763 | 497 | default t)))) |
d0b9c3ab | 498 | (activate-input-method input-method) |
42395763 | 499 | (setq default-input-method input-method)) |
4ed46869 KH |
500 | |
501 | (defun toggle-input-method (&optional arg) | |
15b3e511 | 502 | "Turn on or off a multilingual text input method for the current buffer. |
723a427a | 503 | |
d0b9c3ab | 504 | With arg, read an input method from minibuffer and turn it on. |
723a427a | 505 | |
15b3e511 | 506 | Without arg, if some input method is currently activated, turn it off, |
723a427a KH |
507 | else turn on an input method selected last time |
508 | or the default input method (see `default-input-method'). | |
509 | ||
510 | When there's no input method to turn on, turn on what read from minibuffer." | |
4ed46869 | 511 | (interactive "P") |
723a427a | 512 | (let* ((default (or (car input-method-history) default-input-method))) |
b4fba33f KH |
513 | (if (and current-input-method (not arg)) |
514 | (inactivate-input-method) | |
515 | (if (not enable-multibyte-characters) | |
96db204a | 516 | (error "Can't activate any input method while multibyte characters are disabled")) |
723a427a KH |
517 | (activate-input-method |
518 | (if (or arg (not default)) | |
519 | (read-input-method-name | |
520 | (if default "Input method (default %s): " "Input method: " ) | |
521 | default t) | |
522 | default)) | |
523 | (or default-input-method | |
524 | (setq default-input-method current-input-method))))) | |
d0b9c3ab KH |
525 | |
526 | (defun describe-input-method (input-method) | |
4ed46869 | 527 | "Describe the current input method." |
d0b9c3ab KH |
528 | (interactive |
529 | (list (read-input-method-name | |
530 | "Describe input method (default, current choice): "))) | |
531 | (if (null input-method) | |
532 | (describe-current-input-method) | |
533 | (with-output-to-temp-buffer "*Help*" | |
534 | (let ((elt (assoc input-method input-method-alist))) | |
535 | (princ (format "Input method: %s (`%s' in mode line) for %s\n %s\n" | |
536 | input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))) | |
537 | ||
538 | (defun describe-current-input-method () | |
96db204a | 539 | "Describe the input method currently in use." |
4ed46869 KH |
540 | (if current-input-method |
541 | (if (and (symbolp describe-current-input-method-function) | |
542 | (fboundp describe-current-input-method-function)) | |
543 | (funcall describe-current-input-method-function) | |
544 | (message "No way to describe the current input method `%s'" | |
545 | (cdr current-input-method)) | |
546 | (ding)) | |
d0b9c3ab | 547 | (error "No input method is activated now"))) |
4ed46869 KH |
548 | |
549 | (defun read-multilingual-string (prompt &optional initial-input | |
d0b9c3ab | 550 | input-method) |
4ed46869 KH |
551 | "Read a multilingual string from minibuffer, prompting with string PROMPT. |
552 | The input method selected last time is activated in minibuffer. | |
15b3e511 | 553 | If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer |
d0b9c3ab KH |
554 | initially. |
555 | Optional 3rd argument INPUT-METHOD specifies the input method | |
556 | to be activated instead of the one selected last time." | |
88d559ec KH |
557 | (setq input-method |
558 | (or input-method | |
559 | default-input-method | |
560 | (read-input-method-name "Input method: " nil t))) | |
f17ccaee KH |
561 | (let ((current-input-method |
562 | (or input-method | |
563 | default-input-method | |
564 | (read-input-method-name "Input method: " nil t)))) | |
565 | (read-string prompt initial-input nil nil t))) | |
4ed46869 KH |
566 | |
567 | ;; Variables to control behavior of input methods. All input methods | |
568 | ;; should react to these variables. | |
569 | ||
42395763 RS |
570 | (defcustom input-method-verbose-flag t |
571 | "*If this flag is non-nil, input methods give extra guidance. | |
4ed46869 KH |
572 | |
573 | For instance, Quail input method does not show guidance buffer while | |
42395763 RS |
574 | inputting at minibuffer if this flag is t." |
575 | :type 'boolean | |
576 | :group 'mule) | |
577 | ||
578 | (defcustom input-method-highlight-flag t | |
579 | "*If this flag is non-nil, input methods highlight partially-entered text. | |
580 | For instance, while you are in the middle of a Quail input method sequence, | |
581 | the text inserted so far is temporarily underlined. | |
582 | The underlining goes away when you finish or abort the input method sequence." | |
583 | :type 'boolean | |
584 | :group 'mule) | |
4ed46869 KH |
585 | |
586 | (defvar input-method-activate-hook nil | |
f17ccaee KH |
587 | "Normal hook run just after an input method is activated. |
588 | ||
589 | The variable `current-input-method' keeps the input method name | |
590 | just activated.") | |
4ed46869 KH |
591 | |
592 | (defvar input-method-inactivate-hook nil | |
f17ccaee KH |
593 | "Normal hook run just after an input method is inactivated. |
594 | ||
595 | The variable `current-input-method' still keeps the input method name | |
596 | just inacitvated.") | |
4ed46869 KH |
597 | |
598 | (defvar input-method-after-insert-chunk-hook nil | |
599 | "Normal hook run just after an input method insert some chunk of text.") | |
600 | ||
723a427a KH |
601 | (defvar input-method-exit-on-invalid-key nil |
602 | "This flag controls the behaviour of an input method on invalid key input. | |
603 | Usually, when a user types a key which doesn't start any character | |
604 | handled by the input method, the key is handled by turning off the | |
605 | input method temporalily. After the key is handled, the input method is | |
606 | back on. | |
607 | But, if this flag is non-nil, the input method is never back on.") | |
608 | ||
4ed46869 | 609 | \f |
15b3e511 | 610 | (defun setup-specified-language-environment () |
f850d782 | 611 | "Set up multi-lingual environment convenient for the specified language." |
15b3e511 | 612 | (interactive) |
f850d782 | 613 | (let (language-name) |
15b3e511 KH |
614 | (if (and (symbolp last-command-event) |
615 | (or (not (eq last-command-event 'Default)) | |
616 | (setq last-command-event 'English)) | |
f850d782 RS |
617 | (setq language-name (symbol-name last-command-event))) |
618 | (set-language-environment language-name) | |
15b3e511 | 619 | (error "Bogus calling sequence")))) |
4ed46869 | 620 | |
f850d782 RS |
621 | (defvar current-language-environment "English" |
622 | "The last language environment specified with `set-language-environment'.") | |
623 | ||
166246f7 | 624 | (defun set-language-environment (language-name) |
6c05d680 RS |
625 | "Set up multi-lingual environment for using LANGUAGE-NAME. |
626 | This sets the coding system priority and the default input method | |
627 | and sometimes other things." | |
b4fba33f KH |
628 | (interactive (list (read-language-name 'setup-function |
629 | "Language (null for default): "))) | |
630 | (or language-name | |
631 | (setq language-name "English")) | |
632 | (if (null (get-language-info language-name 'setup-function)) | |
f850d782 RS |
633 | (error "Language environment not defined: %S" language-name)) |
634 | (funcall (get-language-info language-name 'setup-function)) | |
635 | (setq current-language-environment language-name) | |
636 | (force-mode-line-update t)) | |
4ed46869 KH |
637 | |
638 | ;; Print all arguments with `princ', then print "\n". | |
639 | (defsubst princ-list (&rest args) | |
640 | (while args (princ (car args)) (setq args (cdr args))) | |
641 | (princ "\n")) | |
642 | ||
48082651 | 643 | ;; Print a language specific information such as input methods, |
13e82c04 | 644 | ;; charsets, and coding systems. This function is intended to be |
48082651 | 645 | ;; called from the menu: |
281d03ec | 646 | ;; [menu-bar mule describe-language-environment LANGUAGE] |
48082651 KH |
647 | ;; and should not run it by `M-x describe-current-input-method-function'. |
648 | (defun describe-specified-language-support () | |
96db204a | 649 | "Describe how Emacs supports the specified language environment." |
48082651 | 650 | (interactive) |
281d03ec | 651 | (let (language-name) |
48082651 | 652 | (if (not (and (symbolp last-command-event) |
281d03ec | 653 | (setq language-name (symbol-name last-command-event)))) |
48082651 | 654 | (error "Bogus calling sequence")) |
281d03ec RS |
655 | (describe-language-environment language-name))) |
656 | ||
657 | (defun describe-language-environment (language-name) | |
658 | "Describe how Emacs supports language environment LANGUAGE-NAME." | |
659 | (interactive (list (read-language-name 'documentation "Language: "))) | |
f850d782 RS |
660 | (if (null language-name) |
661 | (setq language-name current-language-environment)) | |
281d03ec RS |
662 | (if (or (null language-name) |
663 | (null (get-language-info language-name 'documentation))) | |
664 | (error "No documentation for the specified language")) | |
665 | (let ((doc (get-language-info language-name 'documentation))) | |
48082651 | 666 | (with-output-to-temp-buffer "*Help*" |
13e82c04 | 667 | (if (stringp doc) |
d0b9c3ab KH |
668 | (progn |
669 | (princ-list doc) | |
670 | (terpri))) | |
15b3e511 KH |
671 | (let ((str (get-language-info language-name 'sample-text))) |
672 | (if (stringp str) | |
673 | (progn | |
281d03ec | 674 | (princ "Sample text:\n") |
d0b9c3ab KH |
675 | (princ-list " " str) |
676 | (terpri)))) | |
281d03ec | 677 | (princ "Input methods:\n") |
d0b9c3ab | 678 | (let ((l input-method-alist)) |
15b3e511 | 679 | (while l |
d0b9c3ab KH |
680 | (if (string= language-name (nth 1 (car l))) |
681 | (princ-list " " (car (car l)) | |
682 | (format " (`%s' in mode line)" (nth 3 (car l))))) | |
15b3e511 | 683 | (setq l (cdr l)))) |
281d03ec RS |
684 | (terpri) |
685 | (princ "Character sets:\n") | |
15b3e511 KH |
686 | (let ((l (get-language-info language-name 'charset))) |
687 | (if (null l) | |
688 | (princ-list " nothing specific to " language-name) | |
689 | (while l | |
690 | (princ-list " " (car l) ": " | |
691 | (charset-description (car l))) | |
692 | (setq l (cdr l))))) | |
281d03ec RS |
693 | (terpri) |
694 | (princ "Coding systems:\n") | |
15b3e511 KH |
695 | (let ((l (get-language-info language-name 'coding-system))) |
696 | (if (null l) | |
697 | (princ-list " nothing specific to " language-name) | |
48082651 | 698 | (while l |
281d03ec RS |
699 | (princ (format " %s (`%c' in mode line):\n\t%s\n" |
700 | (car l) | |
701 | (coding-system-mnemonic (car l)) | |
a904b20b | 702 | (coding-system-doc-string (car l)))) |
15b3e511 | 703 | (setq l (cdr l)))))))) |
4ed46869 KH |
704 | \f |
705 | ;;; Charset property | |
706 | ||
707 | (defsubst get-charset-property (charset propname) | |
708 | "Return the value of CHARSET's PROPNAME property. | |
709 | This is the last value stored with | |
96db204a | 710 | (put-charset-property CHARSET PROPNAME VALUE)." |
4ed46869 KH |
711 | (plist-get (charset-plist charset) propname)) |
712 | ||
713 | (defsubst put-charset-property (charset propname value) | |
714 | "Store CHARSETS's PROPNAME property with value VALUE. | |
715 | It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." | |
716 | (set-charset-plist charset | |
717 | (plist-put (charset-plist charset) propname value))) | |
718 | ||
719 | ;;; Character code property | |
720 | (put 'char-code-property-table 'char-table-extra-slots 0) | |
721 | ||
722 | (defvar char-code-property-table | |
723 | (make-char-table 'char-code-property-table) | |
724 | "Char-table containing a property list of each character code. | |
725 | ||
726 | See also the documentation of `get-char-code-property' and | |
96db204a | 727 | `put-char-code-property'.") |
4ed46869 KH |
728 | |
729 | (defun get-char-code-property (char propname) | |
730 | "Return the value of CHAR's PROPNAME property in `char-code-property-table'." | |
731 | (let ((plist (aref char-code-property-table char))) | |
732 | (if (listp plist) | |
733 | (car (cdr (memq propname plist)))))) | |
734 | ||
735 | (defun put-char-code-property (char propname value) | |
736 | "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. | |
737 | It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." | |
738 | (let ((plist (aref char-code-property-table char))) | |
739 | (if plist | |
740 | (let ((slot (memq propname plist))) | |
741 | (if slot | |
742 | (setcar (cdr slot) value) | |
743 | (nconc plist (list propname value)))) | |
744 | (aset char-code-property-table char (list propname value))))) | |
745 | ||
746 | ;;; mule-cmds.el ends here |