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