Mercurial > hg > xemacs-beta

comparison lisp/quail/quail.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents
children 6608ceec7cf8
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;; Quail -- Simple inputting method
2 ;; Copyright (C) 1992 Free Software Foundation, Inc.
3 ;; This file is part of XEmacs.
4
5 ;; XEmacs is free software; you can redistribute it and/or modify it
6 ;; under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation; either version 2, or (at your option)
8 ;; any later version.
9
10 ;; XEmacs is distributed in the hope that it will be useful, but
11 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; General Public License for more details.
14
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with XEmacs; see the file COPYING. If not, write to the Free
17 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
18
19 ;;; 92.2.12 created for Mule Ver.0.9.0 by K.Handa <handa@etl.go.jp>
20 ;;; long and gory change log deleted.
21
22 ;; Although, EGG is the major inputing method supported by Mule,
23 ;; it's, for the moment, not convenient for inputing Chinese letters.
24 ;; So, I wrote this program as an alternative to EGG to be used
25 ;; until revision of EGG.
26 ;; I modified all translation tables of cxterm/dict/tit of X.V11R5
27 ;; to be used with this system, those are named as quail-*.el.
28 ;; Please load only necessary tables.
29
30 ;; Quail serves as a front end processor for inputing
31 ;; multilingual text from normal ASCII keyboard. By defining a
32 ;; translation table which maps ASCII string to multilingual
33 ;; string, you can input any text from ASCII keyboard.
34
35 (require 'mule)
36
37 ;;;###autoload
38 (defconst quail-version "2.2")
39
40 (defvar quail-region-face 'underline)
41 (defvar quail-selection-face 'highlight)
42
43 (defvar quail-self-insert-after-hook nil
44 "Function(s) to call after inserting quail characters.")
45 (defvar quail-last-char nil
46 "A character typed last time in Quail mode.")
47
48 (defvar quail-completion-buf nil)
49 (defvar quail-guidance-buf nil)
50 (defmacro quail-buffer-alive-p (buf)
51 (list 'and (list 'bufferp buf) (list 'buffer-name buf)))
52
53 ;; Buffer local variables
54 (defvar quail-mode nil
55 "Non-nil if using Quail minor mode.")
56 (make-variable-buffer-local 'quail-mode)
57 (defvar quail-sub-mode nil
58 "Non-nil if in sub-mode of Quail minor mode.")
59 (make-variable-buffer-local 'quail-sub-mode)
60 (defvar quail-keep-state nil)
61 (make-variable-buffer-local 'quail-keep-state)
62 (defvar quail-mode-string nil)
63 (make-variable-buffer-local 'quail-mode-string)
64 (defvar quail-overlay nil
65 "Overlay which covers quail zone.")
66 (make-variable-buffer-local 'quail-overlay)
67 (defvar quail-current-key nil
68 "Within Quail mode, a key string typed so far.")
69 (make-variable-buffer-local 'quail-current-key)
70 (defvar quail-current-str nil
71 "Within Quail mode, a string currently translated from quail-current-key.")
72 (make-variable-buffer-local 'quail-current-str)
73 (defvar quail-previous-extra-mode-list nil)
74 (make-variable-buffer-local 'quail-previous-extra-mode-list)
75
76 ;; Quail package
77
78 ;;;###autoload
79 (defvar quail-package-alist nil
80 "Assoc list of quail-packages. Each element is a list of:
81 NAME, PROMPT, MAP, GUIDANCE, DOC, SUB-MODE-MAP, NOLEARN, DETERMINISTIC,
82 TRANSLATE, LAYOUT, OBSOLETE, DECODE-MAP, and EXTRA-MODE-LIST.
83 See the document of `quail-define-package' for more detail.")
84
85 (defmacro quail-package-name () '(car quail-current-package))
86 (defmacro quail-prompt () '(nth 1 quail-current-package))
87 (defmacro quail-map () '(nth 2 quail-current-package))
88 (defmacro quail-guidance () '(nth 3 quail-current-package))
89 (defmacro quail-document () '(nth 4 quail-current-package))
90 (defmacro quail-sub-mode-map () '(nth 5 quail-current-package))
91 (defmacro quail-nolearn () '(nth 6 quail-current-package))
92 (defmacro quail-deterministic () '(nth 7 quail-current-package))
93 (defmacro quail-translate () '(nth 8 quail-current-package))
94 (defmacro quail-layout () '(nth 9 quail-current-package))
95 (defmacro quail-decode-map () '(nth 11 quail-current-package))
96 (defmacro quail-extra-mode-list () '(nth 12 quail-current-package))
97
98 (defalias 'quail-showkey 'quail-guidance)
99 (defalias 'quail-dynamic-list 'quail-guidance)
100 ;;;###autoload(make-obsolete 'quail-showkey 'quail-guidance)
101 ;;;###autoload(make-obsolete 'quail-dynamic-list 'quail-guidance)
102
103 ;;;###autoload
104 (defvar quail-current-package nil "Current quail-pacakge.")
105 ;;;###autoload
106 (make-variable-buffer-local 'quail-current-package)
107
108 (defvar quail-last-package nil "Last quail-pacakge.")
109
110 (defmacro quail-package (name)
111 "Return quail-package named NAME."
112 (list 'assoc name 'quail-package-alist))
113
114 (defun quail-add-package (package)
115 (let ((pac (quail-package (car package))))
116 (if pac
117 (setcdr pac (cdr package))
118 (setq quail-package-alist (cons package quail-package-alist)))))
119
120 ;;;###autoload
121 (defun quail-use-package (name)
122 "Set current quail package to NAME."
123 (setq quail-current-package (quail-package name))
124 (if (null quail-current-package)
125 (error "No such quail-pacakge: %s" name))
126 (if (null (quail-map))
127 (load-library (quail-prompt)))
128 (if (null (string= name (car quail-current-package)))
129 (setq quail-current-package (quail-package name)))
130 (setq-default quail-current-package quail-current-package))
131
132 (defconst quail-mode-map
133 (let ((map (make-keymap)))
134 (substitute-key-definition 'self-insert-command
135 'quail-self-insert-command
136 map global-map)
137 map))
138
139 (or (assq 'quail-mode minor-mode-alist)
140 (setq minor-mode-alist
141 (cons '(quail-mode " Quail") minor-mode-alist)))
142
143 (or (assq 'quail-mode minor-mode-map-alist)
144 (setq minor-mode-map-alist
145 (cons (cons 'quail-mode quail-mode-map) minor-mode-map-alist)))
146
147 (defconst quail-sub-mode-map
148 (let ((map (copy-keymap quail-mode-map))
149 (i ?0))
150 (while (<= i ?9)
151 (define-key map (char-to-string i) 'quail-self-insert-or-index)
152 (setq i (1+ i)))
153 (define-key map "\en" 'quail-next-candidate)
154 (define-key map "\ep" 'quail-prev-candidate)
155 (define-key map "\eN" 'quail-next-candidate-block)
156 (define-key map "\eP" 'quail-prev-candidate-block)
157 (define-key map "\ei" 'quail-completion)
158 (define-key map "\e " 'quail-select-current)
159 (define-key map "\eg" 'quail-cancel-current)
160 (define-key map "\177" 'quail-backward-delete-char)
161 map))
162
163 (defconst quail-sub-mode-rich-bindings
164 '((">" . quail-next-candidate)
165 ("<" . quail-prev-candidate)
166 ("." . quail-next-candidate-block)
167 ("," . quail-prev-candidate-block)
168 (" " . quail-select-current)
169 ))
170
171 (defun quail-define-package (name prompt &optional guidance doc key-bindings
172 nolearn deterministic translate layout
173 obsolete decode-map extra-mode-list)
174 "Define NAME as a quail-package with initial quail map.
175 The second argument PROMPT is a string to be displayed as a name of
176 minor mode when NAME is selected as current package of quail-mode.
177 Optional arguments are GUIDANCE, DOC, KEY-BINDINGS, NOLEARN, DETERMINISTIC,
178 TRANSLATE, LAYOUT, OBSOLETE, DECODE-MAP, EXTRA-MODE-LIST.
179 GUIDANCE is an alist of key and correspoing string to be shown in echo area,
180 t means shows list of candidates,
181 nil means shows typed key.
182 DOC is a document shown by quail-help command.
183 KEY-BINDINGS is an additional key-bindings for control in quail-sub-mode,
184 the value should be a list of cons of KEY and COMMAND.
185 NOLEARN non-nil means not remembering a candidate seleceted last time.
186 DETERMINISTIC non-nil means deterministic translation
187 and NOLEARN is automatically set to t.
188 TRANSLATE non-nil means input characters are mapped to vt100 layout
189 with quail-keyboard-translate-table.
190 LAYOUT non-nil means translated keyboard layout to be displayed by quail-help.
191 OBSOLETE is an obsolete argument, anything specified is ignored.
192 DECODE-MAP non-nil means create decoding map.
193 EXTRA-MODE-LIST is a list of symbols of minor-modes to be set.
194 The current quail-package is set to this package and following quail-defrule
195 defines translation rules in it."
196 (if deterministic (setq nolearn t)) ;92.10.26 by T.Saneto
197 (quail-add-package
198 (list name prompt (make-sparse-keymap) guidance (or doc "") key-bindings
199 nolearn deterministic translate layout nil
200 (if decode-map '(0) nil)
201 extra-mode-list))
202 (quail-use-package name)
203 nil)
204
205 (defconst quail-keyboard-standard-table
206 '("\
207 1234567890-=`\
208 qwertyuiop[]\
209 asdfghjkl;'\\\
210 zxcvbnm,./\
211 !@#$%^&*()_+~\
212 QWERTYUIOP{}\
213 ASDFGHJKL:\"|\
214 ZXCVBNM<>?\
215 "
216 nil))
217
218 (defvar quail-keyboard-translate-table
219 quail-keyboard-standard-table
220 "List of QUAIL-TRANSLATE-TABLE (first element) and QUAIL-ASSOC-TABLE
221 (second element).
222 QUAIL-TRANSLATE-TABLE is a string which represents the 'normalised'
223 layout of a particular keyboard.
224 QUAIL-ASSOC-TABLE is an a-list which describes 'unordinary' key
225 locations. A key location is given by a vector of the form
226 [x-position y-position shift-or-not]. For example, the '1' (one)
227 key's location is [0 0 0], and 'W' (capital letter W) is [1 1 1]. The
228 third element being 0 means unshifted, 1 means shifted. If
229 QUAIL-ASSOC-TABLE is NIL, the first argument given to quail-defrule
230 will not be translated.")
231
232 (defconst quail-keyboard-translate-table-sun-type3
233 '("\
234 1234567890-=\\\
235 qwertyuiop[]\
236 asdfghjkl;'`\
237 zxcvbnm,./\
238 !@#$%^&*()_+|\
239 QWERTYUIOP{}\
240 ASDFGHJKL:\"~\
241 ZXCVBNM<>?\
242 "
243 ((?` [13 0 0]) (?~ [13 0 1]))))
244
245 (defconst quail-keyboard-translate-table-sun-type4
246 '("\
247 1234567890-=\\\
248 qwertyuiop[]\
249 asdfghjkl;'`\
250 zxcvbnm,./\
251 !@#$%^&*()_+|\
252 QWERTYUIOP{}\
253 ASDFGHJKL:\"~\
254 ZXCVBNM<>?\
255 "
256 ((?\\ [11 -1 0]) (?| [11 -1 1]))))
257
258 (defconst quail-keyboard-translate-table-sony-nwp-411a
259 '("\
260 1234567890-=\\\
261 qwertyuiop[]\
262 asdfghjkl;'`\
263 zxcvbnm,./\
264 !@#$%^&*()_+|\
265 QWERTYUIOP{}\
266 ASDFGHJKL:\"~\
267 ZXCVBNM<>?\
268 "
269 nil))
270
271 (defconst quail-keyboard-translate-table-jis
272 '("\
273 1234567890-^\\\
274 qwertyuiop@[\
275 asdfghjkl;:]\
276 zxcvbnm,./\
277 !\"#$%&'()_=`|\
278 QWERTYUIOP~{\
279 ASDFGHJKL+*}\
280 ZXCVBNM<>?\
281 "
282 ((?_ [10 3 1]))))
283
284 (defconst quail-keyboard-translate-table-fujitsu-sigma-230
285 '("\
286 1234567890-^\\\
287 qwertyuiop@[\
288 asdfghjkl;:]\
289 zxcvbnm,./\
290 !\"#$%&'()_=~|\
291 QWERTYUIOP`{\
292 ASDFGHJKL+*}\
293 ZXCVBNM<>?\
294 "
295 ((?_ [10 3 1]))))
296
297 (defconst quail-keyboard-translate-table-ibm-at
298 '("\
299 1234567890-=\\\
300 qwertyuiop[]\
301 asdfghjkl;'`\
302 zxcvbnm,./\
303 !@#$%^&*()_+|\
304 QWERTYUIOP{}\
305 ASDFGHJKL:\"~\
306 ZXCVBNM<>?\
307 "
308 ((?` [-1 0 0]) (?~ [-1 0 1]))))
309
310 (defconst quail-keyboard-translate-table-ibm-rt/pc
311 '("\
312 1234567890-=`\
313 qwertyuiop[]\
314 asdfghjkl;'\\\
315 zxcvbnm,./\
316 !@#$%^&*()_+~\
317 QWERTYUIOP{}\
318 ASDFGHJKL:\"|\
319 ZXCVBNM<>?\
320 "
321 ((?` [-1 0 0]) (?~ [-1 0 1]) (?\\ [12 1 0]) (?| [12 1 1]))))
322
323 (defconst quail-keyboard-translate-table-decstation
324 '("\
325 1234567890-=`\
326 qwertyuiop[]\
327 asdfghjkl;'\\\
328 zxcvbnm,./\
329 !@#$%^&*()_+~\
330 QWERTYUIOP{}\
331 ASDFGHJKL:\"|\
332 ZXCVBNM<>?\
333 "
334 ((?` [-1 3 0]) (?~ [-1 3 1]))))
335
336 (defconst quail-keyboard-translate-table-dynabook
337 '("\
338 1234567890-=`\
339 qwertyuiop[]\
340 asdfghjkl;'\\\
341 zxcvbnm,./\
342 !@#$%^&*()_+~\
343 QWERTYUIOP{}\
344 ASDFGHJKL:\"|\
345 ZXCVBNM<>?\
346 "
347 ((?` [7 4 0]) (?~ [7 4 1]) (?\\ [1 4 0]) (?| [1 4 1]))))
348
349 (defconst quail-keyboard-translate-table-mac-mo110
350 '("\
351 1234567890-=`\
352 qwertyuiop[]\
353 asdfghjkl;'\\\
354 zxcvbnm,./\
355 !@#$%^&*()_+~\
356 QWERTYUIOP{}\
357 ASDFGHJKL:\"|\
358 ZXCVBNM<>?\
359 "
360 ((?` [-1 0 0]) (?~ [-1 0 1]) (?\\ [8 4 0]) (?| [8 4 1]))))
361
362 (defconst quail-keyboard-translate-table-mac-mo116
363 '("\
364 1234567890-=`\
365 qwertyuiop[]\
366 asdfghjkl;'\\\
367 zxcvbnm,./\
368 !@#$%^&*()_+~\
369 QWERTYUIOP{}\
370 ASDFGHJKL:\"|\
371 ZXCVBNM<>?\
372 "
373 ((?` [1 4 0]) (?~ [1 4 1]) (?\\ [7 4 0]) (?| [7 4 1]))))
374
375 (defun quail-defrule (key candidate &optional name)
376 "Define KEY (string) to produce CANDIDATE in the current quail-map.
377 CANDIDATE is a string, a list of strings, a quail-map, a command, or a symbol.
378 If the string contains only one character, the character code (integer) is
379 also acceptable.
380 The command should be a lisp function suitable for interactive
381 calling (and called with no argument).
382 The symbol's function definition should be a quail-map.
383 Optional arg PACKAGE indicates the package name to be used."
384 (let* ((quail-current-package
385 (if name (quail-package name) quail-current-package))
386 (map (quail-map)))
387 (if (not (keymapp map))
388 (error "QUAIL: Invalid quail-map: %s" map)
389 (if (or (keymapp candidate) ; another quail-map
390 (symbolp candidate)) ; command or symbol
391 (define-key map key candidate)
392 (if (integerp candidate)
393 (setq candidate (char-to-string candidate)))
394 (if (and (setq map (lookup-key map key))
395 (keymapp map))
396 (if (vectorp (car (cdr map)))
397 (define-key map "\0" candidate)
398 (setcdr map (cons (vector candidate) (cdr map))))
399 (define-key (quail-map) key (list 'keymap (vector candidate)))))
400 (if (null (vectorp candidate))
401 (let ((decode-map (quail-decode-map))
402 tbl)
403 (if decode-map
404 (if (setq tbl (assoc candidate decode-map))
405 (setcdr tbl key)
406 (setcar (nthcdr 11 quail-current-package)
407 (cons (cons candidate key) decode-map))))))
408 ))
409 nil)
410
411 (defalias 'qd 'quail-defrule)
412 (defmacro qdv (key str) (list 'quail-defrule key (list 'vector str)))
413
414 (defun quail-message (msg)
415 (or (eq (current-buffer) (window-buffer (minibuffer-window)))
416 (message "%s" msg)))
417
418 (defun quail-select-package (name)
419 "Select quail-package."
420 (interactive
421 (let* ((completion-ignore-case t)
422 (default (if quail-last-package
423 (car quail-last-package)))
424 (package-name (completing-read
425 (format "Quail Package (%s): " default)
426 quail-package-alist nil t nil)))
427 (if (> (length package-name) 0) (list package-name) (list default))))
428 (if (quail-package name)
429 (progn
430 (setq quail-last-package quail-current-package)
431 (quail-use-package name)
432 (if quail-mode
433 (progn (quail-exit-mode) (quail-mode))))))
434
435 ;;;###autoload
436 (defun quail-mode (&optional arg)
437 "Toggle Quail minor mode.
438 With arg, turn Quail mode on if and only if arg is positive.
439 The command key you can use in Quail mode depends on a quail package.
440 Try \\[describe-bindings] in quail-mode.
441 The description about the current quail package is shown by \\[quail-help]."
442 (interactive "P")
443 (setq quail-mode (if (null arg)
444 (null quail-mode)
445 (> (prefix-numeric-value arg) 0)))
446 (if quail-mode
447 (if quail-package-alist
448 (quail-enter-mode)
449 (setq quail-mode nil)
450 (error "QUAIL: No quail-package, one should be loaded in advance."))
451 (quail-exit-mode))
452 (force-mode-line-update 'all))
453
454 (defun quail-setup-guidance-buf ()
455 (or (and (bufferp quail-guidance-buf) (buffer-name quail-guidance-buf))
456 (setq quail-guidance-buf
457 (get-buffer-create " *Quail guide for minibuffer*")))
458 (let ((prompt (quail-prompt))
459 (curbuf (current-buffer)))
460 (set-buffer quail-guidance-buf)
461 (if (null (assq 'quail-mode mode-line-format))
462 (setq mode-line-format
463 (cons '(quail-mode (mc-flag ("[" quail-mode-string "]")))
464 mode-line-format)))
465 (setq quail-mode t
466 quail-mode-string prompt)
467 (erase-buffer)
468 (or (overlayp quail-overlay)
469 (setq quail-overlay (make-overlay 1 1)))
470 (set-buffer curbuf))
471 (cond ((get-buffer-window quail-guidance-buf)
472 ;; `buf' is already shown in some window.
473 )
474 ((null (eq (current-buffer) (window-buffer (minibuffer-window))))
475 ;; We are in normal buffer, let's use minibuffer.
476 (set-window-buffer (minibuffer-window) quail-guidance-buf))
477 (t
478 ;; Since we are in minibuffer, we can't use it.
479 ;; Let's find the bottom window.
480 (let ((window-min-height 1)
481 (win (frame-lowest-window (selected-frame)))
482 height)
483 (setq height (window-height win))
484 (if (>= height 4)
485 (setq win (split-window win (- height 2))))
486 (set-window-buffer win quail-guidance-buf)))))
487
488 (defun quail-delete-guidance-buf ()
489 (if (and (bufferp quail-guidance-buf) (buffer-name quail-guidance-buf))
490 (if (eq (current-buffer) (window-buffer (minibuffer-window)))
491 (let ((win (get-buffer-window quail-guidance-buf)))
492 (if win (delete-window win)))
493 (set-window-buffer (minibuffer-window)
494 (format " *Minibuf-%d*" (minibuffer-depth))))))
495
496 (defun quail-enter-mode ()
497 (or (eq (car (car minor-mode-map-alist)) 'quail-mode)
498 (setq minor-mode-map-alist
499 (cons (cons 'quail-mode quail-mode-map) minor-mode-map-alist)))
500 (quail-use-package (or (car quail-current-package)
501 (car (car quail-package-alist))))
502 (setq quail-mode-string (quail-prompt))
503 (if (null (assq 'quail-mode mode-line-format))
504 (setq mode-line-format
505 (cons '(quail-mode (mc-flag ("[" quail-mode-string "]")))
506 mode-line-format)))
507 (if (null (overlayp quail-overlay))
508 (progn
509 (setq quail-overlay (make-overlay (point) (point)))
510 (overlay-put quail-overlay 'face quail-region-face)))
511 (make-local-hook 'post-command-hook)
512 (add-hook 'post-command-hook 'quail-reset-state nil t)
513 (setq quail-keep-state nil)
514 (if (quail-sub-mode-map)
515 (progn
516 (if (null (keymapp (quail-sub-mode-map)))
517 (let ((bindings (quail-sub-mode-map))
518 (map (copy-keymap quail-sub-mode-map)))
519 (while bindings
520 (define-key map (car (car bindings)) (cdr (car bindings)))
521 (setq bindings (cdr bindings)))
522 (setcar (nthcdr 5 quail-current-package) map)))))
523 (let ((modes (quail-extra-mode-list))
524 (i 0))
525 (setq quail-previous-extra-mode-list (make-list (length modes) nil))
526 (while modes
527 (setcar (nthcdr i quail-previous-extra-mode-list)
528 (symbol-value (car modes)))
529 (if (null (symbol-value (car modes)))
530 (funcall (car modes) 1))
531 (setq i (1+ i) modes (cdr modes))))
532 (quail-init-state)
533 (quail-message (substitute-command-keys "\\[quail-help] for help."))
534 (run-hooks 'quail-mode-hook))
535
536 (defun quail-exit-mode ()
537 (interactive)
538 (kill-local-variable 'post-command-hook)
539 (delete-overlay quail-overlay)
540 (quail-delete-guidance-buf)
541 (let ((modes (quail-extra-mode-list))
542 (i 0))
543 (while modes
544 (if (null (nth i quail-previous-extra-mode-list))
545 (funcall (car modes) -1))
546 (setq i (1+ i) modes (cdr modes))))
547 (setq quail-mode nil))
548
549 (defun quail-enter-sub-mode ()
550 (setcdr (assoc 'quail-mode minor-mode-map-alist)
551 (or (quail-sub-mode-map) quail-sub-mode-map))
552 (setq quail-sub-mode t))
553
554 (defun quail-exit-sub-mode ()
555 (setcdr (assoc 'quail-mode minor-mode-map-alist) quail-mode-map)
556 (setq quail-sub-mode nil))
557
558 (defun quail-reset-state ()
559 (if quail-mode
560 (if quail-keep-state
561 (setq quail-keep-state nil)
562 (quail-init-state))))
563
564 (defun quail-init-state ()
565 (if (overlayp quail-overlay)
566 (move-overlay quail-overlay (point) (point))
567 (setq quail-overlay (make-overlay (point) (point))))
568 (setq quail-current-key nil
569 quail-current-str nil)
570 (if quail-sub-mode (quail-exit-sub-mode))
571 (quail-setup-guidance-buf))
572
573 (defun quail-check-state ()
574 (if (and (overlay-buffer quail-overlay)
575 (= (point) (overlay-end quail-overlay)))
576 quail-current-key
577 (quail-init-state)
578 nil))
579
580 (defun quail-delete-region ()
581 (delete-region (overlay-start quail-overlay) (overlay-end quail-overlay)))
582
583 (defun quail-insert (str)
584 (quail-delete-region)
585 (if visual-mode
586 (if (stringp str)
587 (let ((l (string-to-char-list str))) ;93.4.30 by Takahashi N.
588 (while l
589 (visual-insert-1-char (car l))
590 (setq l (cdr l))))
591 (visual-insert-1-char str))
592 (insert str))
593 (if (and auto-fill-function (> (current-column) fill-column))
594 (run-hooks 'auto-fill-function))
595 (let ((len (if (integerp str) (char-bytes str) (length str))))
596 (move-overlay quail-overlay (- (point) len) (point)))
597 (quail-show-guidance))
598
599 (defun quail-get-candidates (def)
600 (setq def (car (cdr def)))
601 (if (null (vectorp def))
602 nil
603 (let ((candidates (aref def 0)))
604 (if (vectorp candidates)
605 (progn
606 (setq candidates
607 (cons 0 (string-to-char-list (aref candidates 0))))
608 (aset def 0 candidates))
609 (if (and (listp candidates)
610 (stringp (car candidates)))
611 (progn
612 (setq candidates (cons 0 candidates))
613 (aset def 0 candidates))))
614 candidates)))
615
616 (defun quail-get-candidate (def &optional nolearn)
617 (let ((candidates (quail-get-candidates def)))
618 (if candidates
619 (if (not (listp candidates)) ;93.1.17 by K.Handa
620 (if (integerp candidates)
621 candidates
622 (if (and (symbolp candidates) (fboundp candidates))
623 (if (keymapp (symbol-function candidates))
624 (symbol-function candidates)
625 (funcall candidates))
626 candidates))
627 (if nolearn
628 (rplaca candidates 0))
629 (nth (car candidates) (cdr candidates)))))) ;93.1.17 by K.Handa
630
631 (defun quail-show-guidance ()
632 ;; At first, show dynamic list or current keyin string in echo area.
633 (quail-setup-guidance-buf)
634 (let ((guidance (quail-guidance)))
635 (if (eq guidance t)
636 (quail-list-dynamically)
637 (save-excursion
638 (let ((key quail-current-key))
639 (save-excursion
640 (set-buffer quail-guidance-buf)
641 (if (null guidance)
642 (insert key)
643 (let ((i 0) (len (length key)) ch show)
644 (while (< i len)
645 (setq ch (aref key i))
646 (setq show (cdr (assoc ch guidance)))
647 (insert (if show show (char-to-string ch)))
648 (setq i (1+ i))))))))))
649 ;; Then highlight the current candidate string in *Completion* buffer if any.
650 (if (and (quail-buffer-alive-p quail-completion-buf)
651 (get-buffer-window quail-completion-buf))
652 (let ((buf (current-buffer))
653 (str (if (stringp quail-current-str)
654 quail-current-str
655 (if (numberp quail-current-str)
656 (char-to-string quail-current-str))))
657 (key quail-current-key))
658 (select-window (get-buffer-window quail-completion-buf))
659 (goto-char (point-min))
660 (if (search-forward (concat " " key ":") nil t)
661 (if (and str (search-forward (concat "." str) nil t))
662 (move-overlay quail-overlay (1+ (match-beginning 0)) (point))
663 (move-overlay quail-overlay (match-beginning 0) (point)))
664 (move-overlay quail-overlay 1 1))
665 (select-window (get-buffer-window buf))
666 )))
667
668 (defun quail-translate-char (ch)
669 (let* ((str (car quail-keyboard-translate-table))
670 (len (length str))
671 (i 0))
672 (while (and (< i len) (/= ch (aref str i)))
673 (setq i (1+ i)))
674 (if (= i len)
675 (error "'%c' not found in quail-keyboard-translate-table" ch))
676 (aref (car quail-keyboard-standard-table) i)))
677
678 (defun quail-select-current ()
679 "Select the current candidate."
680 (interactive "*")
681 (quail-self-insert-command t))
682
683 (defun quail-self-insert-or-index ()
684 "Select a character from the current 10 candidates by digit."
685 (interactive "*")
686 (quail-self-insert-command (- last-command-char ?0)))
687
688 (defun quail-lookup-key (key)
689 (let ((def (lookup-key (quail-map) key)))
690 (if (and (symbolp def) (fboundp def))
691 (setq def (symbol-function def)))
692 def))
693
694 (defun quail-self-insert-command (&optional arg)
695 (interactive "*")
696 (setq quail-keep-state t)
697 (quail-check-state)
698 (setq quail-last-char last-command-char)
699 (let* ((ch (if (quail-translate)
700 (quail-translate-char quail-last-char)
701 quail-last-char))
702 (chstr (char-to-string ch))
703 (key (if quail-current-key
704 (format "%s%c" quail-current-key ch)
705 chstr))
706 (def (quail-lookup-key key)))
707 (cond ((keymapp def)
708 (setq quail-current-key key)
709 (setq quail-current-str (quail-get-candidate def (quail-nolearn)))
710 (quail-insert (or quail-current-str quail-current-key))
711 (if (and quail-current-str
712 (null (nthcdr 2 def))
713 (setq def (aref (nth 1 def) 0))
714 (or (null (listp def)) (= (length def) 2))
715 (null (and (>= (length quail-current-key) 3)
716 (lookup-key (quail-map) chstr))))
717 (quail-init-state)))
718 ((commandp def)
719 (setq quail-current-key key)
720 (if (keymapp (symbol-function def))
721 (progn
722 (setq quail-current-str nil)
723 (quail-insert quail-current-key))
724 (call-interactively def)))
725 ((and (numberp arg) quail-current-str (null (quail-deterministic)))
726 (quail-indexed-candidate arg))
727 ((eq arg t)
728 (quail-init-state))
729 (quail-current-key
730 (let ((len (length key)) str)
731 (if (and (>= len 4)
732 (keymapp (lookup-key (quail-map) (substring key -2)))
733 (setq def (quail-lookup-key (substring key 0 -2)))
734 (keymapp def)
735 (setq str (quail-get-candidate def (quail-nolearn))))
736 (progn
737 (quail-delete-region)
738 (insert str)
739 (quail-init-state)
740 (setq unread-command-events
741 (cons (aref key (- len 2))
742 (cons ch unread-command-events))))
743 (quail-init-state)
744 (quail-self-insert-command))))
745 (t
746 (quail-init-state)
747 (self-insert-command 1)))
748 (run-hooks 'quail-self-insert-after-hook)
749 )
750 (if (and quail-current-key (null quail-sub-mode))
751 (quail-enter-sub-mode))
752 )
753
754 (defun quail-next-candidate ()
755 "Select next candidate."
756 (interactive)
757 (setq quail-keep-state t)
758 (if (and (quail-check-state) quail-current-str)
759 (quail-select-candidate 1 t)
760 (beep)))
761
762 (defun quail-prev-candidate ()
763 "Select previous candidate."
764 (interactive)
765 (setq quail-keep-state t)
766 (if (and (quail-check-state) quail-current-str)
767 (quail-select-candidate -1 t)
768 (beep)))
769
770 (defun quail-indexed-candidate (idx)
771 (setq idx (if (= idx 0) 9 (1- idx)))
772 (quail-select-candidate idx nil t)
773 (quail-init-state))
774
775 (defun quail-next-candidate-block ()
776 "Select candidate in next 10 alternatives."
777 (interactive)
778 (setq quail-keep-state t)
779 (if (and (quail-check-state) quail-current-str)
780 (quail-select-candidate 10 t t)
781 (beep)))
782
783 (defun quail-prev-candidate-block ()
784 "Select candidate in previous 10 alternatives."
785 (interactive)
786 (setq quail-keep-state t)
787 (if (and (quail-check-state) quail-current-str)
788 (quail-select-candidate -10 t t)
789 (beep)))
790
791 (defun quail-select-candidate (idx &optional relative block)
792 (let* ((def (quail-lookup-key quail-current-key))
793 (candidates (quail-get-candidates def)))
794 (if (listp candidates)
795 (let ((maxidx (- (length candidates) 2))
796 (current-idx (car candidates)))
797 (if relative
798 (setq idx (+ current-idx idx))
799 (if block
800 (setq idx (+ (* (/ current-idx 10) 10) idx))))
801 (if block
802 (if (> idx maxidx)
803 (if (/= (/ maxidx 10) (/ current-idx 10))
804 (setq idx maxidx)
805 (beep)
806 (setq idx current-idx))
807 (if (< idx 0) (progn (beep) (setq idx (+ idx 10)))))
808 (if (> idx maxidx) (setq idx 0)
809 (if (< idx 0) (setq idx maxidx))))
810 (rplaca candidates idx)
811 (setq quail-current-str (nth (car candidates) (cdr candidates)))
812 (quail-insert quail-current-str)))))
813
814 (defun quail-cancel-current ()
815 "Cancel the current key sequence."
816 (interactive)
817 (quail-delete-region)
818 (quail-init-state))
819
820 (defun quail-backward-delete-char (arg)
821 "Delete characters backward in quail-mode."
822 (interactive "*p")
823 (if (= (length quail-current-key) 1)
824 (progn
825 (quail-delete-region)
826 (quail-init-state))
827 (setq quail-keep-state t)
828 (setq quail-current-key (substring quail-current-key 0 -1))
829 (let ((def (quail-lookup-key quail-current-key)))
830 (setq quail-last-char
831 (aref quail-current-key (1- (length quail-current-key))))
832 (setq quail-current-str
833 (quail-get-candidate def (quail-nolearn))) ;93.1.17 by K.Handa
834 (quail-insert (or quail-current-str quail-current-key)))))
835
836 (defvar quail-work-str (make-string 128 0))
837
838 (defun quail-list-dynamically ()
839 "Show list of candidates dynamically."
840 (let* ((def (quail-lookup-key quail-current-key))
841 (candidates (quail-get-candidates def))
842 (key quail-current-key))
843 (save-excursion
844 (set-buffer quail-guidance-buf)
845 (erase-buffer)
846 (insert key)
847 (if (or (nthcdr 2 def) (listp (car (cdr def))))
848 (let ((i ? ) (l (cdr def)))
849 (while (< i 127) (aset quail-work-str i 0) (setq i (1+ i)))
850 (while l
851 (if (listp (car l))
852 (aset quail-work-str (car (car l)) 1))
853 (setq l (cdr l)))
854 (insert "[")
855 (setq i ? )
856 (while (< i 127)
857 (if (= (aref quail-work-str i) 1)
858 (insert i))
859 (setq i (1+ i)))
860 (insert "]")))
861 (if (consp candidates)
862 (let ((idx (car candidates))
863 (maxidx (1+ (/ (1- (length (cdr candidates))) 10)))
864 (num 0)
865 p p1 p2 str)
866 (indent-to 10)
867 (insert (format "(%d/%d)" (1+ (/ idx 10)) maxidx))
868 (setq candidates (nthcdr (* (/ idx 10) 10) (cdr candidates)))
869 (while (and candidates (< num 10))
870 (setq num (1+ num))
871 (insert (format " %d." (if (< num 10) num 0)))
872 (setq p (point))
873 (insert (car candidates))
874 (if (= num (1+ (% idx 10)))
875 (setq p1 p p2 (point)))
876 (setq candidates (cdr candidates)))
877 (put-text-property p1 p2 'face quail-selection-face))))
878 ))
879
880 (defun quail-display-buffer (buf)
881 (if (get-buffer-window buf)
882 nil
883 (let ((curwin (selected-window))
884 (height 0)
885 largest)
886 (walk-windows '(lambda (win)
887 (if (and (null (eq curwin win ))
888 (> (window-height win) height))
889 (setq height (window-height win)
890 largest win))))
891 (set-window-buffer (if (> height (/ (window-height curwin) 2))
892 largest
893 (split-window curwin))
894 buf)
895 )))
896
897 (defun quail-completion ()
898 "Show list of candidates."
899 (interactive)
900 (let ((def (quail-lookup-key quail-current-key))
901 (key quail-current-key))
902 (if (not (keymapp def))
903 (quail-message "No macth.")
904 (setq quail-keep-state t)
905 (save-excursion
906 (if (not (quail-buffer-alive-p quail-completion-buf))
907 (setq quail-completion-buf
908 (get-buffer-create "*Completions*")))
909 (set-buffer quail-completion-buf)
910 (erase-buffer)
911 (setq quail-overlay (make-overlay 1 1))
912 (overlay-put quail-overlay 'face quail-selection-face)
913 (insert "Current candidates:\n")
914 (quail-completion-list key def 1)
915 (quail-display-buffer (current-buffer)))
916 (quail-show-guidance))))
917
918 (defun quail-completion-list (key def indent)
919 (let ((candidates (quail-get-candidates def)))
920 (indent-to indent)
921 (insert key ":")
922 (if candidates
923 (quail-candidate-with-indent
924 (if (consp candidates) (cdr candidates) candidates)
925 key)
926 (insert " none\n"))
927 (setq indent (+ indent 2))
928 (setq def (cdr def))
929 (while def
930 (if (listp (vectorp (car def)))
931 (let ((map (cdr (car def))))
932 (if (symbolp map) (setq map (symbol-function map)))
933 (quail-completion-list (format "%s%c" key (car (car def)))
934 map indent)))
935 (setq def (cdr def)))))
936
937 (defun quail-candidate-with-indent (candidates key)
938 (if (consp candidates)
939 (let ((clm (current-column))
940 (i 0)
941 num)
942 (while candidates
943 (if (= (% i 10) 0) (insert (format "(%d)" (1+ (/ i 10)))))
944 (insert " " (if (= (% i 10) 9) "0" (+ ?1 (% i 10))) ".")
945 (insert (if (stringp (car candidates))
946 (car candidates)
947 (char-to-string (car candidates))))
948 (setq i (1+ i))
949 (setq candidates (cdr candidates))
950 (if (and candidates (= (% i 10) 0))
951 (progn
952 (insert ?\n)
953 (indent-to clm)))))
954 (if (and (symbolp candidates) (fboundp candidates))
955 (insert " (1) 0."
956 (let ((quail-current-key key)) (funcall candidates)))
957 (insert " (1) 0." candidates)))
958 (insert ?\n))
959
960 (defun quail-help ()
961 "Show brief description of the current quail-pacakge."
962 (interactive)
963 (setq quail-keep-state t)
964 (let ((package quail-current-package)
965 (buf (get-buffer "*Quail-Help*"))
966 (first t))
967 (save-excursion
968 (set-buffer (or buf (get-buffer-create "*Quail-Help*")))
969 (if (and buf (eq package quail-current-package))
970 (setq first nil)
971 (setq buf (current-buffer))
972 (setq quail-current-package package)
973 (erase-buffer)
974 (insert (quail-document))
975 (if (quail-layout) (quail-show-layout))
976 (insert "\n--- Key bindinds ---\n")
977 (let ((map (or (quail-sub-mode-map) quail-sub-mode-map))
978 (i 0))
979 (while (< i 256)
980 (quail-describe-binding map i)
981 (setq i (1+ i)))
982 (setq map (lookup-key map (vector meta-prefix-char)))
983 (setq i 0)
984 (while (< i 256)
985 (quail-describe-binding map i 'meta)
986 (setq i (1+ i)))
987 (goto-char (point-min)))))
988 (let ((win (get-buffer-window buf)))
989 (if win
990 (save-excursion
991 (set-buffer buf)
992 (if (null first)
993 (if (> (point-max) (window-end win))
994 (set-window-start win (window-end win))
995 (if (< (point-min) (window-start win))
996 (set-window-start win 1)))))
997 (quail-display-buffer buf))
998 (let (up down)
999 (save-excursion
1000 (sit-for 0)
1001 (set-buffer buf)
1002 (if (> (point-max) (window-end win))
1003 (setq up t)
1004 (if (< (point-min) (window-start win))
1005 (setq down t))))
1006 (if up
1007 (quail-message
1008 (substitute-command-keys
1009 "\\[quail-help] to scroll up *Quail-Help* buffer."))
1010 (if down
1011 (quail-message
1012 (substitute-command-keys
1013 "\\[quail-help] to show top of *Quail-Help* buffer."))))))
1014 ))
1015
1016 (defun quail-show-layout ()
1017 (let* ((xoff 10)
1018 (yoff 3)
1019 (space 4)
1020 (p (point))
1021 (i 0)
1022 (str (car quail-keyboard-translate-table))
1023 (len (length str))
1024 (alist (car (cdr quail-keyboard-translate-table)))
1025 pos x y ch ch1 kmp)
1026 (insert "
1027
1028
1029
1030
1031
1032
1033
1034
1035 ")
1036 (save-excursion
1037 (while (< i len)
1038 (goto-char p)
1039 (setq ch (aref str i))
1040 (if (setq pos (car (cdr (assoc ch alist))))
1041 (progn (forward-line (+ yoff (aref pos 1)))
1042 (forward-char (+ xoff (* space (aref pos 0))
1043 (aref pos 1) (aref pos 2))))
1044 (cond
1045 ((< i 13) (setq x i y 0)) ; unshifted, 1st row
1046 ((< i 25) (setq x (- i 13) y 1)) ; unshifted, 2nd row
1047 ((< i 37) (setq x (- i 25) y 2)) ; unshifted, 3rd row
1048 ((< i 47) (setq x (- i 37) y 3)) ; unshifted, 4th row
1049 ((< i 60) (setq x (- i 47) y 0)) ; shifted, 1st row
1050 ((< i 72) (setq x (- i 60) y 1)) ; shifted, 2nd row
1051 ((< i 84) (setq x (- i 72) y 2)) ; shifted, 3rd row
1052 ((< i 94) (setq x (- i 84) y 3)) ; shifted, 4th row
1053 (t (setq x (- i 90) y 4))) ; space, bottom row
1054 (forward-line (+ yoff y))
1055 (forward-char (+ xoff (* space x) y (if (< i 47) 0 1))))
1056 (delete-char 1)
1057 (if (quail-translate)
1058 (setq ch (quail-translate-char ch)))
1059 (setq ch1
1060 (and (setq kmp (quail-lookup-key (char-to-string ch)))
1061 (quail-get-candidate kmp (quail-nolearn))))
1062 (insert (if ch1 ch1 ch))
1063 (setq i (1+ i))))))
1064
1065 (defun quail-describe-binding (map i &optional meta)
1066 (let ((cmd (lookup-key map (vector i))))
1067 (if (and (symbolp cmd) (fboundp cmd)
1068 (not (memq cmd '(quail-self-insert-command
1069 quail-self-insert-or-index))))
1070 (progn
1071 (if meta (insert "ESC "))
1072 (insert (single-key-description i) ":")
1073 (indent-to-column 8)
1074 (insert (documentation cmd) "\n")))))
1075
1076 ;;;###autoload
1077 (global-set-key "\C-]" 'quail-mode)
1078
1079 (define-key mule-keymap "M" 'quail-select-package)
1080
1081 ;; For byte-compiler
1082 (put 'quail-defrule 'byte-hunk-handler 'eval)
1083 (put 'qdv 'byte-hunk-handler 'eval)
1084 (put 'qd 'byte-hunk-handler 'eval)
1085 (put 'quail-define-package 'byte-hunk-handler 'eval)
1086
1087 (defun quail-setup-current-package ()
1088 ;; Do nothing while loading non-compiled file.
1089 )
1090
1091 (defun quail-setup-current-package-handler (ignore)
1092 (list 'quail-add-package (list 'quote quail-current-package)))
1093
1094 (put 'quail-setup-current-package 'byte-hunk-handler
1095 'quail-setup-current-package-handler)
1096
1097 ;;
1098 (provide 'quail)