Mercurial > emacs
comparison lisp/international/mule-cmds.el @ 17052:d0d7b244b1d0
Initial revision
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Thu, 20 Feb 1997 07:02:49 +0000 |
parents | |
children | 70194012fb3a |
comparison
equal
deleted
inserted
replaced
17051:fd0b17a79b07 | 17052:d0d7b244b1d0 |
---|---|
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 | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
24 ;;; Code: | |
25 | |
26 ;;; MULE related key bindings and menus. | |
27 | |
28 (defvar mule-keymap (make-sparse-keymap "MULE") | |
29 "Keymap for MULE (Multilingual environment) specific commands.") | |
30 (fset 'mule-prefix mule-keymap) | |
31 | |
32 ;; Keep "C-x C-k ..." for mule specific commands. | |
33 (define-key ctl-x-map "\C-k" 'mule-prefix) | |
34 | |
35 (define-key global-map [menu-bar mule] (cons "Mule" mule-keymap)) | |
36 | |
37 (setq menu-bar-final-items (cons 'mule menu-bar-final-items)) | |
38 | |
39 (defvar mule-describe-language-support-map | |
40 (make-sparse-keymap "Describe Language Support")) | |
41 (fset 'mule-describe-language-support-prefix | |
42 mule-describe-language-support-map) | |
43 | |
44 (define-key mule-keymap "m" 'toggle-enable-multibyte-characters) | |
45 (define-key mule-keymap "f" 'set-buffer-file-coding-system) | |
46 (define-key mule-keymap "t" 'set-terminal-coding-system) | |
47 (define-key mule-keymap "k" 'set-keyboard-coding-system) | |
48 (define-key mule-keymap "p" 'set-current-process-coding-system) | |
49 (define-key mule-keymap "i" 'select-input-method) | |
50 | |
51 (define-key help-map "\C-L" 'describe-language-support) | |
52 (define-key help-map "\C-\\" 'describe-input-method) | |
53 (define-key help-map "C" 'describe-current-coding-system) | |
54 (define-key help-map "h" 'view-hello-file) | |
55 | |
56 (define-key mule-keymap [set-process-coding-system] | |
57 '(" ... of process" . set-current-process-coding-system)) | |
58 (define-key mule-keymap [set-keyboard-coding-system] | |
59 '(" ... of keyboard" . set-keyboard-coding-system)) | |
60 (define-key mule-keymap [set-terminal-coding-system] | |
61 '(" ... of terminal" . set-terminal-coding-system)) | |
62 (define-key mule-keymap [set-buffer-file-coding-system] | |
63 '(" ... of visiting file" . set-buffer-file-coding-system)) | |
64 (define-key mule-keymap [separator-mule] | |
65 '("Setting coding systems")) | |
66 (define-key mule-keymap [describe-current-coding-system] | |
67 '("Describe current coding systems" . describe-current-coding-system)) | |
68 (define-key mule-keymap [describe-language-support] | |
69 '("Describe language support" . mule-describe-language-support-prefix)) | |
70 (define-key mule-keymap [view-hello-file] | |
71 '("Show many languages" . view-hello-file)) | |
72 (define-key mule-keymap [describe-input-method] | |
73 '("Describe input method" . describe-input-method)) | |
74 (define-key mule-keymap [select-input-method] | |
75 '("Select input method" . select-input-method)) | |
76 (define-key mule-keymap [toggle-input-method] | |
77 '("Toggle input method" . toggle-input-method)) | |
78 (define-key mule-keymap [toggle-mule] | |
79 '("Toggle MULE" . toggle-enable-multibyte-characters)) | |
80 | |
81 ;; These are meaningless when running under X. | |
82 (put 'set-keyboard-coding-system 'menu-enable | |
83 '(null window-system)) | |
84 (put 'set-terminal-coding-system 'menu-enable | |
85 '(null window-system)) | |
86 | |
87 | |
88 ;; This should be a single character key binding because users use it | |
89 ;; very frequently while editing multilingual text. Now we can use | |
90 ;; only two such keys: "\C-\\" and "\C-^", but the latter is not | |
91 ;; convenient because it requires shifting on most keyboards. An | |
92 ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' | |
93 ;; but it won't be used that frequently. | |
94 (define-key global-map "\C-\\" 'toggle-input-method) | |
95 | |
96 (defun toggle-enable-multibyte-characters (&optional arg) | |
97 "Change whether this buffer enables multibyte characters. | |
98 With arg, make them enable iff arg is positive." | |
99 (interactive "P") | |
100 (setq enable-multibyte-characters | |
101 (if (null arg) (null enable-multibyte-characters) | |
102 (> (prefix-numeric-value arg) 0))) | |
103 (force-mode-line-update)) | |
104 | |
105 (defun view-hello-file () | |
106 "Display the HELLO file which list up many languages and characters." | |
107 (interactive) | |
108 (find-file-read-only (expand-file-name "HELLO" data-directory))) | |
109 | |
110 | |
111 ;;; Language support staffs. | |
112 | |
113 (defvar primary-language "English" | |
114 "Name of a user's primary language. | |
115 Emacs provide various language supports based on this variable.") | |
116 | |
117 (defvar language-info-alist nil | |
118 "Alist of language names vs the corresponding information of various kind. | |
119 Each element looks like: | |
120 (LANGUAGE-NAME . ((KEY . INFO) ...)) | |
121 where LANGUAGE-NAME is a string, | |
122 KEY is a symbol denoting the kind of information, | |
123 INFO is any Lisp object which contains the actual information related | |
124 to KEY.") | |
125 | |
126 (defun get-language-info (language-name key) | |
127 "Return the information for LANGUAGE-NAME of the kind KEY. | |
128 LANGUAGE-NAME is a string. | |
129 KEY is a symbol denoting the kind of required information." | |
130 (let ((lang-slot (assoc language-name language-info-alist))) | |
131 (if lang-slot | |
132 (cdr (assq key (cdr lang-slot)))))) | |
133 | |
134 ;; Return a lambda form which calls `describe-language-support' with | |
135 ;; argument LANG. | |
136 (defun build-describe-language-support-function (lang) | |
137 `(lambda () | |
138 (interactive) | |
139 (describe-language-support ,lang))) | |
140 | |
141 (defun set-language-info (language-name key info) | |
142 "Set for LANGUAGE-NAME the information INFO under KEY. | |
143 LANGUAGE-NAME is a string | |
144 KEY is a symbol denoting the kind of information. | |
145 INFO is any Lisp object which contains the actual information. | |
146 | |
147 Currently, the following KEYs are used by Emacs: | |
148 charset: list of symbols whose values are charsets specific to the language. | |
149 coding-system: list of coding systems specific to the langauge. | |
150 setup-function: see the documentation of `set-language-envrionment'. | |
151 tutorial: a tutorial file name written in the language. | |
152 sample-text: one line short text containing characters of the language. | |
153 documentation: a docstring describing how the language is supported, | |
154 or a fuction to call to describe it, | |
155 or t which means call `describe-language-support' to describe it. | |
156 input-method: alist of input method names for the language vs information | |
157 for activating them. Use `register-input-method' (which see) | |
158 to add a new input method to the alist. | |
159 | |
160 Emacs will use more KEYs in the future. To avoid the conflition, users | |
161 should use prefix \"user-\" in the name of KEY." | |
162 (let (lang-slot key-slot) | |
163 (setq lang-slot (assoc language-name language-info-alist)) | |
164 (if (null lang-slot) ; If no slot for the language, add it. | |
165 (setq lang-slot (list language-name) | |
166 language-info-alist (cons lang-slot language-info-alist))) | |
167 (setq key-slot (assq key lang-slot)) | |
168 (if (null key-slot) ; If no slot for the key, add it. | |
169 (progn | |
170 (setq key-slot (list key)) | |
171 (setcdr lang-slot (cons key-slot (cdr lang-slot))))) | |
172 (setcdr key-slot info) | |
173 ;; Setup menu. | |
174 (if (eq key 'documentation) | |
175 (define-key mule-describe-language-support-map | |
176 (vector (intern language-name)) | |
177 (cons language-name | |
178 (build-describe-language-support-function language-name)))) | |
179 )) | |
180 | |
181 (defun set-language-info-alist (language-name alist) | |
182 "Set for LANGUAGE-NAME the information in ALIST. | |
183 ALIST is an alist of KEY and INFO. See the documentation of | |
184 `set-langauge-info' for the meanings of KEY and INFO." | |
185 (while alist | |
186 (set-language-info language-name (car (car alist)) (cdr (car alist))) | |
187 (setq alist (cdr alist)))) | |
188 | |
189 (defun read-language-name (key prompt &optional initial-input) | |
190 "Read language name which has information for KEY, prompting with PROMPT." | |
191 (let* ((completion-ignore-case t) | |
192 (name (completing-read prompt | |
193 language-info-alist | |
194 (function (lambda (elm) (assq key elm))) | |
195 t | |
196 initial-input))) | |
197 ;; In spite of the documentation, completing-read returns null | |
198 ;; string instead of nil if input is null. | |
199 (and (> (length name) 0) name))) | |
200 | |
201 ;;; Multilingual input methods. | |
202 | |
203 (defvar current-input-method nil | |
204 "The current input method for multilingual text. | |
205 The value is a cons of language name and input method name. | |
206 If nil, it means no input method is activated now.") | |
207 (make-variable-buffer-local 'current-input-method) | |
208 (put 'current-input-method 'permanent-local t) | |
209 | |
210 (defvar current-input-method-title nil | |
211 "Title string of the current input method shown in mode line. | |
212 Every input method should set this an appropriate value when activated.") | |
213 (make-variable-buffer-local 'current-input-method-title) | |
214 (put 'current-input-method-title 'permanent-local t) | |
215 | |
216 (defvar default-input-method nil | |
217 "Default input method. | |
218 The default input method is the one activated automatically by the command | |
219 `toggle-input-method' (\\[toggle-input-method]). | |
220 The value is a cons of language name and input method name.") | |
221 | |
222 (defvar default-input-method-title nil | |
223 "Title string of the default input method.") | |
224 | |
225 (defvar previous-input-method nil | |
226 "Input method selected previously. | |
227 This is the one selected before the current input method is selected. | |
228 See also the documentation of `default-input-method'.") | |
229 | |
230 (defvar inactivate-current-input-method-function nil | |
231 "Function to call for inactivating the current input method. | |
232 Every input method should set this to an appropriate value when activated. | |
233 This function is called with no argument.") | |
234 (make-variable-buffer-local 'inactivate-current-input-method-function) | |
235 (put 'inactivate-current-input-method-function 'permanent-local t) | |
236 | |
237 (defvar describe-current-input-method-function nil | |
238 "Function to call for describing the current input method. | |
239 This function is called with no argument.") | |
240 (make-variable-buffer-local 'describe-current-input-method-function) | |
241 (put 'describe-current-input-method-function 'permanent-local t) | |
242 | |
243 (defun register-input-method (language-name input-method) | |
244 "Register INPUT-METHOD as an input method of LANGUAGE-NAME. | |
245 LANGUAGE-NAME is a string. | |
246 INPUT-METHOD is a list of the form: | |
247 (METHOD-NAME ACTIVATE-FUNC ARG ...) | |
248 where METHOD-NAME is the name of this method, | |
249 ACTIVATE-FUNC is the function to call for activating this method. | |
250 Arguments for the function are METHOD-NAME and ARGs." | |
251 (let ((slot (get-language-info language-name 'input-method)) | |
252 method-slot) | |
253 (if (null slot) | |
254 (set-language-info language-name 'input-method (list input-method)) | |
255 (setq method-slot (assoc (car input-method) slot)) | |
256 (if method-slot | |
257 (setcdr method-slot (cdr input-method)) | |
258 (set-language-info language-name 'input-method | |
259 (cons input-method slot)))))) | |
260 | |
261 (defun read-language-and-input-method-name () | |
262 "Read a language names and the corresponding input method from a minibuffer. | |
263 Return a cons of those names." | |
264 (let ((language-name (read-language-name | |
265 'input-method | |
266 "Language: " | |
267 (if previous-input-method | |
268 (cons (car previous-input-method) 0))))) | |
269 (if (null language-name) | |
270 (error "No input method for the specified language")) | |
271 (let* ((completion-ignore-case t) | |
272 (key-slot | |
273 (assq 'input-method | |
274 (cdr (assoc language-name language-info-alist)))) | |
275 (method-name | |
276 (completing-read "Input method: " (cdr key-slot) nil t | |
277 (if (and previous-input-method | |
278 (string= language-name | |
279 (car previous-input-method))) | |
280 (cons (cdr previous-input-method) 0))))) | |
281 ;; In spite of the documentation, completing-read returns | |
282 ;; null string instead of nil if input is null. | |
283 (if (= (length method-name) 0) | |
284 (error "No input method specified")) | |
285 (list language-name method-name)))) | |
286 | |
287 (defun set-default-input-method (language-name method-name) | |
288 "Set the default input method to METHOD-NAME for inputting LANGUAGE-NAME. | |
289 The default input method is the one activated automatically by the command | |
290 `toggle-input-method' (\\[toggle-input-method]). | |
291 This doesn't affect the currently activated input method." | |
292 (interactive (read-language-and-input-method-name)) | |
293 (let* ((key-slot (get-language-info language-name 'input-method)) | |
294 (method-slot (assoc method-name key-slot))) | |
295 (if (null method-slot) | |
296 (error "No input method `%s' for %s" method-name language-name)) | |
297 (setq default-input-method (cons language-name method-name)))) | |
298 | |
299 (defun select-input-method (language-name method-name) | |
300 "Select and activate input method METHOD-NAME for inputting LANGUAGE-NAME. | |
301 The information for activating METHOD-NAME is stored | |
302 in `language-info-alist' under the key 'input-method. | |
303 The format of the information has the form: | |
304 ((METHOD-NAME ACTIVATE-FUNC ARG ...) ...) | |
305 where ACTIVATE-FUNC is a function to call for activating this method. | |
306 Arguments for the function are METHOD-NAME and ARGs." | |
307 (interactive (read-language-and-input-method-name)) | |
308 (let* ((key-slot (get-language-info language-name 'input-method)) | |
309 (method-slot (assoc method-name key-slot))) | |
310 (if (null method-slot) | |
311 (error "No input method `%s' for %s" method-name language-name)) | |
312 (if current-input-method | |
313 (progn | |
314 (if (not (equal previous-input-method current-input-method)) | |
315 (setq previous-input-method current-input-method)) | |
316 (funcall inactivate-current-input-method-function))) | |
317 (setq method-slot (cdr method-slot)) | |
318 (apply (car method-slot) method-name (cdr method-slot)) | |
319 (setq default-input-method | |
320 (setq current-input-method (cons language-name method-name))) | |
321 (setq default-input-method-title current-input-method-title) | |
322 (setq current-input-method default-input-method))) | |
323 | |
324 (defun toggle-input-method (&optional arg) | |
325 "Toggle whether a multilingual input method is activated in this buffer. | |
326 With arg, activate an input method specified interactively. | |
327 Without arg, the method being activated is the one selected most recently, | |
328 but if no input method has ever been selected, select one interactively." | |
329 (interactive "P") | |
330 (if arg | |
331 (call-interactively 'select-input-method) | |
332 (if (null current-input-method) | |
333 (if default-input-method | |
334 (select-input-method (car default-input-method) | |
335 (cdr default-input-method)) | |
336 (call-interactively 'select-input-method)) | |
337 (funcall inactivate-current-input-method-function) | |
338 (setq current-input-method nil)))) | |
339 | |
340 (defun describe-input-method () | |
341 "Describe the current input method." | |
342 (interactive) | |
343 (if current-input-method | |
344 (if (and (symbolp describe-current-input-method-function) | |
345 (fboundp describe-current-input-method-function)) | |
346 (funcall describe-current-input-method-function) | |
347 (message "No way to describe the current input method `%s'" | |
348 (cdr current-input-method)) | |
349 (ding)) | |
350 (message "No input method is activated now") | |
351 (ding))) | |
352 | |
353 (defun read-multilingual-string (prompt &optional initial-input | |
354 language-name method-name) | |
355 "Read a multilingual string from minibuffer, prompting with string PROMPT. | |
356 The input method selected last time is activated in minibuffer. | |
357 If non-nil, second arg INITIAL-INPUT is a string to insert before reading. | |
358 Optional 3rd and 4th arguments LANGUAGE-NAME and METHOD-NAME specify | |
359 the input method to be activated instead of the one selected last time." | |
360 (let ((minibuffer-setup-hook '(toggle-input-method)) | |
361 (default-input-method default-input-method)) | |
362 (if (and language-name method-name) | |
363 (set-default-input-method language-name method-name)) | |
364 (read-string prompt initial-input))) | |
365 | |
366 ;; Variables to control behavior of input methods. All input methods | |
367 ;; should react to these variables. | |
368 | |
369 (defvar input-method-tersely-flag nil | |
370 "*If this flag is non-nil, input method works rather tersely. | |
371 | |
372 For instance, Quail input method does not show guidance buffer while | |
373 inputting at minibuffer if this flag is t.") | |
374 | |
375 (defvar input-method-activate-hook nil | |
376 "Normal hook run just after an input method is activated.") | |
377 | |
378 (defvar input-method-inactivate-hook nil | |
379 "Normal hook run just after an input method is inactivated.") | |
380 | |
381 (defvar input-method-after-insert-chunk-hook nil | |
382 "Normal hook run just after an input method insert some chunk of text.") | |
383 | |
384 | |
385 ;;; Language specific setup functions. | |
386 (defun set-language-environment (language-name) | |
387 "Setup a user's environment for LANGUAGE-NAME. | |
388 | |
389 To setup, a fucntion returned by: | |
390 (get-language-info LANGUAGE-NAME 'setup-function) | |
391 is called." | |
392 (interactive (list (read-language-name 'setup-function "Language: "))) | |
393 (let (func) | |
394 (if (or (null language-name) | |
395 (null (setq func | |
396 (get-language-info language-name 'setup-function)))) | |
397 (error "No way to setup environment for the specified language")) | |
398 (funcall func))) | |
399 | |
400 ;; Print all arguments with `princ', then print "\n". | |
401 (defsubst princ-list (&rest args) | |
402 (while args (princ (car args)) (setq args (cdr args))) | |
403 (princ "\n")) | |
404 | |
405 (defun describe-language-support (language-name) | |
406 "Show documentation about how Emacs supports LANGUAGE-NAME." | |
407 (interactive (list (read-language-name 'documentation "Language: "))) | |
408 (let (doc) | |
409 (if (or (null language-name) | |
410 (null (setq doc | |
411 (get-language-info language-name 'documentation)))) | |
412 (error "No documentation for the specified language")) | |
413 (with-output-to-temp-buffer "*Help*" | |
414 (if (not (eq doc t)) | |
415 (cond ((stringp doc) | |
416 (princ doc)) | |
417 ((and (symbolp doc) (fboundp doc)) | |
418 (funcall doc)) | |
419 (t | |
420 (error "Invalid documentation data for %s" language-name))) | |
421 (princ-list "List of items specific to " | |
422 language-name | |
423 " environment") | |
424 (princ "-----------------------------------------------------------\n") | |
425 (let ((str (get-language-info language-name 'sample-text))) | |
426 (if (stringp str) | |
427 (progn | |
428 (princ "<sample text>\n") | |
429 (princ-list " " str)))) | |
430 (princ "<input methods>\n") | |
431 (let ((l (get-language-info language-name 'input-method))) | |
432 (while l | |
433 (princ-list " " (car (car l))) | |
434 (setq l (cdr l)))) | |
435 (princ "<character sets>\n") | |
436 (let ((l (get-language-info language-name 'charset))) | |
437 (if (null l) | |
438 (princ-list " nothing specific to " language-name) | |
439 (while l | |
440 (princ-list " " (car l) | |
441 (format ":%3d:\n\t" (charset-id (car l))) | |
442 (charset-description (car l))) | |
443 (setq l (cdr l))))) | |
444 (princ "<coding systems>\n") | |
445 (let ((l (get-language-info language-name 'coding-system))) | |
446 (if (null l) | |
447 (princ-list " nothing specific to " language-name) | |
448 (while l | |
449 (princ-list " " (car l) ":\n\t" | |
450 (coding-system-docstring (car l))) | |
451 (setq l (cdr l))))))))) | |
452 | |
453 ;;; Charset property | |
454 | |
455 (defsubst get-charset-property (charset propname) | |
456 "Return the value of CHARSET's PROPNAME property. | |
457 This is the last value stored with | |
458 `(put-charset-property CHARSET PROPNAME VALUE)'." | |
459 (plist-get (charset-plist charset) propname)) | |
460 | |
461 (defsubst put-charset-property (charset propname value) | |
462 "Store CHARSETS's PROPNAME property with value VALUE. | |
463 It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." | |
464 (set-charset-plist charset | |
465 (plist-put (charset-plist charset) propname value))) | |
466 | |
467 ;;; Character code property | |
468 (put 'char-code-property-table 'char-table-extra-slots 0) | |
469 | |
470 (defvar char-code-property-table | |
471 (make-char-table 'char-code-property-table) | |
472 "Char-table containing a property list of each character code. | |
473 | |
474 See also the documentation of `get-char-code-property' and | |
475 `put-char-code-property'") | |
476 | |
477 (defun get-char-code-property (char propname) | |
478 "Return the value of CHAR's PROPNAME property in `char-code-property-table'." | |
479 (let ((plist (aref char-code-property-table char))) | |
480 (if (listp plist) | |
481 (car (cdr (memq propname plist)))))) | |
482 | |
483 (defun put-char-code-property (char propname value) | |
484 "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. | |
485 It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." | |
486 (let ((plist (aref char-code-property-table char))) | |
487 (if plist | |
488 (let ((slot (memq propname plist))) | |
489 (if slot | |
490 (setcar (cdr slot) value) | |
491 (nconc plist (list propname value)))) | |
492 (aset char-code-property-table char (list propname value))))) | |
493 | |
494 ;;; mule-cmds.el ends here |