Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; quail.el --- provides simple input method for multilingual text |
4ed46869 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1997-1998, 2000-2014 Free Software Foundation, Inc. |
7976eda0 | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
5df4f04c | 5 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 |
db328182 KH |
6 | ;; National Institute of Advanced Industrial Science and Technology (AIST) |
7 | ;; Registration Number H14PRO021 | |
4ed46869 KH |
8 | |
9 | ;; Author: Kenichi HANDA <handa@etl.go.jp> | |
10 | ;; Naoto TAKAHASHI <ntakahas@etl.go.jp> | |
11 | ;; Maintainer: Kenichi HANDA <handa@etl.go.jp> | |
35fffde1 | 12 | ;; Keywords: mule, multilingual, input method, i18n |
4ed46869 KH |
13 | |
14 | ;; This file is part of GNU Emacs. | |
15 | ||
4936186e | 16 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
4ed46869 | 17 | ;; it under the terms of the GNU General Public License as published by |
4936186e GM |
18 | ;; the Free Software Foundation, either version 3 of the License, or |
19 | ;; (at your option) any later version. | |
4ed46869 KH |
20 | |
21 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
22 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
24 | ;; GNU General Public License for more details. | |
25 | ||
26 | ;; You should have received a copy of the GNU General Public License | |
4936186e | 27 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
4ed46869 KH |
28 | |
29 | ;;; Commentary: | |
30 | ||
31 | ;; In Quail minor mode, you can input multilingual text easily. By | |
32 | ;; defining a translation table (named Quail map) which maps ASCII key | |
33 | ;; string to multilingual character or string, you can input any text | |
34 | ;; from ASCII keyboard. | |
35 | ;; | |
36 | ;; We use words "translation" and "conversion" differently. The | |
37 | ;; former is done by Quail package itself, the latter is the further | |
38 | ;; process of converting a translated text to some more desirable | |
39 | ;; text. For instance, Quail package for Japanese (`quail-jp') | |
40 | ;; translates Roman text (transliteration of Japanese in Latin | |
41 | ;; alphabets) to Hiragana text, which is then converted to | |
42 | ;; Kanji-and-Kana mixed text or Katakana text by commands specified in | |
43 | ;; CONVERSION-KEYS argument of the Quail package. | |
44 | ||
35fffde1 | 45 | ;; [There was an input method for Mule 2.3 called `Tamago' from the |
f6b1b0a8 | 46 | ;; Japanese `TAkusan MAtasete GOmen-nasai', or `Sorry for having you |
35fffde1 DL |
47 | ;; wait so long'; this couldn't be included in Emacs 20. `Tamago' is |
48 | ;; Japanese for `egg' (implicitly a hen's egg). Handa-san made a | |
49 | ;; smaller and simpler system; the smaller quail egg is also eaten in | |
50 | ;; Japan. Maybe others will be egged on to write more sorts of input | |
51 | ;; methods.] | |
52 | ||
4ed46869 KH |
53 | ;;; Code: |
54 | ||
5e94230e | 55 | (require 'help-mode) |
f58e0fd5 | 56 | (eval-when-compile (require 'cl-lib)) |
ec9164f3 | 57 | |
95109387 KH |
58 | (defgroup quail nil |
59 | "Quail: multilingual input method." | |
60 | :group 'leim) | |
4ed46869 KH |
61 | |
62 | ;; Buffer local variables | |
63 | ||
64 | (defvar quail-current-package nil | |
105ef6bf | 65 | "The current Quail package, which depends on the current input method. |
4ed46869 KH |
66 | See the documentation of `quail-package-alist' for the format.") |
67 | (make-variable-buffer-local 'quail-current-package) | |
68 | (put 'quail-current-package 'permanent-local t) | |
69 | ||
17388a62 KH |
70 | ;; Quail uses the following variables to assist users. |
71 | ;; A string containing available key sequences or translation list. | |
72 | (defvar quail-guidance-str nil) | |
4ed46869 KH |
73 | ;; A buffer to show completion list of the current key sequence. |
74 | (defvar quail-completion-buf nil) | |
17388a62 KH |
75 | ;; We may display the guidance string in a buffer on a one-line frame. |
76 | (defvar quail-guidance-buf nil) | |
77 | (defvar quail-guidance-frame nil) | |
4ed46869 | 78 | |
7d842556 | 79 | ;; Each buffer in which Quail is activated should use different |
17388a62 KH |
80 | ;; guidance string. |
81 | (make-variable-buffer-local 'quail-guidance-str) | |
82 | (put 'quail-guidance-str 'permanent-local t) | |
7d842556 | 83 | |
4ed46869 KH |
84 | (defvar quail-overlay nil |
85 | "Overlay which covers the current translation region of Quail.") | |
86 | (make-variable-buffer-local 'quail-overlay) | |
87 | ||
88 | (defvar quail-conv-overlay nil | |
89 | "Overlay which covers the text to be converted in Quail mode.") | |
90 | (make-variable-buffer-local 'quail-conv-overlay) | |
91 | ||
92 | (defvar quail-current-key nil | |
93 | "Current key for translation in Quail mode.") | |
b58fc490 | 94 | (make-variable-buffer-local 'quail-current-key) |
4ed46869 KH |
95 | |
96 | (defvar quail-current-str nil | |
97 | "Currently selected translation of the current key.") | |
b58fc490 | 98 | (make-variable-buffer-local 'quail-current-str) |
4ed46869 KH |
99 | |
100 | (defvar quail-current-translations nil | |
7d842556 KH |
101 | "Cons of indices and vector of possible translations of the current key. |
102 | Indices is a list of (CURRENT START END BLOCK BLOCKS), where | |
103 | CURRENT is an index of the current translation, | |
104 | START and END are indices of the start and end of the current block, | |
105 | BLOCK is the current block index, | |
106 | BLOCKS is a number of blocks of translation.") | |
b58fc490 | 107 | (make-variable-buffer-local 'quail-current-translations) |
4ed46869 | 108 | |
ff913e92 KH |
109 | (defvar quail-current-data nil |
110 | "Any Lisp object holding information of current translation status. | |
111 | When a key sequence is mapped to TRANS and TRANS is a cons | |
cd30a521 | 112 | of actual translation and some Lisp object to be referred |
ff913e92 KH |
113 | for translating the longer key sequence, this variable is set |
114 | to that Lisp object.") | |
7d842556 | 115 | (make-variable-buffer-local 'quail-current-data) |
ff913e92 | 116 | |
4ed46869 KH |
117 | ;; Quail package handlers. |
118 | ||
119 | (defvar quail-package-alist nil | |
120 | "List of Quail packages. | |
121 | A Quail package is a list of these elements: | |
122 | NAME, TITLE, QUAIL-MAP, GUIDANCE, DOCSTRING, TRANSLATION-KEYS, | |
123 | FORGET-LAST-SELECTION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT, | |
124 | DECODE-MAP, MAXIMUM-SHORTEST, OVERLAY-PLIST, UPDATE-TRANSLATION-FUNCTION, | |
b55ba027 | 125 | CONVERSION-KEYS, SIMPLE. |
4ed46869 KH |
126 | |
127 | QUAIL-MAP is a data structure to map key strings to translations. For | |
128 | the format, see the documentation of `quail-map-p'. | |
129 | ||
130 | DECODE-MAP is an alist of translations and corresponding keys. | |
131 | ||
132 | See the documentation of `quail-define-package' for the other elements.") | |
133 | ||
134 | ;; Return various slots in the current quail-package. | |
135 | ||
136 | (defsubst quail-name () | |
137 | "Return the name of the current Quail package." | |
138 | (nth 0 quail-current-package)) | |
94579c02 SM |
139 | |
140 | (defun quail-indent-to (col) | |
141 | (indent-to col) | |
142 | (let ((end (point))) | |
143 | (save-excursion | |
144 | (unless (zerop (skip-chars-backward "\t ")) | |
145 | (put-text-property (point) end 'display (list 'space :align-to col)))))) | |
146 | ||
ace43887 KH |
147 | ;;;###autoload |
148 | (defun quail-title () | |
4ed46869 | 149 | "Return the title of the current Quail package." |
341cd4f0 KH |
150 | (let ((title (nth 1 quail-current-package))) |
151 | ;; TITLE may be a string or a list. If it is a list, each element | |
152 | ;; is a string or the form (VAR STR1 STR2), and the interpretation | |
153 | ;; of the list is the same as that of mode-line-format. | |
154 | (if (stringp title) | |
155 | title | |
156 | (condition-case nil | |
157 | (mapconcat | |
a1506d29 | 158 | (lambda (x) |
341cd4f0 KH |
159 | (cond ((stringp x) x) |
160 | ((and (listp x) (symbolp (car x)) (= (length x) 3)) | |
161 | (if (symbol-value (car x)) | |
162 | (nth 1 x) (nth 2 x))) | |
163 | (t ""))) | |
164 | title "") | |
165 | (error ""))))) | |
4ed46869 KH |
166 | (defsubst quail-map () |
167 | "Return the translation map of the current Quail package." | |
168 | (nth 2 quail-current-package)) | |
169 | (defsubst quail-guidance () | |
170 | "Return an object used for `guidance' feature of the current Quail package. | |
171 | See also the documentation of `quail-define-package'." | |
172 | (nth 3 quail-current-package)) | |
173 | (defsubst quail-docstring () | |
174 | "Return the documentation string of the current Quail package." | |
175 | (nth 4 quail-current-package)) | |
176 | (defsubst quail-translation-keymap () | |
177 | "Return translation keymap in the current Quail package. | |
178 | Translation keymap is a keymap used while translation region is active." | |
179 | (nth 5 quail-current-package)) | |
180 | (defsubst quail-forget-last-selection () | |
181 | "Return `forget-last-selection' flag of the current Quail package. | |
182 | See also the documentation of `quail-define-package'." | |
183 | (nth 6 quail-current-package)) | |
184 | (defsubst quail-deterministic () | |
185 | "Return `deterministic' flag of the current Quail package. | |
186 | See also the documentation of `quail-define-package'." | |
187 | (nth 7 quail-current-package)) | |
188 | (defsubst quail-kbd-translate () | |
189 | "Return `kbd-translate' flag of the current Quail package. | |
190 | See also the documentation of `quail-define-package'." | |
191 | (nth 8 quail-current-package)) | |
192 | (defsubst quail-show-layout () | |
193 | "Return `show-layout' flag of the current Quail package. | |
194 | See also the documentation of `quail-define-package'." | |
195 | (nth 9 quail-current-package)) | |
196 | (defsubst quail-decode-map () | |
197 | "Return decode map of the current Quail package. | |
198 | It is an alist of translations and corresponding keys." | |
199 | (nth 10 quail-current-package)) | |
200 | (defsubst quail-maximum-shortest () | |
201 | "Return `maximum-shortest' flag of the current Quail package. | |
202 | See also the documentation of `quail-define-package'." | |
203 | (nth 11 quail-current-package)) | |
204 | (defsubst quail-overlay-plist () | |
205 | "Return property list of an overly used in the current Quail package." | |
206 | (nth 12 quail-current-package)) | |
207 | (defsubst quail-update-translation-function () | |
208 | "Return a function for updating translation in the current Quail package." | |
209 | (nth 13 quail-current-package)) | |
210 | (defsubst quail-conversion-keymap () | |
211 | "Return conversion keymap in the current Quail package. | |
212 | Conversion keymap is a keymap used while conversion region is active | |
213 | but translation region is not active." | |
214 | (nth 14 quail-current-package)) | |
b55ba027 KH |
215 | (defsubst quail-simple () |
216 | "Return t if the current Quail package is simple." | |
217 | (nth 15 quail-current-package)) | |
4ed46869 KH |
218 | |
219 | (defsubst quail-package (name) | |
220 | "Return Quail package named NAME." | |
221 | (assoc name quail-package-alist)) | |
222 | ||
223 | (defun quail-add-package (package) | |
224 | "Add Quail package PACKAGE to `quail-package-alist'." | |
225 | (let ((pac (quail-package (car package)))) | |
226 | (if pac | |
227 | (setcdr pac (cdr package)) | |
228 | (setq quail-package-alist (cons package quail-package-alist))))) | |
229 | ||
230 | (defun quail-select-package (name) | |
231 | "Select Quail package named NAME as the current Quail package." | |
232 | (let ((package (quail-package name))) | |
233 | (if (null package) | |
234 | (error "No Quail package `%s'" name)) | |
235 | (setq quail-current-package package) | |
236 | (setq-default quail-current-package package) | |
237 | name)) | |
238 | ||
239 | ;;;###autoload | |
240 | (defun quail-use-package (package-name &rest libraries) | |
241 | "Start using Quail package PACKAGE-NAME. | |
2279ba84 | 242 | The remaining arguments are LIBRARIES to be loaded before using the package. |
3573bdbe EZ |
243 | |
244 | This activates input method defined by PACKAGE-NAME by running | |
245 | `quail-activate', which see." | |
ff913e92 KH |
246 | (let ((package (quail-package package-name))) |
247 | (if (null package) | |
248 | ;; Perhaps we have not yet loaded necessary libraries. | |
249 | (while libraries | |
250 | (if (not (load (car libraries) t)) | |
251 | (progn | |
252 | (with-output-to-temp-buffer "*Help*" | |
253 | (princ "Quail package \"") | |
254 | (princ package-name) | |
255 | (princ "\" can't be activated\n because library \"") | |
256 | (princ (car libraries)) | |
257 | (princ "\" is not in `load-path'. | |
4ed46869 KH |
258 | |
259 | The most common case is that you have not yet installed appropriate | |
260 | libraries in LEIM (Libraries of Emacs Input Method) which is | |
261 | distributed separately from Emacs. | |
262 | ||
4ed46869 | 263 | LEIM is available from the same ftp directory as Emacs.")) |
ff913e92 KH |
264 | (error "Can't use the Quail package `%s'" package-name)) |
265 | (setq libraries (cdr libraries)))))) | |
4ed46869 KH |
266 | (quail-select-package package-name) |
267 | (setq current-input-method-title (quail-title)) | |
bcbeff85 KH |
268 | (quail-activate) |
269 | ;; Hide all '... loaded' message. | |
270 | (message nil)) | |
4ed46869 | 271 | |
d91eafdf | 272 | (defvar quail-translation-keymap |
4ed46869 | 273 | (let ((map (make-keymap)) |
d91eafdf KH |
274 | (i 0)) |
275 | (while (< i ?\ ) | |
276 | (define-key map (char-to-string i) 'quail-other-command) | |
277 | (setq i (1+ i))) | |
4ed46869 KH |
278 | (while (< i 127) |
279 | (define-key map (char-to-string i) 'quail-self-insert-command) | |
280 | (setq i (1+ i))) | |
f5c7c0eb | 281 | (setq i 128) |
094550e6 | 282 | (while (< i 256) |
f5c7c0eb KH |
283 | (define-key map (vector i) 'quail-self-insert-command) |
284 | (setq i (1+ i))) | |
4ed46869 | 285 | (define-key map "\177" 'quail-delete-last-char) |
4ed46869 KH |
286 | (define-key map "\C-f" 'quail-next-translation) |
287 | (define-key map "\C-b" 'quail-prev-translation) | |
288 | (define-key map "\C-n" 'quail-next-translation-block) | |
289 | (define-key map "\C-p" 'quail-prev-translation-block) | |
4afb4ca5 KH |
290 | (define-key map [right] 'quail-next-translation) |
291 | (define-key map [left] 'quail-prev-translation) | |
292 | (define-key map [down] 'quail-next-translation-block) | |
293 | (define-key map [up] 'quail-prev-translation-block) | |
4ed46869 KH |
294 | (define-key map "\C-i" 'quail-completion) |
295 | (define-key map "\C-@" 'quail-select-current) | |
5611ce7c KH |
296 | ;; Following simple.el, Enter key on numeric keypad selects the |
297 | ;; current translation just like `C-SPC', and `mouse-2' chooses | |
298 | ;; any completion visible in the *Quail Completions* buffer. | |
299 | (define-key map [kp-enter] 'quail-select-current) | |
300 | (define-key map [mouse-2] 'quail-mouse-choose-completion) | |
301 | (define-key map [down-mouse-2] nil) | |
4ed46869 | 302 | (define-key map "\C-h" 'quail-translation-help) |
e68e61b5 | 303 | (define-key map [?\C- ] 'quail-select-current) |
4ed46869 KH |
304 | (define-key map [tab] 'quail-completion) |
305 | (define-key map [delete] 'quail-delete-last-char) | |
306 | (define-key map [backspace] 'quail-delete-last-char) | |
e3799a72 | 307 | map) |
57a54470 RS |
308 | "Keymap used processing translation in complex Quail modes. |
309 | Only a few especially complex input methods use this map; | |
310 | most use `quail-simple-translation-keymap' instead. | |
311 | This map is activated while translation region is active.") | |
312 | ||
362a8065 KH |
313 | (defvar quail-translation-docstring |
314 | "When you type keys, the echo area shows the possible characters | |
315 | which correspond to that key sequence, each preceded by a digit. You | |
316 | can select one of the characters shown by typing the corresponding | |
317 | digit. Alternatively, you can use C-f and C-b to move through the | |
318 | line to select the character you want, then type a letter to begin | |
319 | entering another Chinese character or type a space or punctuation | |
320 | character. | |
321 | ||
322 | If there are more than ten possible characters for the given spelling, | |
323 | the echo area shows ten characters at a time; you can use C-n to move | |
324 | to the next group of ten, and C-p to move back to the previous group | |
325 | of ten.") | |
326 | ||
327 | ;; Categorize each Quail commands to make the output of quail-help | |
328 | ;; concise. This is done by putting `quail-help' property. The value | |
329 | ;; is: | |
330 | ;; hide -- never show this command | |
331 | ;; non-deterministic -- show only for non-deterministic input method | |
332 | (let ((l '((quail-other-command . hide) | |
333 | (quail-self-insert-command . hide) | |
334 | (quail-delete-last-char . hide) | |
335 | (quail-next-translation . non-deterministic) | |
336 | (quail-prev-translation . non-deterministic) | |
337 | (quail-next-translation-block . non-deterministic) | |
338 | (quail-prev-translation-block . non-deterministic)))) | |
95109387 | 339 | (while l |
362a8065 | 340 | (put (car (car l)) 'quail-help (cdr (car l))) |
95109387 KH |
341 | (setq l (cdr l)))) |
342 | ||
d91eafdf | 343 | (defvar quail-simple-translation-keymap |
57a54470 | 344 | (let ((map (make-keymap)) |
d91eafdf KH |
345 | (i 0)) |
346 | (while (< i ?\ ) | |
347 | (define-key map (char-to-string i) 'quail-other-command) | |
348 | (setq i (1+ i))) | |
57a54470 RS |
349 | (while (< i 127) |
350 | (define-key map (char-to-string i) 'quail-self-insert-command) | |
351 | (setq i (1+ i))) | |
99da6af3 KH |
352 | (setq i 128) |
353 | (while (< i 256) | |
354 | (define-key map (vector i) 'quail-self-insert-command) | |
355 | (setq i (1+ i))) | |
57a54470 | 356 | (define-key map "\177" 'quail-delete-last-char) |
959096f8 RS |
357 | (define-key map [delete] 'quail-delete-last-char) |
358 | (define-key map [backspace] 'quail-delete-last-char) | |
d91eafdf KH |
359 | ;;(let ((meta-map (make-sparse-keymap))) |
360 | ;;(define-key map (char-to-string meta-prefix-char) meta-map) | |
361 | ;;(define-key map [escape] meta-map)) | |
e3799a72 | 362 | map) |
57a54470 | 363 | "Keymap used while processing translation in simple Quail modes. |
348d1438 | 364 | A few especially complex input methods use `quail-translation-keymap' instead. |
4ed46869 KH |
365 | This map is activated while translation region is active.") |
366 | ||
d91eafdf | 367 | (defvar quail-conversion-keymap |
4ed46869 | 368 | (let ((map (make-keymap)) |
b58fc490 | 369 | (i ?\ )) |
4ed46869 | 370 | (while (< i 127) |
b58fc490 | 371 | (define-key map (char-to-string i) 'quail-self-insert-command) |
4ed46869 | 372 | (setq i (1+ i))) |
f5c7c0eb | 373 | (setq i 128) |
094550e6 | 374 | (while (< i 256) |
b58fc490 | 375 | (define-key map (vector i) 'quail-self-insert-command) |
f5c7c0eb | 376 | (setq i (1+ i))) |
4ed46869 KH |
377 | (define-key map "\C-b" 'quail-conversion-backward-char) |
378 | (define-key map "\C-f" 'quail-conversion-forward-char) | |
379 | (define-key map "\C-a" 'quail-conversion-beginning-of-region) | |
380 | (define-key map "\C-e" 'quail-conversion-end-of-region) | |
381 | (define-key map "\C-d" 'quail-conversion-delete-char) | |
b45d8d64 | 382 | (define-key map "\C-k" 'quail-conversion-delete-tail) |
d91eafdf | 383 | (define-key map "\C-h" 'quail-translation-help) |
4ed46869 KH |
384 | (define-key map "\177" 'quail-conversion-backward-delete-char) |
385 | (define-key map [delete] 'quail-conversion-backward-delete-char) | |
386 | (define-key map [backspace] 'quail-conversion-backward-delete-char) | |
e3799a72 | 387 | map) |
4ed46869 | 388 | "Keymap used for processing conversion in Quail mode. |
cd30a521 | 389 | This map is activated while conversion region is active but translation |
4ed46869 KH |
390 | region is not active.") |
391 | ||
95109387 KH |
392 | ;; Just a dummy definition. |
393 | (defun quail-other-command () | |
394 | (interactive) | |
395 | ) | |
396 | ||
ff913e92 | 397 | ;;;###autoload |
4ed46869 KH |
398 | (defun quail-define-package (name language title |
399 | &optional guidance docstring translation-keys | |
400 | forget-last-selection deterministic | |
401 | kbd-translate show-layout create-decode-map | |
402 | maximum-shortest overlay-plist | |
403 | update-translation-function | |
57a54470 | 404 | conversion-keys simple) |
4ed46869 KH |
405 | "Define NAME as a new Quail package for input LANGUAGE. |
406 | TITLE is a string to be displayed at mode-line to indicate this package. | |
d91eafdf | 407 | Optional arguments are GUIDANCE, DOCSTRING, TRANSLATION-KEYS, |
4ed46869 KH |
408 | FORGET-LAST-SELECTION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT, |
409 | CREATE-DECODE-MAP, MAXIMUM-SHORTEST, OVERLAY-PLIST, | |
57a54470 | 410 | UPDATE-TRANSLATION-FUNCTION, CONVERSION-KEYS and SIMPLE. |
4ed46869 KH |
411 | |
412 | GUIDANCE specifies how a guidance string is shown in echo area. | |
413 | If it is t, list of all possible translations for the current key is shown | |
414 | with the currently selected translation being highlighted. | |
415 | If it is an alist, the element has the form (CHAR . STRING). Each character | |
416 | in the current key is searched in the list and the corresponding string is | |
417 | shown. | |
418 | If it is nil, the current key is shown. | |
419 | ||
362a8065 KH |
420 | DOCSTRING is the documentation string of this package. The command |
421 | `describe-input-method' shows this string while replacing the form | |
cd70a6ef KH |
422 | \\=\\<VAR> in the string by the value of VAR. That value should be a |
423 | string. For instance, the form \\=\\<quail-translation-docstring> is | |
362a8065 KH |
424 | replaced by a description about how to select a translation from a |
425 | list of candidates. | |
4ed46869 KH |
426 | |
427 | TRANSLATION-KEYS specifies additional key bindings used while translation | |
428 | region is active. It is an alist of single key character vs. corresponding | |
429 | command to be called. | |
430 | ||
431 | FORGET-LAST-SELECTION non-nil means a selected translation is not kept | |
432 | for the future to translate the same key. If this flag is nil, a | |
433 | translation selected for a key is remembered so that it can be the | |
434 | first candidate when the same key is entered later. | |
435 | ||
436 | DETERMINISTIC non-nil means the first candidate of translation is | |
437 | selected automatically without allowing users to select another | |
438 | translation for a key. In this case, unselected translations are of | |
439 | no use for an interactive use of Quail but can be used by some other | |
440 | programs. If this flag is non-nil, FORGET-LAST-SELECTION is also set | |
441 | to t. | |
442 | ||
443 | KBD-TRANSLATE non-nil means input characters are translated from a | |
444 | user's keyboard layout to the standard keyboard layout. See the | |
445 | documentation of `quail-keyboard-layout' and | |
446 | `quail-keyboard-layout-standard' for more detail. | |
447 | ||
44e76f9d GM |
448 | SHOW-LAYOUT non-nil means the function `quail-help' (as used by |
449 | the command `describe-input-method') should show the user's keyboard | |
450 | layout visually with translated characters. If KBD-TRANSLATE is | |
451 | set, it is desirable to also set this flag, unless this package | |
452 | defines no translations for single character keys. | |
4ed46869 KH |
453 | |
454 | CREATE-DECODE-MAP non-nil means decode map is also created. A decode | |
455 | map is an alist of translations and corresponding original keys. | |
456 | Although this map is not used by Quail itself, it can be used by some | |
457 | other programs. For instance, Vietnamese supporting needs this map to | |
458 | convert Vietnamese text to VIQR format which uses only ASCII | |
459 | characters to represent Vietnamese characters. | |
460 | ||
461 | MAXIMUM-SHORTEST non-nil means break key sequence to get maximum | |
462 | length of the shortest sequence. When we don't have a translation of | |
463 | key \"..ABCD\" but have translations of \"..AB\" and \"CD..\", break | |
464 | the key at \"..AB\" and start translation of \"CD..\". Hangul | |
465 | packages, for instance, use this facility. If this flag is nil, we | |
466 | break the key just at \"..ABC\" and start translation of \"D..\". | |
467 | ||
468 | OVERLAY-PLIST if non-nil is a property list put on an overlay which | |
469 | covers Quail translation region. | |
470 | ||
471 | UPDATE-TRANSLATION-FUNCTION if non-nil is a function to call to update | |
cd30a521 KH |
472 | the current translation region according to a new translation data. By |
473 | default, a translated text or a user's key sequence (if no translation | |
4ed46869 KH |
474 | for it) is inserted. |
475 | ||
476 | CONVERSION-KEYS specifies additional key bindings used while | |
477 | conversion region is active. It is an alist of single key character | |
57a54470 RS |
478 | vs. corresponding command to be called. |
479 | ||
480 | If SIMPLE is non-nil, then we do not alter the meanings of | |
481 | commands such as C-f, C-b, C-n, C-p and TAB; they are treated as | |
482 | non-Quail commands." | |
4ed46869 KH |
483 | (let (translation-keymap conversion-keymap) |
484 | (if deterministic (setq forget-last-selection t)) | |
485 | (if translation-keys | |
20110571 | 486 | (progn |
57a54470 RS |
487 | (setq translation-keymap (copy-keymap |
488 | (if simple quail-simple-translation-keymap | |
489 | quail-translation-keymap))) | |
599430d0 SM |
490 | (dolist (trans translation-keys) |
491 | (define-key translation-keymap (car trans) (cdr trans)))) | |
57a54470 RS |
492 | (setq translation-keymap |
493 | (if simple quail-simple-translation-keymap | |
494 | quail-translation-keymap))) | |
20110571 KH |
495 | (when conversion-keys |
496 | (setq conversion-keymap (copy-keymap quail-conversion-keymap)) | |
599430d0 SM |
497 | (dolist (conv conversion-keys) |
498 | (define-key conversion-keymap (car conv) (cdr conv)))) | |
4ed46869 KH |
499 | (quail-add-package |
500 | (list name title (list nil) guidance (or docstring "") | |
501 | translation-keymap | |
502 | forget-last-selection deterministic kbd-translate show-layout | |
503 | (if create-decode-map (list 'decode-map) nil) | |
504 | maximum-shortest overlay-plist update-translation-function | |
b55ba027 | 505 | conversion-keymap simple)) |
7d842556 KH |
506 | |
507 | ;; Update input-method-alist. | |
508 | (let ((slot (assoc name input-method-alist)) | |
509 | (val (list language 'quail-use-package title docstring))) | |
510 | (if slot (setcdr slot val) | |
511 | (setq input-method-alist (cons (cons name val) input-method-alist))))) | |
512 | ||
4ed46869 KH |
513 | (quail-select-package name)) |
514 | ||
515 | ;; Quail minor mode handlers. | |
516 | ||
517 | ;; Setup overlays used in Quail mode. | |
20110571 | 518 | (defun quail-setup-overlays (conversion-mode) |
4ed46869 KH |
519 | (let ((pos (point))) |
520 | (if (overlayp quail-overlay) | |
521 | (move-overlay quail-overlay pos pos) | |
17388a62 | 522 | (setq quail-overlay (make-overlay pos pos)) |
20110571 KH |
523 | (if input-method-highlight-flag |
524 | (overlay-put quail-overlay 'face 'underline)) | |
4ed46869 KH |
525 | (let ((l (quail-overlay-plist))) |
526 | (while l | |
527 | (overlay-put quail-overlay (car l) (car (cdr l))) | |
528 | (setq l (cdr (cdr l)))))) | |
20110571 KH |
529 | (if conversion-mode |
530 | (if (overlayp quail-conv-overlay) | |
531 | (if (not (overlay-start quail-conv-overlay)) | |
532 | (move-overlay quail-conv-overlay pos pos)) | |
17388a62 | 533 | (setq quail-conv-overlay (make-overlay pos pos)) |
20110571 KH |
534 | (if input-method-highlight-flag |
535 | (overlay-put quail-conv-overlay 'face 'underline)))))) | |
4ed46869 KH |
536 | |
537 | ;; Delete overlays used in Quail mode. | |
538 | (defun quail-delete-overlays () | |
b58fc490 | 539 | (if (and (overlayp quail-overlay) (overlay-start quail-overlay)) |
4ed46869 | 540 | (delete-overlay quail-overlay)) |
b58fc490 | 541 | (if (and (overlayp quail-conv-overlay) (overlay-start quail-conv-overlay)) |
4ed46869 KH |
542 | (delete-overlay quail-conv-overlay))) |
543 | ||
72b255c7 PE |
544 | (defun quail-deactivate () |
545 | "Deactivate Quail input method. | |
3573bdbe | 546 | |
72b255c7 | 547 | This function runs the normal hook `quail-deactivate-hook'." |
b58fc490 KH |
548 | (interactive) |
549 | (quail-activate -1)) | |
550 | ||
2a1e2476 | 551 | (define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.3") |
72b255c7 | 552 | |
b58fc490 KH |
553 | (defun quail-activate (&optional arg) |
554 | "Activate Quail input method. | |
2279ba84 | 555 | With ARG, activate Quail input method if and only if arg is positive. |
b58fc490 | 556 | |
3573bdbe | 557 | This function runs `quail-activate-hook' if it activates the input |
72b255c7 | 558 | method, `quail-deactivate-hook' if it deactivates it. |
3573bdbe | 559 | |
b58fc490 KH |
560 | While this input method is active, the variable |
561 | `input-method-function' is bound to the function `quail-input-method'." | |
562 | (if (and arg | |
563 | (< (prefix-numeric-value arg) 0)) | |
72b255c7 | 564 | ;; Let's deactivate Quail input method. |
b58fc490 KH |
565 | (unwind-protect |
566 | (progn | |
b58fc490 KH |
567 | (quail-delete-overlays) |
568 | (setq describe-current-input-method-function nil) | |
17388a62 KH |
569 | (quail-hide-guidance) |
570 | (remove-hook 'post-command-hook 'quail-show-guidance t) | |
72b255c7 PE |
571 | (run-hooks |
572 | 'quail-inactivate-hook ; for backward compatibility | |
573 | 'quail-deactivate-hook)) | |
b58fc490 | 574 | (kill-local-variable 'input-method-function)) |
f0c968ff | 575 | ;; Let's activate Quail input method. |
4ed46869 KH |
576 | (if (null quail-current-package) |
577 | ;; Quail package is not yet selected. Select one now. | |
578 | (let (name) | |
579 | (if quail-package-alist | |
580 | (setq name (car (car quail-package-alist))) | |
4ed46869 KH |
581 | (error "No Quail package loaded")) |
582 | (quail-select-package name))) | |
72b255c7 | 583 | (setq deactivate-current-input-method-function 'quail-deactivate) |
4ed46869 | 584 | (setq describe-current-input-method-function 'quail-help) |
4ed46869 | 585 | (quail-delete-overlays) |
17388a62 KH |
586 | (setq quail-guidance-str "") |
587 | (quail-show-guidance) | |
05204016 KH |
588 | ;; If we are in minibuffer, turn off the current input method |
589 | ;; before exiting. | |
17388a62 KH |
590 | (when (eq (selected-window) (minibuffer-window)) |
591 | (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer) | |
592 | (add-hook 'post-command-hook 'quail-show-guidance nil t)) | |
b58fc490 KH |
593 | (run-hooks 'quail-activate-hook) |
594 | (make-local-variable 'input-method-function) | |
595 | (setq input-method-function 'quail-input-method))) | |
4ed46869 | 596 | |
72b255c7 PE |
597 | (define-obsolete-variable-alias |
598 | 'quail-inactivate-hook | |
2a1e2476 | 599 | 'quail-deactivate-hook "24.3") |
72b255c7 | 600 | |
4ed46869 | 601 | (defun quail-exit-from-minibuffer () |
72b255c7 | 602 | (deactivate-input-method) |
4ed46869 KH |
603 | (if (<= (minibuffer-depth) 1) |
604 | (remove-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))) | |
605 | ||
4ed46869 KH |
606 | ;; Keyboard layout translation handlers. |
607 | ||
608 | ;; Some Quail packages provide localized keyboard simulation which | |
609 | ;; requires a particular keyboard layout. In this case, what we need | |
610 | ;; is locations of keys the user entered, not character codes | |
611 | ;; generated by those keys. However, for the moment, there's no | |
612 | ;; common way to get such information. So, we ask a user to give | |
613 | ;; information of his own keyboard layout, then translate it to the | |
614 | ;; standard layout which we defined so that all Quail packages depend | |
615 | ;; just on it. | |
616 | ||
617 | (defconst quail-keyboard-layout-standard | |
618 | "\ | |
ea3fb7d2 | 619 | \ |
4ed46869 KH |
620 | 1!2@3#4$5%6^7&8*9(0)-_=+`~ \ |
621 | qQwWeErRtTyYuUiIoOpP[{]} \ | |
622 | aAsSdDfFgGhHjJkKlL;:'\"\\| \ | |
ea3fb7d2 KH |
623 | zZxXcCvVbBnNmM,<.>/? \ |
624 | " | |
4ed46869 KH |
625 | "Standard keyboard layout of printable characters Quail assumes. |
626 | See the documentation of `quail-keyboard-layout' for this format. | |
627 | This layout is almost the same as that of VT100, | |
628 | but the location of key \\ (backslash) is just right of key ' (single-quote), | |
629 | not right of RETURN key.") | |
630 | ||
ea3fb7d2 | 631 | (defconst quail-keyboard-layout-len 180) |
4ed46869 KH |
632 | |
633 | ;; Here we provide several examples of famous keyboard layouts. | |
9a02c067 | 634 | ;; This is a candidate for a language environment-dependent setting. |
4ed46869 KH |
635 | (defvar quail-keyboard-layout-alist |
636 | (list | |
95109387 | 637 | (cons "standard" quail-keyboard-layout-standard) |
4ed46869 | 638 | '("sun-type3" . "\ |
ea3fb7d2 | 639 | \ |
4ed46869 KH |
640 | 1!2@3#4$5%6^7&8*9(0)-_=+\\|`~\ |
641 | qQwWeErRtTyYuUiIoOpP[{]} \ | |
642 | aAsSdDfFgGhHjJkKlL;:'\" \ | |
ea3fb7d2 KH |
643 | zZxXcCvVbBnNmM,<.>/? \ |
644 | ") | |
50b190e4 KH |
645 | '("atari-german" . "\ |
646 | \ | |
647 | 1!2\"3\2474$5%6&7/8(9)0=\337?'`#^ \ | |
648 | qQwWeErRtTzZuUiIoOpP\374\334+* \ | |
649 | aAsSdDfFgGhHjJkKlL\366\326\344\304~| \ | |
650 | <>yYxXcCvVbBnNmM,;.:-_ \ | |
651 | ") | |
99da6af3 KH |
652 | |
653 | '("pc102-de" . "\ | |
654 | \ | |
655 | ^\2601!2\"3\2474$5%6&7/8(9)0=\337?\264`#' \ | |
656 | qQwWeErRtTzZuUiIoOpP\374\334+* \ | |
657 | aAsSdDfFgGhHjJkKlL\366\326\344\304 \ | |
658 | <>yYxXcCvVbBnNmM,;.:-_ \ | |
659 | ") | |
660 | ||
95109387 KH |
661 | '("jp106" . "\ |
662 | \ | |
663 | 1!2\"3#4$5%6&7'8(9)0~-=^~\\| \ | |
664 | qQwWeErRtTyYuUiIoOpP@`[{ \ | |
665 | aAsSdDfFgGhHjJkKlL;+:*]} \ | |
666 | zZxXcCvVbBnNmM,<.>/?\\_ \ | |
667 | ") | |
35fffde1 DL |
668 | '("pc105-uk" . "\ |
669 | \ | |
67442738 | 670 | `\2541!2\"3\2434$5%6^7&8*9(0)-_=+ \ |
35fffde1 DL |
671 | qQwWeErRtTyYuUiIoOpP[{]} \ |
672 | aAsSdDfFgGhHjJkKlL;:'@#~ \ | |
673 | \\|zZxXcCvVbBnNmM,<.>/? \ | |
674 | ") | |
95109387 | 675 | ) |
4ed46869 KH |
676 | "Alist of keyboard names and corresponding layout strings. |
677 | See the documentation of `quail-keyboard-layout' for the format of | |
95109387 KH |
678 | the layout string.") |
679 | ||
2d8a4bbe DL |
680 | (defcustom quail-keyboard-layout quail-keyboard-layout-standard |
681 | "A string which represents physical key layout of a particular keyboard. | |
682 | We assume there are six rows and each row has 15 keys (columns), | |
683 | the first row is above the `1' - `0' row, | |
684 | the first column of the second row is left of key `1', | |
685 | the first column of the third row is left of key `q', | |
686 | the first column of the fourth row is left of key `a', | |
687 | the first column of the fifth row is left of key `z', | |
688 | the sixth row is below the `z' - `/' row. | |
689 | Nth (N is even) and (N+1)th characters in the string are non-shifted | |
690 | and shifted characters respectively at the same location. | |
691 | The location of Nth character is row (N / 30) and column ((N mod 30) / 2). | |
692 | The command `quail-set-keyboard-layout' usually sets this variable." | |
693 | :group 'quail | |
694 | :type `(choice | |
695 | ,@(mapcar (lambda (pair) | |
696 | (list 'const :tag (car pair) (cdr pair))) | |
697 | quail-keyboard-layout-alist) | |
698 | (string :tag "Other"))) | |
699 | ||
95109387 KH |
700 | ;; A non-standard keyboard layout may miss some key locations of the |
701 | ;; standard layout while having additional key locations not in the | |
702 | ;; standard layout. This alist maps those additional key locations to | |
703 | ;; the missing locations. The value is updated automatically by | |
704 | ;; quail-set-keyboard-layout. | |
705 | (defvar quail-keyboard-layout-substitution nil) | |
706 | ||
707 | (defun quail-update-keyboard-layout (kbd-type) | |
708 | (let ((layout (assoc kbd-type quail-keyboard-layout-alist))) | |
709 | (if (null layout) | |
710 | ;; Here, we had better ask a user to define his own keyboard | |
711 | ;; layout interactively. | |
712 | (error "Unknown keyboard type `%s'" kbd-type)) | |
713 | (setq quail-keyboard-layout (cdr layout)) | |
714 | (let ((i quail-keyboard-layout-len) | |
715 | subst-list missing-list) | |
716 | ;; Sum up additional key locations not in the standard layout in | |
717 | ;; subst-list, and missing key locations in missing-list. | |
718 | (while (> i 0) | |
719 | (setq i (1- i)) | |
720 | (if (= (aref quail-keyboard-layout i) ? ) | |
721 | (if (/= (aref quail-keyboard-layout-standard i) ? ) | |
722 | (setq missing-list (cons i missing-list))) | |
723 | (if (= (aref quail-keyboard-layout-standard i) ? ) | |
724 | (setq subst-list (cons (cons i nil) subst-list))))) | |
725 | (setq quail-keyboard-layout-substitution subst-list) | |
726 | ;; If there are additional key locations, map them to missing | |
727 | ;; key locations. | |
599430d0 | 728 | (dolist (missing missing-list) |
95109387 KH |
729 | (while (and subst-list (cdr (car subst-list))) |
730 | (setq subst-list (cdr subst-list))) | |
731 | (if subst-list | |
599430d0 | 732 | (setcdr (car subst-list) missing)))))) |
95109387 KH |
733 | |
734 | (defcustom quail-keyboard-layout-type "standard" | |
735 | "Type of keyboard layout used in Quail base input method. | |
736 | Available types are listed in the variable `quail-keyboard-layout-alist'." | |
737 | :group 'quail | |
35fffde1 DL |
738 | :type (cons 'choice (mapcar (lambda (elt) |
739 | (list 'const (car elt))) | |
740 | quail-keyboard-layout-alist)) | |
95109387 KH |
741 | :set #'(lambda (symbol value) |
742 | (quail-update-keyboard-layout value) | |
743 | (set symbol value))) | |
4ed46869 | 744 | |
44baad62 | 745 | ;;;###autoload |
4ed46869 KH |
746 | (defun quail-set-keyboard-layout (kbd-type) |
747 | "Set the current keyboard layout to the same as keyboard KBD-TYPE. | |
748 | ||
749 | Since some Quail packages depends on a physical layout of keys (not | |
750 | characters generated by them), those are created by assuming the | |
751 | standard layout defined in `quail-keyboard-layout-standard'. This | |
752 | function tells Quail system the layout of your keyboard so that what | |
753 | you type is correctly handled." | |
754 | (interactive | |
91e947ce | 755 | (let* ((completion-ignore-case t) |
4ed46869 KH |
756 | (type (completing-read "Keyboard type: " |
757 | quail-keyboard-layout-alist))) | |
758 | (list type))) | |
95109387 KH |
759 | (quail-update-keyboard-layout kbd-type) |
760 | (setq quail-keyboard-layout-type kbd-type)) | |
4ed46869 | 761 | |
95109387 KH |
762 | (defun quail-keyboard-translate (char) |
763 | "Translate CHAR to the one in the standard keyboard layout." | |
4ed46869 | 764 | (if (eq quail-keyboard-layout quail-keyboard-layout-standard) |
50b190e4 KH |
765 | ;; All Quail packages are designed based on |
766 | ;; `quail-keyboard-layout-standard'. | |
95109387 | 767 | char |
4ed46869 | 768 | (let ((i 0)) |
95109387 | 769 | ;; Find the key location on the current keyboard layout. |
4ed46869 | 770 | (while (and (< i quail-keyboard-layout-len) |
95109387 | 771 | (/= char (aref quail-keyboard-layout i))) |
4ed46869 KH |
772 | (setq i (1+ i))) |
773 | (if (= i quail-keyboard-layout-len) | |
95109387 | 774 | ;; CHAR is not in quail-keyboard-layout, which means that a |
50b190e4 | 775 | ;; user typed a key which generated a character code to be |
95109387 | 776 | ;; handled out of Quail. Just return CHAR and make |
50b190e4 | 777 | ;; quail-execute-non-quail-command handle it correctly. |
95109387 KH |
778 | char |
779 | (let ((ch (aref quail-keyboard-layout-standard i))) | |
780 | (if (= ch ?\ ) | |
781 | ;; This location not available in the standard keyboard | |
782 | ;; layout. Check if the location is used to substitute | |
783 | ;; for the other location of the standard layout. | |
784 | (if (setq i (cdr (assq i quail-keyboard-layout-substitution))) | |
785 | (aref quail-keyboard-layout-standard i) | |
786 | ;; Just return CHAR as well as above. | |
787 | char) | |
788 | ch)))))) | |
789 | ||
8179cccd KH |
790 | (defun quail-keyseq-translate (keyseq) |
791 | (apply 'string | |
792 | (mapcar (function (lambda (x) (quail-keyboard-translate x))) | |
793 | keyseq))) | |
794 | ||
95109387 | 795 | (defun quail-insert-kbd-layout (kbd-layout) |
74ace46a DL |
796 | "Insert the visual keyboard layout table according to KBD-LAYOUT. |
797 | The format of KBD-LAYOUT is the same as `quail-keyboard-layout'." | |
95109387 KH |
798 | (let (done-list layout i ch) |
799 | ;; At first, convert KBD-LAYOUT to the same size vector that | |
800 | ;; contains translated character or string. | |
801 | (setq layout (string-to-vector kbd-layout) | |
802 | i 0) | |
803 | (while (< i quail-keyboard-layout-len) | |
804 | (setq ch (aref kbd-layout i)) | |
805 | (if (quail-kbd-translate) | |
806 | (setq ch (quail-keyboard-translate ch))) | |
807 | (let* ((map (cdr (assq ch (cdr (quail-map))))) | |
808 | (translation (and map (quail-get-translation | |
809 | (car map) (char-to-string ch) 1)))) | |
810 | (if translation | |
811 | (progn | |
812 | (if (consp translation) | |
599430d0 SM |
813 | (setq translation |
814 | (if (> (length (cdr translation)) 0) | |
815 | (aref (cdr translation) 0) | |
816 | " "))) | |
95109387 | 817 | (setq done-list (cons translation done-list))) |
1180f752 | 818 | (setq translation (aref kbd-layout i))) |
95109387 KH |
819 | (aset layout i translation)) |
820 | (setq i (1+ i))) | |
821 | ||
822 | (let ((pos (point)) | |
823 | (bar "|") | |
824 | lower upper row) | |
825 | ;; Make table without horizontal lines. Each column for a key | |
9b053e76 | 826 | ;; has the form "| LU |" where L is for lower key and U is |
95109387 KH |
827 | ;; for a upper key. If width of L (U) is greater than 1, |
828 | ;; preceding (following) space is not inserted. | |
829 | (put-text-property 0 1 'face 'bold bar) | |
830 | (setq i 0) | |
831 | (while (< i quail-keyboard-layout-len) | |
832 | (when (= (% i 30) 0) | |
833 | (setq row (/ i 30)) | |
834 | (if (> row 1) | |
835 | (insert-char 32 (+ row (/ (- row 2) 2))))) | |
836 | (setq lower (aref layout i) | |
837 | upper (aref layout (1+ i))) | |
95109387 | 838 | (insert bar) |
4b05d722 | 839 | (if (< (if (stringp lower) (string-width lower) (char-width lower)) 2) |
95109387 | 840 | (insert " ")) |
a640d29a | 841 | (if (characterp lower) |
599430d0 SM |
842 | (setq lower |
843 | (if (eq (get-char-code-property lower 'general-category) 'Mn) | |
844 | ;; Pad the left and right of non-spacing characters. | |
845 | (compose-string (string lower) 0 1 | |
846 | (format "\t%c\t" lower)) | |
847 | (string lower)))) | |
a640d29a | 848 | (if (characterp upper) |
599430d0 SM |
849 | (setq upper |
850 | (if (eq (get-char-code-property upper 'general-category) 'Mn) | |
851 | ;; Pad the left and right of non-spacing characters. | |
852 | (compose-string (string upper) 0 1 | |
853 | (format "\t%c\t" upper)) | |
854 | (string upper)))) | |
a640d29a KH |
855 | (insert (bidi-string-mark-left-to-right lower) |
856 | (propertize " " 'invisible t) | |
857 | (bidi-string-mark-left-to-right upper)) | |
858 | (if (< (string-width upper) 2) | |
95109387 KH |
859 | (insert " ")) |
860 | (setq i (+ i 2)) | |
861 | (if (= (% i 30) 0) | |
a640d29a | 862 | (insert bar "\n"))) |
95109387 KH |
863 | ;; Insert horizontal lines while deleting blank key columns at the |
864 | ;; beginning and end of each line. | |
865 | (save-restriction | |
866 | (narrow-to-region pos (point)) | |
867 | (goto-char pos) | |
868 | ;;(while (looking-at "[| ]*$") | |
869 | ;;(forward-line 1) | |
870 | ;;(delete-region pos (point))) | |
871 | (let ((from1 100) (to1 0) from2 to2) | |
872 | (while (not (eobp)) | |
4b05d722 | 873 | (if (looking-at "[| \u202c\u202d]*$") |
95109387 KH |
874 | ;; The entire row is blank. |
875 | (delete-region (point) (match-end 0)) | |
876 | ;; Delete blank key columns at the head. | |
4b05d722 | 877 | (if (looking-at "\u202d? *\\(| \\)+") |
95109387 KH |
878 | (subst-char-in-region (point) (match-end 0) ?| ? )) |
879 | ;; Delete blank key columns at the tail. | |
4b05d722 | 880 | (if (re-search-forward "\\( |\\)+\u202c?$" |
6ff6e72f | 881 | (line-end-position) t) |
95109387 KH |
882 | (delete-region (match-beginning 0) (point))) |
883 | (beginning-of-line)) | |
884 | ;; Calculate the start and end columns of a horizontal line. | |
885 | (if (eolp) | |
886 | (setq from2 from1 to2 to1) | |
4b05d722 | 887 | (skip-chars-forward " \u202d") |
95109387 KH |
888 | (setq from2 (current-column)) |
889 | (end-of-line) | |
890 | (setq to2 (current-column)) | |
891 | (if (< from2 from1) | |
892 | (setq from1 from2)) | |
893 | (if (> to2 to1) | |
894 | (setq to1 to2)) | |
895 | (beginning-of-line)) | |
896 | ;; If the previous or the current line has at least one key | |
897 | ;; column, insert a horizontal line. | |
898 | (when (> to1 0) | |
899 | (insert-char 32 from1) | |
900 | (setq pos (point)) | |
901 | (insert "+") | |
902 | (insert-char ?- (- (- to1 from1) 2)) | |
903 | (insert "+") | |
904 | (put-text-property pos (point) 'face 'bold) | |
905 | (insert "\n")) | |
906 | (setq from1 from2 to1 to2) | |
907 | (forward-line 1))) | |
908 | ;; Insert "space bar" box. | |
909 | (forward-line -1) | |
910 | (setq pos (point)) | |
911 | (insert | |
912 | " +-----------------------------+ | |
913 | | space bar | | |
914 | +-----------------------------+ | |
915 | ") | |
916 | (put-text-property pos (point) 'face 'bold) | |
917 | (insert ?\n))) | |
918 | ||
919 | done-list)) | |
920 | ||
921 | ;;;###autoload | |
922 | (defun quail-show-keyboard-layout (&optional keyboard-type) | |
362a8065 KH |
923 | "Show the physical layout of the keyboard type KEYBOARD-TYPE. |
924 | ||
925 | The variable `quail-keyboard-layout-type' holds the currently selected | |
926 | keyboard type." | |
95109387 | 927 | (interactive |
5b76833f | 928 | (list (completing-read "Keyboard type (default current choice): " |
95109387 KH |
929 | quail-keyboard-layout-alist |
930 | nil t))) | |
931 | (or (and keyboard-type (> (length keyboard-type) 0)) | |
932 | (setq keyboard-type quail-keyboard-layout-type)) | |
933 | (let ((layout (assoc keyboard-type quail-keyboard-layout-alist))) | |
934 | (or layout | |
935 | (error "Unknown keyboard type: %s" keyboard-type)) | |
936 | (with-output-to-temp-buffer "*Help*" | |
24790d0c | 937 | (with-current-buffer standard-output |
95109387 KH |
938 | (insert "Keyboard layout (keyboard type: " |
939 | keyboard-type | |
940 | ")\n") | |
941 | (quail-insert-kbd-layout (cdr layout)))))) | |
4ed46869 KH |
942 | |
943 | ;; Quail map | |
944 | ||
945 | (defsubst quail-map-p (object) | |
946 | "Return t if OBJECT is a Quail map. | |
947 | ||
948 | A Quail map holds information how a particular key should be translated. | |
949 | Its format is (TRANSLATION . ALIST). | |
950 | TRANSLATION is either a character, or a cons (INDEX . VECTOR). | |
951 | In the latter case, each element of VECTOR is a candidate for the translation, | |
952 | and INDEX points the currently selected translation. | |
953 | ||
954 | ALIST is normally a list of elements that look like (CHAR . DEFN), | |
955 | where DEFN is another Quail map for a longer key (CHAR added to the | |
956 | current key). It may also be a symbol of a function which returns an | |
957 | alist of the above format. | |
958 | ||
959 | Just after a Quail package is read, TRANSLATION may be a string or a | |
960 | vector. Then each element of the string or vector is a candidate for | |
961 | the translation. These objects are transformed to cons cells in the | |
962 | format \(INDEX . VECTOR), as described above." | |
963 | (and (consp object) | |
964 | (let ((translation (car object))) | |
ff913e92 | 965 | (or (integerp translation) (null translation) |
4ed46869 | 966 | (vectorp translation) (stringp translation) |
ff913e92 KH |
967 | (symbolp translation) |
968 | (and (consp translation) (not (vectorp (cdr translation)))))) | |
4ed46869 | 969 | (let ((alist (cdr object))) |
ff913e92 KH |
970 | (or (and (listp alist) (consp (car alist))) |
971 | (symbolp alist))))) | |
4ed46869 | 972 | |
ff913e92 | 973 | ;;;###autoload |
4ed46869 KH |
974 | (defmacro quail-define-rules (&rest rules) |
975 | "Define translation rules of the current Quail package. | |
976 | Each argument is a list of KEY and TRANSLATION. | |
977 | KEY is a string meaning a sequence of keystrokes to be translated. | |
978 | TRANSLATION is a character, a string, a vector, a Quail map, or a function. | |
9429dee6 | 979 | If it is a character, it is the sole translation of KEY. |
4ed46869 KH |
980 | If it is a string, each character is a candidate for the translation. |
981 | If it is a vector, each element (string or character) is a candidate | |
982 | for the translation. | |
983 | In these cases, a key specific Quail map is generated and assigned to KEY. | |
984 | ||
985 | If TRANSLATION is a Quail map or a function symbol which returns a Quail map, | |
bb63aae5 KH |
986 | it is used to handle KEY. |
987 | ||
988 | The first argument may be an alist of annotations for the following | |
989 | rules. Each element has the form (ANNOTATION . VALUE), where | |
990 | ANNOTATION is a symbol indicating the annotation type. Currently | |
991 | the following annotation types are supported. | |
992 | ||
993 | append -- the value non-nil means that the following rules should | |
994 | be appended to the rules of the current Quail package. | |
995 | ||
996 | face -- the value is a face to use for displaying TRANSLATIONs in | |
997 | candidate list. | |
998 | ||
999 | advice -- the value is a function to call after one of RULES is | |
1000 | selected. The function is called with one argument, the | |
1001 | selected TRANSLATION string, after the TRANSLATION is | |
1002 | inserted. | |
1003 | ||
1004 | no-decode-map --- the value non-nil means that decoding map is not | |
1005 | generated for the following translations." | |
1006 | (let ((l rules) | |
1007 | append no-decode-map props) | |
1008 | ;; If the first argument is an alist of annotations, handle them. | |
1009 | (if (consp (car (car l))) | |
1010 | (let ((annotations (car l))) | |
1011 | (setq append (assq 'append annotations)) | |
1012 | (if append | |
1013 | (setq annotations (delete append annotations) | |
1014 | append (cdr append))) | |
1015 | (setq no-decode-map (assq 'no-decode-map annotations)) | |
1016 | (if no-decode-map | |
1017 | (setq annotations (delete no-decode-map annotations) | |
1018 | no-decode-map (cdr no-decode-map))) | |
94579c02 SM |
1019 | ;; Convert the remaining annotations to property list PROPS. |
1020 | (dolist (annotation annotations) | |
bb63aae5 | 1021 | (setq props |
94579c02 SM |
1022 | (cons (car annotation) |
1023 | (cons (cdr annotation) | |
1024 | props)))) | |
bb63aae5 KH |
1025 | (setq l (cdr l)))) |
1026 | ;; Process the remaining arguments one by one. | |
1027 | (if append | |
1028 | ;; There's no way to add new rules at compiling time. | |
1029 | `(let ((tail ',l) | |
1030 | (map (quail-map)) | |
1031 | (decode-map (and (quail-decode-map) (not ,no-decode-map))) | |
1032 | (properties ',props) | |
1033 | key trans) | |
1034 | (while tail | |
1035 | (setq key (car (car tail)) trans (car (cdr (car tail))) | |
1036 | tail (cdr tail)) | |
1037 | (quail-defrule-internal key trans map t decode-map properties))) | |
1038 | ;; We can build up quail map and decode map at compiling time. | |
1039 | (let ((map (list nil)) | |
1040 | (decode-map (if (not no-decode-map) (list 'decode-map))) | |
1041 | key trans) | |
599430d0 SM |
1042 | (dolist (el l) |
1043 | (setq key (car el) trans (car (cdr el))) | |
bb63aae5 | 1044 | (quail-defrule-internal key trans map t decode-map props)) |
51c4341f SM |
1045 | `(if (prog1 (quail-decode-map) |
1046 | (quail-install-map ',map)) | |
bb63aae5 | 1047 | (quail-install-decode-map ',decode-map)))))) |
4ed46869 | 1048 | |
ff913e92 | 1049 | ;;;###autoload |
817e162f | 1050 | (defun quail-install-map (map &optional name) |
4ed46869 | 1051 | "Install the Quail map MAP in the current Quail package. |
817e162f KH |
1052 | |
1053 | Optional 2nd arg NAME, if non-nil, is a name of Quail package for | |
1054 | which to install MAP. | |
1055 | ||
4ed46869 KH |
1056 | The installed map can be referred by the function `quail-map'." |
1057 | (if (null quail-current-package) | |
1058 | (error "No current Quail package")) | |
1059 | (if (null (quail-map-p map)) | |
1060 | (error "Invalid Quail map `%s'" map)) | |
1061 | (setcar (cdr (cdr quail-current-package)) map)) | |
1062 | ||
bb63aae5 KH |
1063 | ;;;###autoload |
1064 | (defun quail-install-decode-map (decode-map &optional name) | |
1065 | "Install the Quail decode map DECODE-MAP in the current Quail package. | |
1066 | ||
1067 | Optional 2nd arg NAME, if non-nil, is a name of Quail package for | |
1068 | which to install MAP. | |
1069 | ||
1070 | The installed decode map can be referred by the function `quail-decode-map'." | |
1071 | (if (null quail-current-package) | |
1072 | (error "No current Quail package")) | |
4f013856 KH |
1073 | (if (if (consp decode-map) |
1074 | (eq (car decode-map) 'decode-map) | |
1075 | (if (char-table-p decode-map) | |
1076 | (eq (char-table-subtype decode-map) 'quail-decode-map))) | |
1077 | (setcar (nthcdr 10 quail-current-package) decode-map) | |
1078 | (error "Invalid Quail decode map `%s'" decode-map))) | |
1079 | ||
bb63aae5 | 1080 | |
ff913e92 | 1081 | ;;;###autoload |
7b5ebb00 | 1082 | (defun quail-defrule (key translation &optional name append) |
4ed46869 KH |
1083 | "Add one translation rule, KEY to TRANSLATION, in the current Quail package. |
1084 | KEY is a string meaning a sequence of keystrokes to be translated. | |
ff913e92 | 1085 | TRANSLATION is a character, a string, a vector, a Quail map, |
7d842556 | 1086 | a function, or a cons. |
4ed46869 KH |
1087 | It it is a character, it is the sole translation of KEY. |
1088 | If it is a string, each character is a candidate for the translation. | |
1089 | If it is a vector, each element (string or character) is a candidate | |
7d842556 | 1090 | for the translation. |
ff913e92 | 1091 | If it is a cons, the car is one of the above and the cdr is a function |
7d842556 KH |
1092 | to call when translating KEY (the return value is assigned to the |
1093 | variable `quail-current-data'). If the cdr part is not a function, | |
1094 | the value itself is assigned to `quail-current-data'. | |
4ed46869 KH |
1095 | In these cases, a key specific Quail map is generated and assigned to KEY. |
1096 | ||
1097 | If TRANSLATION is a Quail map or a function symbol which returns a Quail map, | |
1098 | it is used to handle KEY. | |
7b5ebb00 KH |
1099 | |
1100 | Optional 3rd argument NAME, if specified, says which Quail package | |
4ed46869 | 1101 | to define this translation rule in. The default is to define it in the |
7b5ebb00 KH |
1102 | current Quail package. |
1103 | ||
1104 | Optional 4th argument APPEND, if non-nil, appends TRANSLATION | |
1105 | to the current translations for KEY instead of replacing them." | |
4ed46869 KH |
1106 | (if name |
1107 | (let ((package (quail-package name))) | |
1108 | (if (null package) | |
1109 | (error "No Quail package `%s'" name)) | |
1110 | (setq quail-current-package package))) | |
7b5ebb00 | 1111 | (quail-defrule-internal key translation (quail-map) append)) |
4ed46869 | 1112 | |
23a01417 SM |
1113 | (defun quail-vunion (v1 v2) |
1114 | (apply 'vector | |
afa13c4a SM |
1115 | ;; No idea why this was here, but it seems to cause the |
1116 | ;; incorrect ordering, according to Nils Anders Danielsson. | |
1117 | ;; (nreverse | |
1118 | (delete-dups (nconc (append v1 ()) (append v2 ()))))) ;; ) | |
23a01417 | 1119 | |
ff913e92 | 1120 | ;;;###autoload |
bb63aae5 KH |
1121 | (defun quail-defrule-internal (key trans map &optional append decode-map props) |
1122 | "Define KEY as TRANS in a Quail map MAP. | |
1123 | ||
1124 | If Optional 4th arg APPEND is non-nil, TRANS is appended to the | |
1125 | current translations for KEY instead of replacing them. | |
1126 | ||
1127 | Optional 5th arg DECODE-MAP is a Quail decode map. | |
1128 | ||
1129 | Optional 6th arg PROPS is a property list annotating TRANS. See the | |
1130 | function `quail-define-rules' for the detail." | |
35f111ba | 1131 | (if (not (or (stringp key) (vectorp key))) |
00baf2eb | 1132 | (error "Invalid Quail key `%s'" key)) |
4ed46869 | 1133 | (if (not (or (numberp trans) (stringp trans) (vectorp trans) |
ff913e92 | 1134 | (consp trans) |
4ed46869 KH |
1135 | (symbolp trans) |
1136 | (quail-map-p trans))) | |
1137 | (error "Invalid Quail translation `%s'" trans)) | |
1138 | (if (null (quail-map-p map)) | |
1139 | (error "Invalid Quail map `%s'" map)) | |
1140 | (let ((len (length key)) | |
1141 | (idx 0) | |
1142 | ch entry) | |
ff913e92 | 1143 | ;; Make a map for registering TRANS if necessary. |
4ed46869 KH |
1144 | (while (< idx len) |
1145 | (if (null (consp map)) | |
1146 | ;; We come here, for example, when we try to define a rule | |
1147 | ;; for "ABC" but a rule for "AB" is already defined as a | |
1148 | ;; symbol. | |
1149 | (error "Quail key %s is too long" key)) | |
1150 | (setq ch (aref key idx) | |
1151 | entry (assq ch (cdr map))) | |
1152 | (if (null entry) | |
1153 | (progn | |
1154 | (setq entry (cons ch (list nil))) | |
1155 | (setcdr map (cons entry (cdr map))))) | |
1156 | (setq map (cdr entry)) | |
1157 | (setq idx (1+ idx))) | |
1158 | (if (symbolp trans) | |
1159 | (if (cdr map) | |
1160 | ;; We come here, for example, when we try to define a rule | |
1161 | ;; for "AB" as a symbol but a rule for "ABC" is already | |
1162 | ;; defined. | |
1163 | (error "Quail key %s is too short" key) | |
1164 | (setcdr entry trans)) | |
1165 | (if (quail-map-p trans) | |
1166 | (if (not (listp (cdr map))) | |
1167 | ;; We come here, for example, when we try to define a rule | |
1168 | ;; for "AB" as a symbol but a rule for "ABC" is already | |
1169 | ;; defined. | |
1170 | (error "Quail key %s is too short" key) | |
1171 | (if (not (listp (cdr trans))) | |
1172 | (if (cdr map) | |
1173 | ;; We come here, for example, when we try to | |
1174 | ;; define a rule for "AB" as a symbol but a rule | |
1175 | ;; for "ABC" is already defined. | |
1176 | (error "Quail key %s is too short" key) | |
1177 | (setcdr entry trans)) | |
1178 | (setcdr entry (append trans (cdr map))))) | |
bb63aae5 KH |
1179 | ;; If PROPS is non-nil or DECODE-MAP is non-nil, convert TRANS |
1180 | ;; to a vector of strings, add PROPS to each string and record | |
1181 | ;; this rule in DECODE-MAP. | |
1182 | (when (and (or props decode-map) | |
1183 | (not (consp trans)) (not (symbolp trans))) | |
1184 | (if (integerp trans) | |
1185 | (setq trans (vector trans)) | |
1186 | (if (stringp trans) | |
1187 | (setq trans (string-to-vector trans)))) | |
1188 | (let ((len (length trans)) | |
1189 | elt) | |
1190 | (while (> len 0) | |
1191 | (setq len (1- len)) | |
1192 | (setq elt (aref trans len)) | |
1193 | (if (integerp elt) | |
1194 | (setq elt (char-to-string elt))) | |
1195 | (aset trans len elt) | |
1196 | (if props | |
1197 | (add-text-properties 0 (length elt) props elt)) | |
1198 | (if decode-map | |
1199 | (setcdr decode-map | |
1200 | (cons (cons elt key) (cdr decode-map))))))) | |
7b5ebb00 | 1201 | (if (and (car map) append) |
23a01417 SM |
1202 | (let* ((prev (quail-get-translation (car map) key len)) |
1203 | (prevchars (if (integerp prev) | |
1204 | (vector prev) | |
1205 | (cdr prev)))) | |
7b5ebb00 KH |
1206 | (if (integerp trans) |
1207 | (setq trans (vector trans)) | |
1208 | (if (stringp trans) | |
1209 | (setq trans (string-to-vector trans)))) | |
23a01417 | 1210 | (let ((new (quail-vunion prevchars trans))) |
599430d0 | 1211 | (setq trans |
23a01417 SM |
1212 | (if (equal new prevchars) |
1213 | ;; Nothing to change, get back to orig value. | |
1214 | prev | |
1215 | (cons (list 0 0 0 0 nil) new)))))) | |
7b5ebb00 | 1216 | (setcar map trans))))) |
4ed46869 | 1217 | |
ff913e92 KH |
1218 | (defun quail-get-translation (def key len) |
1219 | "Return the translation specified as DEF for KEY of length LEN. | |
4ed46869 KH |
1220 | The translation is either a character or a cons of the form (INDEX . VECTOR), |
1221 | where VECTOR is a vector of candidates (character or string) for | |
1222 | the translation, and INDEX points into VECTOR to specify the currently | |
1223 | selected translation." | |
ff913e92 | 1224 | (if (and def (symbolp def)) |
599430d0 SM |
1225 | ;; DEF is a symbol of a function which returns valid translation. |
1226 | (setq def (if (functionp def) (funcall def key len)))) | |
ff913e92 KH |
1227 | (if (and (consp def) (not (vectorp (cdr def)))) |
1228 | (setq def (car def))) | |
1229 | ||
1230 | (cond | |
1231 | ((or (integerp def) (consp def)) | |
1232 | def) | |
1233 | ||
1234 | ((null def) | |
1235 | ;; No translation. | |
1236 | nil) | |
1237 | ||
1238 | ((stringp def) | |
95109387 KH |
1239 | ;; If the length is 1, we don't need vector but a single candidate |
1240 | ;; as the translation. | |
ff913e92 KH |
1241 | (if (= (length def) 1) |
1242 | (aref def 0) | |
95109387 KH |
1243 | ;; Each character in DEF is a candidate of translation. Reform |
1244 | ;; it as (INDICES . VECTOR). | |
1245 | (cons (list 0 0 0 0 nil) (string-to-vector def)))) | |
ff913e92 KH |
1246 | |
1247 | ((vectorp def) | |
95109387 KH |
1248 | ;; If the length is 1, and the length of element string is 1, we |
1249 | ;; don't need vector but a single candidate as the translation. | |
1250 | (if (and (= (length def) 1) | |
1251 | (= (length (aref def 0)) 1)) | |
1252 | (aref (aref def 0) 0) | |
1253 | ;; Each element (string or character) in DEF is a candidate of | |
1254 | ;; translation. Reform it as (INDICES . VECTOR). | |
1255 | (cons (list 0 0 0 0 nil) def))) | |
ff913e92 KH |
1256 | |
1257 | (t | |
1258 | (error "Invalid object in Quail map: %s" def)))) | |
4ed46869 | 1259 | |
5b6156fa | 1260 | (defun quail-lookup-key (key &optional len not-reset-indices) |
4ed46869 KH |
1261 | "Lookup KEY of length LEN in the current Quail map and return the definition. |
1262 | The returned value is a Quail map specific to KEY." | |
7d842556 KH |
1263 | (or len |
1264 | (setq len (length key))) | |
4ed46869 KH |
1265 | (let ((idx 0) |
1266 | (map (quail-map)) | |
1267 | (kbd-translate (quail-kbd-translate)) | |
ff913e92 | 1268 | slot ch translation def) |
4ed46869 KH |
1269 | (while (and map (< idx len)) |
1270 | (setq ch (if kbd-translate (quail-keyboard-translate (aref key idx)) | |
1271 | (aref key idx))) | |
1272 | (setq idx (1+ idx)) | |
1273 | (if (and (cdr map) (symbolp (cdr map))) | |
1274 | (setcdr map (funcall (cdr map) key idx))) | |
1275 | (setq slot (assq ch (cdr map))) | |
1276 | (if (and (cdr slot) (symbolp (cdr slot))) | |
1277 | (setcdr slot (funcall (cdr slot) key idx))) | |
1278 | (setq map (cdr slot))) | |
ff913e92 | 1279 | (setq def (car map)) |
7d842556 | 1280 | (setq quail-current-translations nil) |
ff913e92 | 1281 | (if (and map (setq translation (quail-get-translation def key len))) |
4ed46869 | 1282 | (progn |
ff913e92 KH |
1283 | (if (and (consp def) (not (vectorp (cdr def)))) |
1284 | (progn | |
1285 | (if (not (equal (car def) translation)) | |
1286 | ;; We must reflect TRANSLATION to car part of DEF. | |
1287 | (setcar def translation)) | |
1288 | (setq quail-current-data | |
1289 | (if (functionp (cdr def)) | |
1290 | (funcall (cdr def)) | |
1291 | (cdr def)))) | |
1292 | (if (not (equal def translation)) | |
1293 | ;; We must reflect TRANSLATION to car part of MAP. | |
1294 | (setcar map translation))) | |
74ace46a | 1295 | (if (and (consp translation) (vectorp (cdr translation))) |
4ed46869 KH |
1296 | (progn |
1297 | (setq quail-current-translations translation) | |
5b6156fa | 1298 | (if (and (not not-reset-indices) (quail-forget-last-selection)) |
8024de45 KH |
1299 | (setcar (car quail-current-translations) 0)))))) |
1300 | ;; We may have to reform cdr part of MAP. | |
1301 | (if (and (cdr map) (functionp (cdr map))) | |
1302 | (setcdr map (funcall (cdr map) key len))) | |
4ed46869 KH |
1303 | map)) |
1304 | ||
54bd972f | 1305 | (define-error 'quail-error nil) |
b58fc490 KH |
1306 | (defun quail-error (&rest args) |
1307 | (signal 'quail-error (apply 'format args))) | |
1308 | ||
c5f3770d | 1309 | (defun quail-input-string-to-events (str) |
74ace46a | 1310 | "Convert input string STR to a list of events. |
60a3d85d KH |
1311 | If STR has `advice' text property, append the following special event: |
1312 | \(quail-advice STR)" | |
1313 | (let ((events (mapcar | |
1314 | (lambda (c) | |
9dcb8cd0 EZ |
1315 | (or |
1316 | ;; Avoid "obsolete" warnings for translation-table-for-input. | |
1317 | (with-no-warnings | |
1318 | (and translation-table-for-input | |
1319 | (aref translation-table-for-input c))) | |
1320 | c)) | |
60a3d85d | 1321 | str))) |
c5f3770d KH |
1322 | (if (or (get-text-property 0 'advice str) |
1323 | (next-single-property-change 0 'advice str)) | |
1324 | (setq events | |
1325 | (nconc events (list (list 'quail-advice str))))) | |
1326 | events)) | |
1327 | ||
b58fc490 KH |
1328 | (defvar quail-translating nil) |
1329 | (defvar quail-converting nil) | |
d91eafdf | 1330 | (defvar quail-conversion-str nil) |
b58fc490 KH |
1331 | |
1332 | (defun quail-input-method (key) | |
1333 | (if (or buffer-read-only | |
b45d8d64 KH |
1334 | overriding-terminal-local-map |
1335 | overriding-local-map) | |
b58fc490 KH |
1336 | (list key) |
1337 | (quail-setup-overlays (quail-conversion-keymap)) | |
d91eafdf | 1338 | (let ((modified-p (buffer-modified-p)) |
276bc002 KH |
1339 | (buffer-undo-list t) |
1340 | (inhibit-modification-hooks t)) | |
b58fc490 | 1341 | (unwind-protect |
c5f3770d KH |
1342 | (let ((input-string (if (quail-conversion-keymap) |
1343 | (quail-start-conversion key) | |
1344 | (quail-start-translation key)))) | |
17388a62 | 1345 | (setq quail-guidance-str "") |
c5f3770d KH |
1346 | (when (and (stringp input-string) |
1347 | (> (length input-string) 0)) | |
1348 | (if input-method-exit-on-first-char | |
1349 | (list (aref input-string 0)) | |
1350 | (quail-input-string-to-events input-string)))) | |
b45d8d64 | 1351 | (quail-delete-overlays) |
b58fc490 | 1352 | (set-buffer-modified-p modified-p) |
b45d8d64 KH |
1353 | ;; Run this hook only when the current input method doesn't require |
1354 | ;; conversion. When conversion is required, the conversion function | |
1355 | ;; should run this hook at a proper timing. | |
1356 | (unless (quail-conversion-keymap) | |
1357 | (run-hooks 'input-method-after-insert-chunk-hook)))))) | |
b58fc490 KH |
1358 | |
1359 | (defun quail-overlay-region-events (overlay) | |
1360 | (let ((start (overlay-start overlay)) | |
1361 | (end (overlay-end overlay))) | |
1362 | (if (< start end) | |
1363 | (prog1 | |
1364 | (string-to-list (buffer-substring start end)) | |
1365 | (delete-region start end))))) | |
1366 | ||
d91eafdf KH |
1367 | (defsubst quail-delete-region () |
1368 | "Delete the text in the current translation region of Quail." | |
1369 | (if (overlay-start quail-overlay) | |
1370 | (delete-region (overlay-start quail-overlay) | |
1371 | (overlay-end quail-overlay)))) | |
1372 | ||
b58fc490 | 1373 | (defun quail-start-translation (key) |
c5f3770d KH |
1374 | "Start translation of the typed character KEY by the current Quail package. |
1375 | Return the input string." | |
b58fc490 | 1376 | ;; Check the possibility of translating KEY. |
d91eafdf KH |
1377 | ;; If KEY is nil, we can anyway start translation. |
1378 | (if (or (and (integerp key) | |
1379 | (assq (if (quail-kbd-translate) | |
1380 | (quail-keyboard-translate key) key) | |
1381 | (cdr (quail-map)))) | |
1382 | (null key)) | |
cd30a521 | 1383 | ;; OK, we can start translation. |
d91eafdf KH |
1384 | (let* ((echo-keystrokes 0) |
1385 | (help-char nil) | |
1386 | (overriding-terminal-local-map (quail-translation-keymap)) | |
23a01417 | 1387 | (generated-events nil) ;FIXME: What is this? |
b0fdefb4 | 1388 | (input-method-function nil) |
414ecccc EZ |
1389 | (modified-p (buffer-modified-p)) |
1390 | last-command-event last-command this-command) | |
b58fc490 | 1391 | (setq quail-current-key "" |
d91eafdf KH |
1392 | quail-current-str "" |
1393 | quail-translating t) | |
1394 | (if key | |
1395 | (setq unread-command-events (cons key unread-command-events))) | |
b58fc490 | 1396 | (while quail-translating |
b0fdefb4 | 1397 | (set-buffer-modified-p modified-p) |
17388a62 | 1398 | (quail-show-guidance) |
bc3f38d9 | 1399 | (let* ((prompt (if input-method-use-echo-area |
f6b1b0a8 | 1400 | (format "%s%s %s" |
bc3f38d9 KH |
1401 | (or input-method-previous-message "") |
1402 | quail-current-str | |
1403 | quail-guidance-str))) | |
1404 | (keyseq (read-key-sequence prompt nil nil t)) | |
d91eafdf KH |
1405 | (cmd (lookup-key (quail-translation-keymap) keyseq))) |
1406 | (if (if key | |
1407 | (and (commandp cmd) (not (eq cmd 'quail-other-command))) | |
1408 | (eq cmd 'quail-self-insert-command)) | |
414ecccc EZ |
1409 | (progn |
1410 | (setq last-command-event (aref keyseq (1- (length keyseq))) | |
1411 | last-command this-command | |
1412 | this-command cmd) | |
d91eafdf | 1413 | (setq key t) |
b58fc490 KH |
1414 | (condition-case err |
1415 | (call-interactively cmd) | |
1416 | (quail-error (message "%s" (cdr err)) (beep)))) | |
1417 | ;; KEYSEQ is not defined in the translation keymap. | |
1418 | ;; Let's return the event(s) to the caller. | |
817e162f | 1419 | (setq unread-command-events |
d91eafdf KH |
1420 | (string-to-list (this-single-command-raw-keys))) |
1421 | (setq quail-translating nil)))) | |
1422 | (quail-delete-region) | |
c5f3770d | 1423 | quail-current-str) |
b58fc490 KH |
1424 | |
1425 | ;; Since KEY doesn't start any translation, just return it. | |
8179cccd | 1426 | ;; But translate KEY if necessary. |
c5f3770d | 1427 | (if (quail-kbd-translate) |
195e6740 | 1428 | (setq key (quail-keyboard-translate key))) |
c5f3770d | 1429 | (char-to-string key))) |
b58fc490 KH |
1430 | |
1431 | (defun quail-start-conversion (key) | |
c5f3770d KH |
1432 | "Start conversion of the typed character KEY by the current Quail package. |
1433 | Return the input string." | |
b58fc490 | 1434 | ;; Check the possibility of translating KEY. |
d91eafdf KH |
1435 | ;; If KEY is nil, we can anyway start translation. |
1436 | (if (or (and (integerp key) | |
1437 | (assq (if (quail-kbd-translate) | |
1438 | (quail-keyboard-translate key) key) | |
1439 | (cdr (quail-map)))) | |
1440 | (null key)) | |
b58fc490 | 1441 | ;; Ok, we can start translation and conversion. |
d91eafdf KH |
1442 | (let* ((echo-keystrokes 0) |
1443 | (help-char nil) | |
1444 | (overriding-terminal-local-map (quail-conversion-keymap)) | |
23a01417 | 1445 | (generated-events nil) ;FIXME: What is this? |
b0fdefb4 | 1446 | (input-method-function nil) |
414ecccc EZ |
1447 | (modified-p (buffer-modified-p)) |
1448 | last-command-event last-command this-command) | |
b58fc490 | 1449 | (setq quail-current-key "" |
d91eafdf | 1450 | quail-current-str "" |
b58fc490 | 1451 | quail-translating t |
d91eafdf KH |
1452 | quail-converting t |
1453 | quail-conversion-str "") | |
1454 | (if key | |
1455 | (setq unread-command-events (cons key unread-command-events))) | |
b58fc490 | 1456 | (while quail-converting |
b0fdefb4 | 1457 | (set-buffer-modified-p modified-p) |
b58fc490 KH |
1458 | (or quail-translating |
1459 | (progn | |
1460 | (setq quail-current-key "" | |
d91eafdf | 1461 | quail-current-str "" |
b58fc490 KH |
1462 | quail-translating t) |
1463 | (quail-setup-overlays nil))) | |
17388a62 | 1464 | (quail-show-guidance) |
bc3f38d9 | 1465 | (let* ((prompt (if input-method-use-echo-area |
f6b1b0a8 | 1466 | (format "%s%s%s %s" |
bc3f38d9 KH |
1467 | (or input-method-previous-message "") |
1468 | quail-conversion-str | |
1469 | quail-current-str | |
1470 | quail-guidance-str))) | |
1471 | (keyseq (read-key-sequence prompt nil nil t)) | |
d91eafdf KH |
1472 | (cmd (lookup-key (quail-conversion-keymap) keyseq))) |
1473 | (if (if key (commandp cmd) (eq cmd 'quail-self-insert-command)) | |
414ecccc EZ |
1474 | (progn |
1475 | (setq last-command-event (aref keyseq (1- (length keyseq))) | |
1476 | last-command this-command | |
1477 | this-command cmd) | |
d91eafdf | 1478 | (setq key t) |
b58fc490 KH |
1479 | (condition-case err |
1480 | (call-interactively cmd) | |
d91eafdf KH |
1481 | (quail-error (message "%s" (cdr err)) (beep))) |
1482 | (or quail-translating | |
1483 | (progn | |
1484 | (if quail-current-str | |
1485 | (setq quail-conversion-str | |
1486 | (concat quail-conversion-str | |
1487 | (if (stringp quail-current-str) | |
1488 | quail-current-str | |
1489 | (char-to-string quail-current-str))))) | |
f9f1ed46 KH |
1490 | (if (or input-method-exit-on-first-char |
1491 | (= (length quail-conversion-str) 0)) | |
d91eafdf | 1492 | (setq quail-converting nil))))) |
b58fc490 KH |
1493 | ;; KEYSEQ is not defined in the conversion keymap. |
1494 | ;; Let's return the event(s) to the caller. | |
f9f1ed46 | 1495 | (setq unread-command-events |
d91eafdf KH |
1496 | (string-to-list (this-single-command-raw-keys))) |
1497 | (setq quail-converting nil)))) | |
db8f7303 | 1498 | (setq quail-translating nil) |
348d1438 | 1499 | (if (overlay-start quail-conv-overlay) |
d91eafdf KH |
1500 | (delete-region (overlay-start quail-conv-overlay) |
1501 | (overlay-end quail-conv-overlay))) | |
1502 | (if (> (length quail-conversion-str) 0) | |
c5f3770d | 1503 | quail-conversion-str)) |
b58fc490 KH |
1504 | |
1505 | ;; Since KEY doesn't start any translation, just return it. | |
8179cccd | 1506 | ;; But translate KEY if necessary. |
c5f3770d | 1507 | (if (quail-kbd-translate) |
195e6740 | 1508 | (setq key (quail-keyboard-translate key))) |
c5f3770d | 1509 | (char-to-string key))) |
4ed46869 KH |
1510 | |
1511 | (defun quail-terminate-translation () | |
ce9395a9 | 1512 | "Terminate the translation of the current key." |
b58fc490 | 1513 | (setq quail-translating nil) |
17388a62 | 1514 | (setq quail-guidance-str " ")) |
4ed46869 | 1515 | |
4ed46869 | 1516 | (defun quail-select-current () |
362a8065 | 1517 | "Accept the currently selected translation." |
4ed46869 KH |
1518 | (interactive) |
1519 | (quail-terminate-translation)) | |
1520 | ||
4ed46869 | 1521 | (defun quail-update-translation (control-flag) |
74ace46a DL |
1522 | "Update the current translation status according to CONTROL-FLAG. |
1523 | If CONTROL-FLAG is integer value, it is the number of keys in the | |
1524 | head `quail-current-key' which can be translated. The remaining keys | |
1525 | are put back to `unread-command-events' to be handled again. If | |
1526 | CONTROL-FLAG is t, terminate the translation for the whole keys in | |
1527 | `quail-current-key'. If CONTROL-FLAG is nil, proceed the translation | |
1528 | with more keys." | |
4ed46869 KH |
1529 | (let ((func (quail-update-translation-function))) |
1530 | (if func | |
d91eafdf | 1531 | (setq control-flag (funcall func control-flag)) |
8179cccd KH |
1532 | (cond ((numberp control-flag) |
1533 | (let ((len (length quail-current-key))) | |
1534 | (if (= control-flag 0) | |
1535 | (setq quail-current-str | |
1536 | (if (quail-kbd-translate) | |
1537 | (quail-keyseq-translate quail-current-key) | |
1538 | quail-current-key))) | |
1539 | (or input-method-exit-on-first-char | |
1540 | (while (> len control-flag) | |
1541 | (setq len (1- len)) | |
1542 | (setq unread-command-events | |
1543 | (cons (aref quail-current-key len) | |
1544 | unread-command-events)))))) | |
1545 | ((null control-flag) | |
1546 | (unless quail-current-str | |
1547 | (setq quail-current-str | |
1548 | (if (quail-kbd-translate) | |
1549 | (quail-keyseq-translate quail-current-key) | |
1550 | quail-current-key)) | |
1551 | (if (and input-method-exit-on-first-char | |
1552 | (quail-simple)) | |
1553 | (setq control-flag t))))))) | |
bd21f930 | 1554 | (or input-method-use-echo-area |
17388a62 | 1555 | (let (pos) |
bd21f930 | 1556 | (quail-delete-region) |
17388a62 | 1557 | (setq pos (point)) |
fd7a117d KH |
1558 | (or enable-multibyte-characters |
1559 | (let (char) | |
1560 | (if (stringp quail-current-str) | |
1561 | (catch 'tag | |
1562 | (mapc #'(lambda (ch) | |
1563 | (when (/= (unibyte-char-to-multibyte | |
1564 | (multibyte-char-to-unibyte ch)) | |
1565 | ch) | |
1566 | (setq char ch) | |
1567 | (throw 'tag nil))) | |
1568 | quail-current-str)) | |
1569 | (if (/= (unibyte-char-to-multibyte | |
1570 | (multibyte-char-to-unibyte quail-current-str)) | |
1571 | quail-current-str) | |
1572 | (setq char quail-current-str))) | |
1573 | (when char | |
1574 | (message "Can't input %c in the current unibyte buffer" char) | |
1575 | (ding) | |
1576 | (sit-for 2) | |
1577 | (message nil) | |
1578 | (setq quail-current-str nil) | |
1579 | (throw 'quail-tag nil)))) | |
17388a62 KH |
1580 | (insert quail-current-str) |
1581 | (move-overlay quail-overlay pos (point)) | |
1582 | (if (overlayp quail-conv-overlay) | |
1583 | (if (not (overlay-start quail-conv-overlay)) | |
1584 | (move-overlay quail-conv-overlay pos (point)) | |
1585 | (if (< (overlay-end quail-conv-overlay) (point)) | |
1586 | (move-overlay quail-conv-overlay | |
1587 | (overlay-start quail-conv-overlay) | |
1588 | (point))))))) | |
bd21f930 KH |
1589 | (let (quail-current-str) |
1590 | (quail-update-guidance)) | |
d91eafdf KH |
1591 | (or (stringp quail-current-str) |
1592 | (setq quail-current-str (char-to-string quail-current-str))) | |
05204016 KH |
1593 | (if control-flag |
1594 | (quail-terminate-translation))) | |
4ed46869 KH |
1595 | |
1596 | (defun quail-self-insert-command () | |
f3abc411 | 1597 | "Translate the typed key by the current Quail map, and insert." |
4ed46869 KH |
1598 | (interactive "*") |
1599 | (setq quail-current-key | |
1600 | (concat quail-current-key (char-to-string last-command-event))) | |
d91eafdf KH |
1601 | (or (catch 'quail-tag |
1602 | (quail-update-translation (quail-translate-key)) | |
1603 | t) | |
1604 | ;; If someone throws for `quail-tag' by value nil, we exit from | |
1605 | ;; translation mode. | |
1606 | (setq quail-translating nil))) | |
4ed46869 | 1607 | |
7d842556 | 1608 | (defun quail-map-definition (map) |
74ace46a | 1609 | "Return the actual definition part of Quail map MAP." |
7d842556 KH |
1610 | (let ((def (car map))) |
1611 | (if (and (consp def) (not (vectorp (cdr def)))) | |
1612 | (setq def (car def))) | |
817e162f KH |
1613 | (if (eq def t) |
1614 | (setq def nil)) | |
7d842556 KH |
1615 | def)) |
1616 | ||
7d842556 | 1617 | (defun quail-get-current-str (len def) |
74ace46a DL |
1618 | "Return string to be shown as current translation of key sequence. |
1619 | LEN is the length of the sequence. DEF is a definition part of the | |
1620 | Quail map for the sequence." | |
6b829ee1 KH |
1621 | (or (and (consp def) |
1622 | (if (> (length (cdr def)) (car (car def))) | |
1623 | (aref (cdr def) (car (car def))) | |
1624 | "")) | |
7d842556 KH |
1625 | def |
1626 | (and (> len 1) | |
91a802b0 JL |
1627 | (let* ((str (quail-get-current-str |
1628 | (1- len) | |
1629 | (quail-map-definition (quail-lookup-key | |
1630 | quail-current-key (1- len))))) | |
1631 | (substr1 (substring quail-current-key (1- len) len)) | |
1632 | (str1 (and (quail-deterministic) | |
1633 | (quail-get-current-str | |
1634 | 1 | |
1635 | (quail-map-definition (quail-lookup-key | |
1636 | substr1 1)))))) | |
7d842556 KH |
1637 | (if str |
1638 | (concat (if (stringp str) str (char-to-string str)) | |
91a802b0 JL |
1639 | (if str1 |
1640 | (if (stringp str1) str1 (char-to-string str1)) | |
1641 | substr1))))))) | |
7d842556 KH |
1642 | |
1643 | (defvar quail-guidance-translations-starting-column 20) | |
1644 | ||
7d842556 | 1645 | (defun quail-update-current-translations (&optional relative-index) |
74ace46a DL |
1646 | "Update `quail-current-translations'. |
1647 | Make RELATIVE-INDEX the current translation." | |
7d842556 KH |
1648 | (let* ((indices (car quail-current-translations)) |
1649 | (cur (car indices)) | |
1650 | (start (nth 1 indices)) | |
1651 | (end (nth 2 indices))) | |
1652 | ;; Validate the index number of current translation. | |
1653 | (if (< cur 0) | |
1654 | (setcar indices (setq cur 0)) | |
1655 | (if (>= cur (length (cdr quail-current-translations))) | |
1656 | (setcar indices | |
1657 | (setq cur (1- (length (cdr quail-current-translations))))))) | |
1658 | ||
1659 | (if (or (null end) ; We have not yet calculated END. | |
1660 | (< cur start) ; We moved to the previous block. | |
1661 | (>= cur end)) ; We moved to the next block. | |
1662 | (let ((len (length (cdr quail-current-translations))) | |
17388a62 | 1663 | (maxcol (- (window-width) |
7d842556 KH |
1664 | quail-guidance-translations-starting-column)) |
1665 | (block (nth 3 indices)) | |
23a01417 | 1666 | col idx width trans num-items) |
7d842556 KH |
1667 | (if (< cur start) |
1668 | ;; We must calculate from the head. | |
1669 | (setq start 0 block 0) | |
1670 | (if end ; i.e. (>= cur end) | |
1671 | (setq start end))) | |
1672 | (setq idx start col 0 end start num-items 0) | |
1673 | ;; Loop until we hit the tail, or reach the block of CUR. | |
1674 | (while (and (< idx len) (>= cur end)) | |
1675 | (if (= num-items 0) | |
1676 | (setq start idx col 0 block (1+ block))) | |
1677 | (setq trans (aref (cdr quail-current-translations) idx)) | |
1678 | (setq width (if (integerp trans) (char-width trans) | |
1679 | (string-width trans))) | |
1680 | (setq col (+ col width 3) num-items (1+ num-items)) | |
1681 | (if (and (> num-items 0) | |
1682 | (or (>= col maxcol) (> num-items 10))) | |
1683 | (setq end idx num-items 0) | |
1684 | (setq idx (1+ idx)))) | |
1685 | (setcar (nthcdr 3 indices) block) | |
1686 | (if (>= idx len) | |
1687 | (progn | |
1688 | ;; We hit the tail before reaching MAXCOL. | |
1689 | (setq end idx) | |
1690 | (setcar (nthcdr 4 indices) block))) | |
1691 | (setcar (cdr indices) start) | |
1692 | (setcar (nthcdr 2 indices) end))) | |
1693 | (if relative-index | |
1694 | (if (>= (+ start relative-index) end) | |
95109387 | 1695 | (setcar indices (1- end)) |
7d842556 KH |
1696 | (setcar indices (+ start relative-index)))) |
1697 | (setq quail-current-str | |
d91eafdf KH |
1698 | (aref (cdr quail-current-translations) (car indices))) |
1699 | (or (stringp quail-current-str) | |
1700 | (setq quail-current-str (char-to-string quail-current-str))))) | |
7d842556 | 1701 | |
4ed46869 KH |
1702 | (defun quail-translate-key () |
1703 | "Translate the current key sequence according to the current Quail map. | |
1704 | Return t if we can terminate the translation. | |
1705 | Return nil if the current key sequence may be followed by more keys. | |
1706 | Return number if we can't find any translation for the current key | |
1707 | sequence. The number is the count of valid keys in the current | |
1708 | sequence counting from the head." | |
1709 | (let* ((len (length quail-current-key)) | |
1710 | (map (quail-lookup-key quail-current-key len)) | |
1711 | def ch) | |
1712 | (if map | |
7d842556 KH |
1713 | (let ((def (quail-map-definition map))) |
1714 | (setq quail-current-str (quail-get-current-str len def)) | |
4ed46869 KH |
1715 | ;; Return t only if we can terminate the current translation. |
1716 | (and | |
1717 | ;; No alternative translations. | |
1718 | (or (null (consp def)) (= (length (cdr def)) 1)) | |
1719 | ;; No translation for the longer key. | |
1720 | (null (cdr map)) | |
1721 | ;; No shorter breaking point. | |
1722 | (or (null (quail-maximum-shortest)) | |
1723 | (< len 3) | |
1724 | (null (quail-lookup-key quail-current-key (1- len))) | |
1725 | (null (quail-lookup-key | |
1726 | (substring quail-current-key -2 -1) 1))))) | |
1727 | ||
1728 | ;; There's no translation for the current key sequence. Before | |
1729 | ;; giving up, we must check two possibilities. | |
1730 | (cond ((and | |
1731 | (quail-maximum-shortest) | |
a1233357 | 1732 | (>= len 3) |
7d842556 KH |
1733 | (setq def (quail-map-definition |
1734 | (quail-lookup-key quail-current-key (- len 2)))) | |
4ed46869 KH |
1735 | (quail-lookup-key (substring quail-current-key -2) 2)) |
1736 | ;; Now the sequence is "...ABCD", which can be split into | |
1737 | ;; "...AB" and "CD..." to get valid translation. | |
1738 | ;; At first, get translation of "...AB". | |
7d842556 | 1739 | (setq quail-current-str (quail-get-current-str (- len 2) def)) |
4ed46869 KH |
1740 | ;; Then, return the length of "...AB". |
1741 | (- len 2)) | |
1742 | ||
55e30181 KH |
1743 | ((and (> len 0) |
1744 | (quail-lookup-key (substring quail-current-key 0 -1)) | |
1745 | quail-current-translations | |
4ed46869 KH |
1746 | (not (quail-deterministic)) |
1747 | (setq ch (aref quail-current-key (1- len))) | |
1748 | (>= ch ?0) (<= ch ?9)) | |
1749 | ;; A numeric key is entered to select a desirable translation. | |
1750 | (setq quail-current-key (substring quail-current-key 0 -1)) | |
7d842556 KH |
1751 | ;; We treat key 1,2..,9,0 as specifying 0,1,..8,9. |
1752 | (setq ch (if (= ch ?0) 9 (- ch ?1))) | |
1753 | (quail-update-current-translations ch) | |
4ed46869 KH |
1754 | ;; And, we can terminate the current translation. |
1755 | t) | |
1756 | ||
1f1ce6ab KH |
1757 | ((quail-deterministic) |
1758 | ;; No way to handle the last character in this context. | |
1759 | ;; Commit the longest successfully translated characters, and | |
1760 | ;; handle the remaining characters in a new loop. | |
1761 | (setq def nil) | |
1762 | (while (and (not def) (> len 1)) | |
1763 | (setq len (1- len)) | |
1764 | (setq def (quail-map-definition | |
1765 | (quail-lookup-key quail-current-key len)))) | |
1766 | (if def (setq quail-current-str | |
1767 | (quail-get-current-str len def)) | |
1768 | (setq quail-current-str (aref quail-current-key 0))) | |
1769 | len) | |
1770 | ||
4ed46869 KH |
1771 | (t |
1772 | ;; No way to handle the last character in this context. | |
cbdbef2d KH |
1773 | (setq def (quail-map-definition |
1774 | (quail-lookup-key quail-current-key (1- len)))) | |
53e89326 KH |
1775 | (if def (setq quail-current-str |
1776 | (quail-get-current-str (1- len) def))) | |
4ed46869 KH |
1777 | (1- len)))))) |
1778 | ||
1779 | (defun quail-next-translation () | |
1780 | "Select next translation in the current batch of candidates." | |
1781 | (interactive) | |
1782 | (if quail-current-translations | |
7d842556 KH |
1783 | (let ((indices (car quail-current-translations))) |
1784 | (if (= (1+ (car indices)) (length (cdr quail-current-translations))) | |
5871092a | 1785 | ;; We are already at the tail. |
7d842556 KH |
1786 | (beep) |
1787 | (setcar indices (1+ (car indices))) | |
1788 | (quail-update-current-translations) | |
1789 | (quail-update-translation nil))) | |
b58fc490 KH |
1790 | (setq unread-command-events |
1791 | (cons last-command-event unread-command-events)) | |
1792 | (quail-terminate-translation))) | |
4ed46869 KH |
1793 | |
1794 | (defun quail-prev-translation () | |
1795 | "Select previous translation in the current batch of candidates." | |
1796 | (interactive) | |
1797 | (if quail-current-translations | |
7d842556 KH |
1798 | (let ((indices (car quail-current-translations))) |
1799 | (if (= (car indices) 0) | |
1800 | ;; We are already at the head. | |
1801 | (beep) | |
1802 | (setcar indices (1- (car indices))) | |
1803 | (quail-update-current-translations) | |
1804 | (quail-update-translation nil))) | |
b58fc490 KH |
1805 | (setq unread-command-events |
1806 | (cons last-command-event unread-command-events)) | |
1807 | (quail-terminate-translation))) | |
4ed46869 KH |
1808 | |
1809 | (defun quail-next-translation-block () | |
7d842556 | 1810 | "Select from the next block of translations." |
4ed46869 KH |
1811 | (interactive) |
1812 | (if quail-current-translations | |
7d842556 KH |
1813 | (let* ((indices (car quail-current-translations)) |
1814 | (offset (- (car indices) (nth 1 indices)))) | |
1815 | (if (>= (nth 2 indices) (length (cdr quail-current-translations))) | |
1816 | ;; We are already at the last block. | |
1817 | (beep) | |
1818 | (setcar indices (+ (nth 2 indices) offset)) | |
1819 | (quail-update-current-translations) | |
1820 | (quail-update-translation nil))) | |
b58fc490 | 1821 | (setq unread-command-events |
d91eafdf | 1822 | (cons last-command-event unread-command-events)) |
b58fc490 | 1823 | (quail-terminate-translation))) |
4ed46869 KH |
1824 | |
1825 | (defun quail-prev-translation-block () | |
1826 | "Select the previous batch of 10 translation candidates." | |
1827 | (interactive) | |
7d842556 KH |
1828 | (if quail-current-translations |
1829 | (let* ((indices (car quail-current-translations)) | |
1830 | (offset (- (car indices) (nth 1 indices)))) | |
1831 | (if (= (nth 1 indices) 0) | |
1832 | ;; We are already at the first block. | |
1833 | (beep) | |
1834 | (setcar indices (1- (nth 1 indices))) | |
1835 | (quail-update-current-translations) | |
1836 | (if (< (+ (nth 1 indices) offset) (nth 2 indices)) | |
1837 | (progn | |
1838 | (setcar indices (+ (nth 1 indices) offset)) | |
1839 | (quail-update-current-translations))) | |
1840 | (quail-update-translation nil))) | |
b58fc490 KH |
1841 | (setq unread-command-events |
1842 | (cons last-command-event unread-command-events)) | |
1843 | (quail-terminate-translation))) | |
4ed46869 | 1844 | |
4ed46869 KH |
1845 | (defun quail-abort-translation () |
1846 | "Abort translation and delete the current Quail key sequence." | |
1847 | (interactive) | |
1848 | (quail-delete-region) | |
d91eafdf | 1849 | (setq quail-current-str nil) |
4ed46869 KH |
1850 | (quail-terminate-translation)) |
1851 | ||
1852 | (defun quail-delete-last-char () | |
1853 | "Delete the last input character from the current Quail key sequence." | |
1854 | (interactive) | |
1855 | (if (= (length quail-current-key) 1) | |
1856 | (quail-abort-translation) | |
1857 | (setq quail-current-key (substring quail-current-key 0 -1)) | |
817e162f | 1858 | (quail-delete-region) |
4ed46869 KH |
1859 | (quail-update-translation (quail-translate-key)))) |
1860 | ||
1861 | ;; For conversion mode. | |
1862 | ||
407c6b94 KH |
1863 | (defsubst quail-point-in-conversion-region () |
1864 | "Return non-nil value if the point is in conversion region of Quail mode." | |
1865 | (let (start pos) | |
1866 | (and (setq start (overlay-start quail-conv-overlay)) | |
1867 | (>= (setq pos (point)) start) | |
1868 | (<= pos (overlay-end quail-conv-overlay))))) | |
1869 | ||
4ed46869 KH |
1870 | (defun quail-conversion-backward-char () |
1871 | (interactive) | |
1872 | (if (<= (point) (overlay-start quail-conv-overlay)) | |
b58fc490 KH |
1873 | (quail-error "Beginning of conversion region")) |
1874 | (setq quail-translating nil) | |
4ed46869 KH |
1875 | (forward-char -1)) |
1876 | ||
1877 | (defun quail-conversion-forward-char () | |
1878 | (interactive) | |
1879 | (if (>= (point) (overlay-end quail-conv-overlay)) | |
b58fc490 KH |
1880 | (quail-error "End of conversion region")) |
1881 | (setq quail-translating nil) | |
4ed46869 KH |
1882 | (forward-char 1)) |
1883 | ||
1884 | (defun quail-conversion-beginning-of-region () | |
1885 | (interactive) | |
b45d8d64 | 1886 | (setq quail-translating nil) |
4ed46869 KH |
1887 | (goto-char (overlay-start quail-conv-overlay))) |
1888 | ||
1889 | (defun quail-conversion-end-of-region () | |
1890 | (interactive) | |
b45d8d64 | 1891 | (setq quail-translating nil) |
4ed46869 KH |
1892 | (goto-char (overlay-end quail-conv-overlay))) |
1893 | ||
1894 | (defun quail-conversion-delete-char () | |
1895 | (interactive) | |
b45d8d64 | 1896 | (setq quail-translating nil) |
4ed46869 | 1897 | (if (>= (point) (overlay-end quail-conv-overlay)) |
b58fc490 | 1898 | (quail-error "End of conversion region")) |
4ed46869 | 1899 | (delete-char 1) |
d91eafdf KH |
1900 | (let ((start (overlay-start quail-conv-overlay)) |
1901 | (end (overlay-end quail-conv-overlay))) | |
1902 | (setq quail-conversion-str (buffer-substring start end)) | |
1903 | (if (= start end) | |
1904 | (setq quail-converting nil)))) | |
4ed46869 | 1905 | |
b45d8d64 KH |
1906 | (defun quail-conversion-delete-tail () |
1907 | (interactive) | |
1908 | (if (>= (point) (overlay-end quail-conv-overlay)) | |
1909 | (quail-error "End of conversion region")) | |
1910 | (delete-region (point) (overlay-end quail-conv-overlay)) | |
d91eafdf KH |
1911 | (let ((start (overlay-start quail-conv-overlay)) |
1912 | (end (overlay-end quail-conv-overlay))) | |
1913 | (setq quail-conversion-str (buffer-substring start end)) | |
1914 | (if (= start end) | |
1915 | (setq quail-converting nil)))) | |
b45d8d64 | 1916 | |
4ed46869 KH |
1917 | (defun quail-conversion-backward-delete-char () |
1918 | (interactive) | |
407c6b94 KH |
1919 | (if (> (length quail-current-key) 0) |
1920 | (quail-delete-last-char) | |
1921 | (if (<= (point) (overlay-start quail-conv-overlay)) | |
1922 | (quail-error "Beginning of conversion region")) | |
1923 | (delete-char -1) | |
1924 | (let ((start (overlay-start quail-conv-overlay)) | |
1925 | (end (overlay-end quail-conv-overlay))) | |
1926 | (setq quail-conversion-str (buffer-substring start end)) | |
1927 | (if (= start end) | |
1928 | (setq quail-converting nil))))) | |
4ed46869 KH |
1929 | |
1930 | (defun quail-do-conversion (func &rest args) | |
1931 | "Call FUNC to convert text in the current conversion region of Quail. | |
1932 | Remaining args are for FUNC." | |
1933 | (delete-overlay quail-overlay) | |
1934 | (apply func args)) | |
1935 | ||
1936 | (defun quail-no-conversion () | |
1937 | "Do no conversion of the current conversion region of Quail." | |
1938 | (interactive) | |
b45d8d64 | 1939 | (setq quail-converting nil)) |
4ed46869 KH |
1940 | |
1941 | ;; Guidance, Completion, and Help buffer handlers. | |
1942 | ||
17388a62 KH |
1943 | (defun quail-make-guidance-frame () |
1944 | "Make a new one-line frame for Quail guidance." | |
7d842556 KH |
1945 | (let* ((fparam (frame-parameters)) |
1946 | (top (cdr (assq 'top fparam))) | |
1947 | (border (cdr (assq 'border-width fparam))) | |
1948 | (internal-border (cdr (assq 'internal-border-width fparam))) | |
1949 | (newtop (- top | |
1950 | (frame-char-height) (* internal-border 2) (* border 2)))) | |
1951 | (if (< newtop 0) | |
17388a62 | 1952 | (setq newtop (+ top (frame-pixel-height) internal-border border))) |
f58bd666 SM |
1953 | ;; If I leave the `parent-id' parameter, my frame ends up with 13 lines |
1954 | ;; rather than just 1. Not sure what is really going on, but | |
1955 | ;; clearly this parameter is not needed. --Stef | |
1956 | (setq fparam (delq (assoc 'parent-id fparam) fparam)) | |
17388a62 KH |
1957 | (make-frame (append '((user-position . t) (height . 1) |
1958 | (minibuffer) | |
1959 | (menu-bar-lines . 0) (tool-bar-lines . 0)) | |
1960 | (cons (cons 'top newtop) fparam))))) | |
7d842556 | 1961 | |
05204016 | 1962 | (defun quail-setup-completion-buf () |
74ace46a | 1963 | "Setup Quail completion buffer." |
05204016 | 1964 | (unless (buffer-live-p quail-completion-buf) |
fd02659e SM |
1965 | (let ((mb enable-multibyte-characters)) |
1966 | (setq quail-completion-buf (get-buffer-create "*Quail Completions*")) | |
1967 | (with-current-buffer quail-completion-buf | |
1968 | (set-buffer-multibyte mb) | |
1969 | (setq buffer-read-only t) | |
1970 | (setq quail-overlay (make-overlay (point-min) (point-min))) | |
1971 | (overlay-put quail-overlay 'face 'highlight))))) | |
05204016 | 1972 | |
b55ba027 | 1973 | (defun quail-require-guidance-buf () |
3ecd3a56 | 1974 | "Return t if the current Quail package requires showing guidance buffer." |
b55ba027 | 1975 | (and input-method-verbose-flag |
9a0eac6e KH |
1976 | (if (eq input-method-verbose-flag 'default) |
1977 | (not (and (eq (selected-window) (minibuffer-window)) | |
1978 | (quail-simple))) | |
1979 | (if (eq input-method-verbose-flag 'complex-only) | |
1980 | (not (quail-simple)) | |
1981 | t)))) | |
b55ba027 | 1982 | |
17388a62 KH |
1983 | |
1984 | ;; Quail specific version of minibuffer-message. It displays STRING | |
1985 | ;; with timeout 1000000 seconds instead of two seconds. | |
1986 | ||
1987 | (defun quail-minibuffer-message (string) | |
1988 | (message nil) | |
1989 | (let ((point-max (point-max)) | |
1990 | (inhibit-quit t)) | |
1991 | (save-excursion | |
1992 | (goto-char point-max) | |
1993 | (insert string)) | |
1994 | (sit-for 1000000) | |
1995 | (delete-region point-max (point-max)) | |
1996 | (when quit-flag | |
1997 | (setq quit-flag nil | |
1998 | unread-command-events '(7))))) | |
1999 | ||
2000 | (defun quail-show-guidance () | |
2001 | "Display a guidance for Quail input method in some window. | |
2002 | The guidance is normally displayed at the echo area, | |
2003 | or in a newly created frame (if the current buffer is a | |
2004 | minibuffer and the selected frame has no other windows)." | |
2005 | ;; At first, setup a buffer for completion. | |
05204016 | 2006 | (quail-setup-completion-buf) |
17388a62 KH |
2007 | (bury-buffer quail-completion-buf) |
2008 | ||
2009 | ;; Then, show the guidance. | |
2010 | (when (and (quail-require-guidance-buf) | |
bc3f38d9 | 2011 | (not input-method-use-echo-area) |
17388a62 KH |
2012 | (null unread-command-events) |
2013 | (null unread-post-input-method-events)) | |
2279ba84 | 2014 | (if (minibufferp) |
17388a62 KH |
2015 | (if (eq (minibuffer-window) (frame-root-window)) |
2016 | ;; Use another frame. It is sure that we are using some | |
2017 | ;; window system. | |
2018 | (let ((guidance quail-guidance-str)) | |
2019 | (or (frame-live-p quail-guidance-frame) | |
f58bd666 | 2020 | (setq quail-guidance-frame |
17388a62 KH |
2021 | (quail-make-guidance-frame))) |
2022 | (or (buffer-live-p quail-guidance-buf) | |
2023 | (setq quail-guidance-buf | |
2024 | (get-buffer-create " *Quail-guidance*"))) | |
fd02659e | 2025 | (with-current-buffer quail-guidance-buf |
17388a62 KH |
2026 | (erase-buffer) |
2027 | (setq cursor-type nil) | |
2028 | (insert guidance)) | |
f58bd666 SM |
2029 | (let ((win (frame-root-window quail-guidance-frame))) |
2030 | (set-window-buffer win quail-guidance-buf) | |
2031 | (set-window-dedicated-p win t)) | |
17388a62 KH |
2032 | (quail-minibuffer-message |
2033 | (format " [%s]" current-input-method-title))) | |
c7015153 | 2034 | ;; Show the guidance in the next line of the current |
17388a62 KH |
2035 | ;; minibuffer. |
2036 | (quail-minibuffer-message | |
f58bd666 | 2037 | (format " [%s]\n%s" |
17388a62 KH |
2038 | current-input-method-title quail-guidance-str))) |
2039 | ;; Show the guidance in echo area without logging. | |
2040 | (let ((message-log-max nil)) | |
2041 | (message "%s" quail-guidance-str))))) | |
2042 | ||
2043 | (defun quail-hide-guidance () | |
2044 | "Hide the Quail guidance." | |
2045 | (when (and (quail-require-guidance-buf) | |
2046 | (or (eq (selected-window) (minibuffer-window)) | |
2047 | input-method-use-echo-area) | |
2048 | (eq (minibuffer-window) (frame-root-window))) | |
2049 | ;; We are using another frame for the guidance. | |
2050 | (if (frame-live-p quail-guidance-frame) | |
2051 | (delete-frame quail-guidance-frame)) | |
2052 | (if (buffer-live-p quail-guidance-buf) | |
2053 | (kill-buffer quail-guidance-buf)))) | |
4ed46869 KH |
2054 | |
2055 | (defun quail-update-guidance () | |
2056 | "Update the Quail guidance buffer and completion buffer (if displayed now)." | |
17388a62 KH |
2057 | ;; Update the guidance string. |
2058 | (when (quail-require-guidance-buf) | |
2059 | (let ((guidance (quail-guidance))) | |
2060 | (cond ((or (eq guidance t) | |
2061 | (consp guidance)) | |
2062 | ;; Show the current possible translations. | |
2063 | (setq quail-guidance-str | |
2064 | (quail-get-translations))) | |
2065 | ((null guidance) | |
2066 | ;; Show the current input keys. | |
2067 | (let ((key quail-current-key)) | |
2068 | (if (quail-kbd-translate) | |
2069 | (setq key (quail-keyseq-translate key))) | |
2070 | (setq quail-guidance-str (if (stringp key) key (string key))))) | |
2071 | (t | |
2072 | (setq quail-guidance-str " "))))) | |
4ed46869 KH |
2073 | |
2074 | ;; Update completion buffer if displayed now. We highlight the | |
2075 | ;; selected candidate string in *Completion* buffer if any. | |
2076 | (let ((win (get-buffer-window quail-completion-buf)) | |
2077 | key str pos) | |
2078 | (if win | |
2079 | (save-excursion | |
2080 | (setq str (if (stringp quail-current-str) | |
2081 | quail-current-str | |
2082 | (if (numberp quail-current-str) | |
2083 | (char-to-string quail-current-str))) | |
2084 | key quail-current-key) | |
2085 | (set-buffer quail-completion-buf) | |
2086 | (goto-char (point-min)) | |
2087 | (if (null (search-forward (concat " " key ":") nil t)) | |
2088 | (delete-overlay quail-overlay) | |
2089 | (setq pos (point)) | |
2090 | (if (and str (search-forward (concat "." str) nil t)) | |
17388a62 KH |
2091 | (move-overlay quail-overlay (1+ (match-beginning 0)) (point)) |
2092 | (move-overlay quail-overlay (match-beginning 0) (point))) | |
4ed46869 KH |
2093 | ;; Now POS points end of KEY and (point) points end of STR. |
2094 | (if (pos-visible-in-window-p (point) win) | |
2095 | ;; STR is already visible. | |
2096 | nil | |
2097 | ;; We want to make both KEY and STR visible, but if the | |
2098 | ;; window is too short, make at least STR visible. | |
2099 | (setq pos (progn (point) (goto-char pos))) | |
2100 | (beginning-of-line) | |
2101 | (set-window-start win (point)) | |
2102 | (if (not (pos-visible-in-window-p pos win)) | |
2103 | (set-window-start win pos)) | |
2104 | )))))) | |
2105 | ||
17388a62 KH |
2106 | (defun quail-get-translations () |
2107 | "Return a string containing the current possible translations." | |
6af33222 KH |
2108 | (or (multibyte-string-p quail-current-key) |
2109 | (setq quail-current-key (string-to-multibyte quail-current-key))) | |
5b6156fa | 2110 | (let ((map (quail-lookup-key quail-current-key nil t)) |
17388a62 | 2111 | (str (copy-sequence quail-current-key))) |
7d842556 KH |
2112 | (if quail-current-translations |
2113 | (quail-update-current-translations)) | |
4ed46869 | 2114 | |
17388a62 KH |
2115 | ;; Show the current key. |
2116 | (let ((guidance (quail-guidance))) | |
2117 | (if (listp guidance) | |
6af33222 | 2118 | ;; We must replace the typed key with the specified PROMPT-KEY. |
17388a62 KH |
2119 | (dotimes (i (length str)) |
2120 | (let ((prompt-key (cdr (assoc (aref str i) guidance)))) | |
2121 | (if prompt-key | |
2122 | (aset str i (aref prompt-key 0))))))) | |
4ed46869 | 2123 | |
17388a62 KH |
2124 | ;; Show followable keys. |
2125 | (if (and (> (length quail-current-key) 0) (cdr map)) | |
2126 | (setq str | |
2127 | (format "%s[%s]" | |
2128 | str | |
2129 | (concat (sort (mapcar (function (lambda (x) (car x))) | |
2130 | (cdr map)) | |
2131 | '<))))) | |
4ed46869 | 2132 | ;; Show list of translations. |
17388a62 | 2133 | (if (and quail-current-translations |
817e162f | 2134 | (not (quail-deterministic))) |
17388a62 | 2135 | (let* ((indices (car quail-current-translations)) |
7d842556 KH |
2136 | (cur (car indices)) |
2137 | (start (nth 1 indices)) | |
2138 | (end (nth 2 indices)) | |
2139 | (idx start)) | |
17388a62 KH |
2140 | (if (< (string-width str) |
2141 | (- quail-guidance-translations-starting-column 7)) | |
2142 | (setq str | |
2143 | (concat str | |
2144 | (make-string | |
2145 | (- quail-guidance-translations-starting-column | |
2146 | 7 (string-width str)) | |
2147 | 32)))) | |
f6b1b0a8 | 2148 | (setq str (format "%s(%02d/%s)" |
17388a62 KH |
2149 | str (nth 3 indices) |
2150 | (if (nth 4 indices) | |
2151 | (format "%02d" (nth 4 indices)) | |
2152 | "??"))) | |
7d842556 | 2153 | (while (< idx end) |
17388a62 KH |
2154 | (let ((len (length str)) |
2155 | (trans (aref (cdr quail-current-translations) idx))) | |
2156 | (or (stringp trans) | |
2157 | (setq trans (string trans))) | |
f6b1b0a8 | 2158 | (setq str (format "%s %d.%s" |
17388a62 KH |
2159 | str |
2160 | (if (= (- idx start) 9) 0 | |
2161 | (1+ (- idx start))) | |
2162 | trans)) | |
7d842556 | 2163 | (if (= idx cur) |
17388a62 KH |
2164 | (put-text-property (+ len 3) (length str) |
2165 | 'face 'highlight str)) | |
2166 | (setq idx (1+ idx)))))) | |
2167 | ||
2168 | str)) | |
4ed46869 | 2169 | |
817e162f KH |
2170 | (defvar quail-completion-max-depth 5 |
2171 | "The maximum depth of Quail completion list.") | |
2172 | ||
4ed46869 KH |
2173 | (defun quail-completion () |
2174 | "List all completions for the current key. | |
2175 | All possible translations of the current key and whole possible longer keys | |
817e162f | 2176 | are shown (at most to the depth specified `quail-completion-max-depth')." |
4ed46869 | 2177 | (interactive) |
05204016 | 2178 | (quail-setup-completion-buf) |
0548a7fd KH |
2179 | (let ((win (get-buffer-window quail-completion-buf 'visible)) |
2180 | (key quail-current-key) | |
5b6156fa | 2181 | (map (quail-lookup-key quail-current-key nil t)) |
0548a7fd | 2182 | (require-update nil)) |
24790d0c | 2183 | (with-current-buffer quail-completion-buf |
0548a7fd KH |
2184 | (if (and win |
2185 | (equal key quail-current-key) | |
2186 | (eq last-command 'quail-completion)) | |
2187 | ;; The window for Quail completion buffer has already been | |
2188 | ;; shown. We just scroll it appropriately. | |
2189 | (if (pos-visible-in-window-p (point-max) win) | |
2190 | (set-window-start win (point-min)) | |
d5ec6a2d KH |
2191 | (let ((other-window-scroll-buffer quail-completion-buf) |
2192 | ;; This nil binding is necessary to surely scroll | |
2193 | ;; quail-completion-buf. | |
2194 | (minibuffer-scroll-window nil)) | |
0548a7fd KH |
2195 | (scroll-other-window))) |
2196 | (setq quail-current-key key) | |
6f246553 KH |
2197 | (let ((inhibit-read-only t)) |
2198 | (erase-buffer) | |
2199 | (insert "Possible completion and corresponding characters are:\n") | |
2200 | (quail-completion-1 key map 1) | |
2201 | (set-buffer-modified-p nil)) | |
0548a7fd KH |
2202 | (goto-char (point-min)) |
2203 | (display-buffer (current-buffer)) | |
2204 | (setq require-update t))) | |
2205 | (if require-update | |
2206 | (quail-update-guidance))) | |
2207 | (setq this-command 'quail-completion)) | |
4ed46869 | 2208 | |
4ed46869 | 2209 | (defun quail-completion-1 (key map indent) |
51c4341f | 2210 | "List all completions of KEY in MAP with indentation INDENT." |
4ed46869 | 2211 | (let ((len (length key))) |
94579c02 | 2212 | (quail-indent-to indent) |
4ed46869 KH |
2213 | (insert key ":") |
2214 | (if (and (symbolp map) (fboundp map)) | |
2215 | (setq map (funcall map key len))) | |
2216 | (if (car map) | |
2217 | (quail-completion-list-translations map key (+ indent len 1)) | |
2218 | (insert " -\n")) | |
2219 | (setq indent (+ indent 2)) | |
817e162f | 2220 | (if (and (cdr map) (< (/ (1- indent) 2) quail-completion-max-depth)) |
51c4341f | 2221 | (let ((l (cdr map))) |
817e162f KH |
2222 | (if (functionp l) |
2223 | (setq l (funcall l))) | |
51c4341f SM |
2224 | (dolist (elt (reverse l)) ; L = ((CHAR . DEFN) ....) ; |
2225 | (quail-completion-1 (concat key (string (car elt))) | |
2226 | (cdr elt) indent)))))) | |
4ed46869 | 2227 | |
4ed46869 | 2228 | (defun quail-completion-list-translations (map key indent) |
74ace46a | 2229 | "List all possible translations of KEY in Quail MAP with indentation INDENT." |
5611ce7c | 2230 | (let (beg (translations |
ff913e92 | 2231 | (quail-get-translation (car map) key (length key)))) |
4ed46869 | 2232 | (if (integerp translations) |
5611ce7c KH |
2233 | (progn |
2234 | (insert "(1/1) 1.") | |
2235 | ;; Endow the character `translations' with `mouse-face' text | |
2236 | ;; property to enable `mouse-2' completion. | |
2237 | (setq beg (point)) | |
2238 | (insert translations) | |
2239 | (put-text-property beg (point) 'mouse-face 'highlight) | |
2240 | (insert "\n")) | |
4ed46869 KH |
2241 | ;; We need only vector part. |
2242 | (setq translations (cdr translations)) | |
2243 | ;; Insert every 10 elements with indices in a line. | |
2244 | (let ((len (length translations)) | |
23a01417 | 2245 | (i 0)) |
4ed46869 | 2246 | (while (< i len) |
8c14aa22 RS |
2247 | (when (zerop (% i 10)) |
2248 | (when (>= i 10) | |
5611ce7c | 2249 | (insert "\n") |
94579c02 | 2250 | (quail-indent-to indent)) |
8c14aa22 | 2251 | (insert (format "(%d/%d)" (1+ (/ i 10)) (1+ (/ len 10))))) |
4ed46869 KH |
2252 | ;; We show the last digit of FROM while converting |
2253 | ;; 0,1,..,9 to 1,2,..,0. | |
8c14aa22 | 2254 | (insert (format " %d." (% (1+ i) 10))) |
5611ce7c | 2255 | (setq beg (point)) |
4ed46869 | 2256 | (insert (aref translations i)) |
5611ce7c KH |
2257 | ;; Passing the mouse over a character will highlight. |
2258 | (put-text-property beg (point) 'mouse-face 'highlight) | |
4ed46869 | 2259 | (setq i (1+ i))) |
5611ce7c KH |
2260 | (insert "\n"))))) |
2261 | ||
5611ce7c KH |
2262 | (defun quail-mouse-choose-completion (event) |
2263 | "Click on an alternative in the `*Quail Completions*' buffer to choose it." | |
5611ce7c | 2264 | ;; This function is an exact copy of the mouse.el function |
74ace46a | 2265 | ;; `mouse-choose-completion' except that we: |
35fffde1 | 2266 | ;; 2) don't bury *Quail Completions* buffer, so comment a section, and |
5611ce7c | 2267 | ;; 3) delete/terminate the current quail selection here. |
d5e63715 SM |
2268 | ;; FIXME: Consolidate with `choose-completion'. The point number |
2269 | ;; 1 has been done, already. The point number 3 should be fairly | |
2270 | ;; easy to move to a choose-completion-string-function. So all | |
2271 | ;; that's left is point number 2. | |
2272 | (interactive "e") | |
5611ce7c KH |
2273 | ;; Give temporary modes such as isearch a chance to turn off. |
2274 | (run-hooks 'mouse-leave-buffer-hook) | |
2275 | (let ((buffer (window-buffer)) | |
2403c841 | 2276 | choice) |
24790d0c | 2277 | (with-current-buffer (window-buffer (posn-window (event-start event))) |
5611ce7c KH |
2278 | (if completion-reference-buffer |
2279 | (setq buffer completion-reference-buffer)) | |
5611ce7c KH |
2280 | (save-excursion |
2281 | (goto-char (posn-point (event-start event))) | |
2282 | (let (beg end) | |
2283 | (if (and (not (eobp)) (get-text-property (point) 'mouse-face)) | |
2284 | (setq end (point) beg (1+ (point)))) | |
2285 | (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) | |
2286 | (setq end (1- (point)) beg (point))) | |
2287 | (if (null beg) | |
b58fc490 | 2288 | (quail-error "No completion here")) |
5611ce7c KH |
2289 | (setq beg (previous-single-property-change beg 'mouse-face)) |
2290 | (setq end (or (next-single-property-change end 'mouse-face) | |
2291 | (point-max))) | |
2292 | (setq choice (buffer-substring beg end))))) | |
2403c841 SM |
2293 | ;; (let ((owindow (selected-window))) |
2294 | ;; (select-window (posn-window (event-start event))) | |
2295 | ;; (if (and (one-window-p t 'selected-frame) | |
2296 | ;; (window-dedicated-p (selected-window))) | |
2297 | ;; ;; This is a special buffer's frame | |
2298 | ;; (iconify-frame (selected-frame)) | |
2299 | ;; (or (window-dedicated-p (selected-window)) | |
2300 | ;; (bury-buffer))) | |
2301 | ;; (select-window owindow)) | |
5611ce7c | 2302 | (quail-delete-region) |
2403c841 SM |
2303 | (setq quail-current-str choice) |
2304 | ;; FIXME: We need to pass `base-position' here. | |
2305 | ;; FIXME: why do we need choose-completion-string with all its | |
2306 | ;; completion-specific logic? | |
2307 | (choose-completion-string choice buffer) | |
5611ce7c KH |
2308 | (quail-terminate-translation))) |
2309 | ||
362a8065 KH |
2310 | (defun quail-build-decode-map (map-list key decode-map num |
2311 | &optional maxnum ignores) | |
74ace46a DL |
2312 | "Build a decoding map. |
2313 | Accumulate in the cdr part of DECODE-MAP all pairs of key sequences | |
2314 | vs the corresponding translations defined in the Quail map | |
2315 | specified by the first element MAP-LIST. Each pair has the form | |
2316 | \(KEYSEQ . TRANSLATION). DECODE-MAP should have the form | |
2317 | \(decode-map . ALIST), where ALIST is an alist of length NUM. KEY | |
2318 | is a key sequence to reach MAP. | |
2319 | Optional 5th arg MAXNUM limits the number of accumulated pairs. | |
2320 | Optional 6th arg IGNORES is a list of translations to ignore." | |
362a8065 KH |
2321 | (let* ((map (car map-list)) |
2322 | (translation (quail-get-translation (car map) key (length key))) | |
2323 | elt) | |
95109387 | 2324 | (cond ((integerp translation) |
362a8065 | 2325 | ;; Accept only non-ASCII chars not listed in IGNORES. |
94579c02 | 2326 | (when (and (> translation 127) (not (memq translation ignores))) |
95109387 KH |
2327 | (setcdr decode-map |
2328 | (cons (cons key translation) (cdr decode-map))) | |
2329 | (setq num (1+ num)))) | |
2330 | ((consp translation) | |
2331 | (setq translation (cdr translation)) | |
2332 | (let ((multibyte nil)) | |
2333 | (mapc (function (lambda (x) | |
362a8065 KH |
2334 | ;; Accept only non-ASCII chars not |
2335 | ;; listed in IGNORES. | |
94579c02 | 2336 | (if (and (if (integerp x) (> x 127) |
85261854 | 2337 | (string-match-p "[^[:ascii:]]" x)) |
95109387 KH |
2338 | (not (member x ignores))) |
2339 | (setq multibyte t)))) | |
2340 | translation) | |
2341 | (when multibyte | |
2342 | (setcdr decode-map | |
2343 | (cons (cons key translation) (cdr decode-map))) | |
2344 | (setq num (+ num (length translation))))))) | |
2345 | (if (and maxnum (> num maxnum)) | |
2346 | (- num) | |
2347 | (setq map (cdr map)) | |
362a8065 | 2348 | ;; Recursively check the deeper map. |
95109387 KH |
2349 | (while (and map (>= num 0)) |
2350 | (setq elt (car map) map (cdr map)) | |
362a8065 KH |
2351 | (when (and (integerp (car elt)) (consp (cdr elt)) |
2352 | (not (memq (cdr elt) map-list))) | |
2353 | (setq num (quail-build-decode-map (cons (cdr elt) map-list) | |
95109387 KH |
2354 | (format "%s%c" key (car elt)) |
2355 | decode-map num maxnum ignores)))) | |
2356 | num))) | |
2357 | ||
2358 | (defun quail-insert-decode-map (decode-map) | |
74ace46a DL |
2359 | "Insert pairs of key sequences vs the corresponding translations. |
2360 | These are stored in DECODE-MAP using the concise format. DECODE-MAP | |
2361 | should be made by `quail-build-decode-map' (which see)." | |
95109387 KH |
2362 | (setq decode-map |
2363 | (sort (cdr decode-map) | |
2364 | (function (lambda (x y) | |
2365 | (setq x (car x) y (car y)) | |
2366 | (or (> (length x) (length y)) | |
2367 | (and (= (length x) (length y)) | |
2368 | (not (string< x y)))))))) | |
6b61353c KH |
2369 | (let ((window-width (window-width (get-buffer-window |
2370 | (current-buffer) 'visible))) | |
362a8065 | 2371 | (single-trans-width 4) |
362a8065 KH |
2372 | (single-list nil) |
2373 | (multiple-list nil) | |
23a01417 | 2374 | trans) |
362a8065 | 2375 | ;; Divide the elements of decoding map into single ones (i.e. the |
23a01417 | 2376 | ;; one that has single translation) and multiple ones (i.e. the |
362a8065 | 2377 | ;; one that has multiple translations). |
23a01417 SM |
2378 | (dolist (elt decode-map) |
2379 | (setq trans (cdr elt)) | |
95109387 KH |
2380 | (if (and (vectorp trans) (= (length trans) 1)) |
2381 | (setq trans (aref trans 0))) | |
2382 | (if (vectorp trans) | |
23a01417 SM |
2383 | (push elt multiple-list) |
2384 | (push (cons (car elt) trans) single-list) | |
2385 | (let ((width (if (stringp trans) (string-width trans) | |
2386 | (char-width trans)))) | |
2387 | (if (> width single-trans-width) | |
2388 | (setq single-trans-width width))))) | |
362a8065 | 2389 | (when single-list |
51c4341f SM |
2390 | ;; Figure out how many columns can fit. |
2391 | (let* ((len (length single-list)) | |
2392 | ;; The longest key is at the end, by virtue of the above `sort'. | |
2393 | (max-key-width (max 3 (length (caar (last single-list))))) | |
2394 | ;; Starting point: worst case. | |
23a01417 SM |
2395 | (col-width (+ max-key-width 1 single-trans-width 1)) |
2396 | (cols (/ window-width col-width)) | |
51c4341f SM |
2397 | rows) |
2398 | ;; Now, let's see if we can pack in a few more columns since | |
2399 | ;; the first columns can often be made narrower thanks to the | |
2400 | ;; length-sorting. | |
2401 | (while (let ((newrows (/ (+ len cols) (1+ cols))) ;Round up. | |
2402 | (width 0)) | |
2403 | (dotimes (col (1+ cols)) | |
2404 | (let ((last-col-elt (or (nth (1- (* (1+ col) newrows)) | |
2405 | single-list) | |
2406 | (car (last single-list))))) | |
f58e0fd5 SM |
2407 | (cl-incf width (+ (max 3 (length (car last-col-elt))) |
2408 | 1 single-trans-width 1)))) | |
51c4341f | 2409 | (< width window-width)) |
f58e0fd5 | 2410 | (cl-incf cols)) |
51c4341f SM |
2411 | (setq rows (/ (+ len cols -1) cols)) ;Round up. |
2412 | (let ((key-width (max 3 (length (car (nth (1- rows) single-list)))))) | |
2413 | (insert "key") | |
2414 | (quail-indent-to (1+ key-width)) | |
2415 | (insert "char") | |
2416 | (quail-indent-to (+ 1 key-width 1 single-trans-width 1))) | |
23a01417 | 2417 | (insert "[type a key sequence to insert the corresponding character]\n") |
51c4341f SM |
2418 | (let ((pos (point)) |
2419 | (col 0)) | |
2420 | (insert-char ?\n (+ rows 2)) | |
2421 | (while single-list | |
23a01417 | 2422 | (goto-char pos) |
51c4341f SM |
2423 | (let* ((key-width (max 3 (length |
2424 | (car (or (nth (1- rows) single-list) | |
2425 | (car (last single-list))))))) | |
2426 | (col-width (+ key-width 1 single-trans-width 1))) | |
2427 | ;; Insert the header-line. | |
2428 | (move-to-column col) | |
2429 | (quail-indent-to col) | |
2430 | (insert-char ?- key-width) | |
2431 | (insert ?\s) | |
2432 | (insert-char ?- single-trans-width) | |
2433 | (forward-line 1) | |
2434 | ;; Insert the key-tran pairs. | |
2435 | (dotimes (row rows) | |
2436 | (let ((elt (pop single-list))) | |
2437 | (when elt | |
2438 | (move-to-column col) | |
2439 | (quail-indent-to col) | |
2440 | (insert (propertize (car elt) | |
2441 | 'face 'font-lock-comment-face)) | |
2442 | (quail-indent-to (+ col key-width 1)) | |
2443 | (insert (cdr elt)) | |
2444 | (forward-line 1)))) | |
2445 | (setq col (+ col col-width))))) | |
23a01417 | 2446 | (goto-char (point-max)))) |
95109387 | 2447 | |
362a8065 | 2448 | (when multiple-list |
23a01417 SM |
2449 | ;; Since decode-map is sorted, we known the longest key is at the end. |
2450 | (let ((max-key-width (max 3 (length (caar (last multiple-list)))))) | |
2451 | (insert "key") | |
2452 | (quail-indent-to (1+ max-key-width)) | |
2453 | (insert "character(s) [type a key (sequence) and select one from the list]\n") | |
2454 | (insert-char ?- max-key-width) | |
2455 | (insert " ------------\n") | |
2456 | (dolist (elt multiple-list) | |
51c4341f SM |
2457 | (insert (propertize (car elt) |
2458 | 'face 'font-lock-comment-face)) | |
23a01417 SM |
2459 | (quail-indent-to max-key-width) |
2460 | (if (vectorp (cdr elt)) | |
2461 | (mapc (function | |
2462 | (lambda (x) | |
2463 | (let ((width (if (integerp x) (char-width x) | |
2464 | (string-width x)))) | |
2465 | (when (> (+ (current-column) 1 width) window-width) | |
2466 | (insert "\n") | |
2467 | (quail-indent-to max-key-width)) | |
2468 | (insert " " x)))) | |
2469 | (cdr elt)) | |
2470 | (insert " " (cdr elt))) | |
2471 | (insert ?\n)) | |
2472 | (insert ?\n))))) | |
95109387 | 2473 | |
5e94230e CY |
2474 | (define-button-type 'quail-keyboard-layout-button |
2475 | :supertype 'help-xref | |
4f91a816 SM |
2476 | 'help-function (lambda (layout) |
2477 | (help-setup-xref `(quail-keyboard-layout-button ,layout) | |
2478 | nil) | |
2479 | (quail-show-keyboard-layout layout)) | |
5e94230e CY |
2480 | 'help-echo (purecopy "mouse-2, RET: show keyboard layout")) |
2481 | ||
2482 | (define-button-type 'quail-keyboard-customize-button | |
2483 | :supertype 'help-customize-variable | |
2484 | 'help-echo (purecopy "mouse-2, RET: customize keyboard layout")) | |
396ae608 | 2485 | |
6c7b13cf KH |
2486 | (defun quail-help (&optional package) |
2487 | "Show brief description of the current Quail package. | |
24790d0c | 2488 | Optional arg PACKAGE specifies the name of alternative Quail |
362a8065 | 2489 | package to describe." |
5e94230e | 2490 | (require 'help-mode) |
83600a29 | 2491 | (let ((help-xref-mule-regexp help-xref-mule-regexp-template) |
c5930207 | 2492 | (mb enable-multibyte-characters) |
396ae608 RS |
2493 | (package-def |
2494 | (if package | |
2495 | (assoc package quail-package-alist) | |
2496 | quail-current-package))) | |
58d2b986 | 2497 | ;; At first, make sure that the help buffer has window. |
1ce2659d RS |
2498 | (let ((temp-buffer-show-hook nil)) |
2499 | (with-output-to-temp-buffer (help-buffer) | |
2500 | (with-current-buffer standard-output | |
c5930207 | 2501 | (set-buffer-multibyte mb) |
1ce2659d | 2502 | (setq quail-current-package package-def)))) |
58d2b986 | 2503 | ;; Then, insert text in the help buffer while paying attention to |
6b61353c | 2504 | ;; the width of the window in which the buffer displayed. |
24790d0c | 2505 | (with-current-buffer (help-buffer) |
09877d5d | 2506 | (setq buffer-read-only nil) |
7a08ed35 EZ |
2507 | ;; Without this, a keyboard layout with R2L characters might be |
2508 | ;; displayed reversed, right to left. See the thread starting at | |
2509 | ;; http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00062.html | |
2510 | ;; for a description of one such situation. | |
2511 | (setq bidi-paragraph-direction 'left-to-right) | |
09877d5d MB |
2512 | (insert "Input method: " (quail-name) |
2513 | " (mode line indicator:" | |
2514 | (quail-title) | |
2515 | ")\n\n") | |
2516 | (save-restriction | |
2517 | (narrow-to-region (point) (point)) | |
2518 | (insert (quail-docstring)) | |
2519 | (goto-char (point-min)) | |
2520 | (with-syntax-table emacs-lisp-mode-syntax-table | |
2521 | (while (re-search-forward "\\\\<\\sw\\(\\sw\\|\\s_\\)+>" nil t) | |
2522 | (let ((sym (intern-soft | |
2523 | (buffer-substring (+ (match-beginning 0) 2) | |
2524 | (1- (point)))))) | |
2525 | (if (and (boundp sym) | |
2526 | (stringp (symbol-value sym))) | |
2527 | (replace-match (symbol-value sym) t t))))) | |
2528 | (goto-char (point-max))) | |
2529 | (or (bolp) | |
2530 | (insert "\n")) | |
2531 | (insert "\n") | |
2532 | ||
2533 | (let ((done-list nil)) | |
2534 | ;; Show keyboard layout if the current package requests it.. | |
2535 | (when (quail-show-layout) | |
2536 | (insert " | |
362a8065 KH |
2537 | KEYBOARD LAYOUT |
2538 | --------------- | |
8179cccd KH |
2539 | This input method works by translating individual input characters. |
2540 | Assuming that your actual keyboard has the `") | |
09877d5d MB |
2541 | (help-insert-xref-button |
2542 | quail-keyboard-layout-type | |
396ae608 RS |
2543 | 'quail-keyboard-layout-button |
2544 | quail-keyboard-layout-type) | |
09877d5d | 2545 | (insert "' layout, |
9a6ad735 EZ |
2546 | translation results in the following \"virtual\" keyboard layout |
2547 | \(the labels on the keys indicate what character will be produced | |
2548 | by each key, with and without holding Shift): | |
195e6740 | 2549 | ") |
09877d5d MB |
2550 | (setq done-list |
2551 | (quail-insert-kbd-layout quail-keyboard-layout)) | |
2552 | (insert "If your keyboard has a different layout, rearranged from | |
8179cccd | 2553 | `") |
09877d5d MB |
2554 | (help-insert-xref-button |
2555 | "standard" | |
396ae608 | 2556 | 'quail-keyboard-layout-button "standard") |
09877d5d | 2557 | (insert "', the \"virtual\" keyboard you get with this input method |
8179cccd KH |
2558 | will be rearranged in the same way. |
2559 | ||
2560 | You can set the variable `quail-keyboard-layout-type' to specify | |
2561 | the physical layout of your keyboard; the tables shown in | |
2562 | documentation of input methods including this one are based on the | |
2563 | physical keyboard layout as specified with that variable. | |
2564 | ") | |
09877d5d MB |
2565 | (help-insert-xref-button |
2566 | "[customize keyboard layout]" | |
396ae608 | 2567 | 'quail-keyboard-customize-button 'quail-keyboard-layout-type) |
09877d5d MB |
2568 | (insert "\n")) |
2569 | ||
2570 | ;; Show key sequences. | |
23a01417 SM |
2571 | (let* ((decode-map (list 'decode-map)) |
2572 | (num (quail-build-decode-map (list (quail-map)) "" decode-map | |
94579c02 SM |
2573 | ;; We used to use 512 here, but |
2574 | ;; TeX has more than 1000 and | |
2575 | ;; it's good to see the list. | |
23a01417 | 2576 | 0 5120 done-list))) |
09877d5d MB |
2577 | (when (> num 0) |
2578 | (insert " | |
362a8065 | 2579 | KEY SEQUENCE |
a17ea571 | 2580 | ------------ |
362a8065 | 2581 | ") |
09877d5d MB |
2582 | (if (quail-show-layout) |
2583 | (insert "You can also input more characters") | |
2584 | (insert "You can input characters")) | |
2585 | (insert " by the following key sequences:\n") | |
2586 | (quail-insert-decode-map decode-map)))) | |
2587 | ||
2588 | (quail-help-insert-keymap-description | |
2589 | (quail-translation-keymap) | |
2590 | "\ | |
362a8065 KH |
2591 | KEY BINDINGS FOR TRANSLATION |
2592 | ----------------------------\n") | |
09877d5d MB |
2593 | (insert ?\n) |
2594 | (if (quail-conversion-keymap) | |
2595 | (quail-help-insert-keymap-description | |
2596 | (quail-conversion-keymap) | |
2597 | "\ | |
362a8065 KH |
2598 | KEY BINDINGS FOR CONVERSION |
2599 | ---------------------------\n")) | |
74ace46a | 2600 | (setq quail-current-package nil) |
09877d5d MB |
2601 | ;; Resize the help window again, now that it has all its contents. |
2602 | (save-selected-window | |
2c72829f | 2603 | (select-window (get-buffer-window (current-buffer) t)) |
09877d5d | 2604 | (run-hooks 'temp-buffer-show-hook))))) |
9a6428f8 | 2605 | |
4ed46869 | 2606 | (defun quail-help-insert-keymap-description (keymap &optional header) |
23a01417 SM |
2607 | (let ((pos1 (point)) |
2608 | pos2) | |
4ed46869 KH |
2609 | (if header |
2610 | (insert header)) | |
362a8065 KH |
2611 | (save-excursion |
2612 | (insert (substitute-command-keys "\\{keymap}"))) | |
2613 | ;; Skip headers "key bindings", etc. | |
95109387 KH |
2614 | (forward-line 3) |
2615 | (setq pos2 (point)) | |
2616 | (with-syntax-table emacs-lisp-mode-syntax-table | |
2617 | (while (re-search-forward "\\sw\\(\\sw\\|\\s_\\)+" nil t) | |
2618 | (let ((sym (intern-soft (buffer-substring (match-beginning 0) | |
2619 | (point))))) | |
2620 | (if (and sym (fboundp sym) | |
362a8065 KH |
2621 | (or (eq (get sym 'quail-help) 'hide) |
2622 | (and (quail-deterministic) | |
2623 | (eq (get sym 'quail-help) 'non-deterministic)))) | |
95109387 KH |
2624 | (delete-region (line-beginning-position) |
2625 | (1+ (line-end-position))))))) | |
2626 | (goto-char pos2) | |
2627 | (while (not (eobp)) | |
2628 | (if (looking-at "[ \t]*$") | |
2629 | (delete-region (point) (1+ (line-end-position))) | |
2630 | (forward-line 1))) | |
2631 | (goto-char pos2) | |
2632 | (if (eobp) | |
2633 | (delete-region pos1 (point))) | |
2634 | (goto-char (point-max)))) | |
4ed46869 KH |
2635 | |
2636 | (defun quail-translation-help () | |
d91eafdf | 2637 | "Show help message while translating in Quail input method." |
4ed46869 | 2638 | (interactive) |
d91eafdf KH |
2639 | (if (not (eq this-command last-command)) |
2640 | (let (state-msg keymap) | |
2641 | (if (and quail-converting (= (length quail-current-key) 0)) | |
2642 | (setq state-msg | |
2643 | (format "Converting string %S by input method %S.\n" | |
2644 | quail-conversion-str (quail-name)) | |
2645 | keymap (quail-conversion-keymap)) | |
2646 | (setq state-msg | |
2647 | (format "Translating key sequence %S by input method %S.\n" | |
2648 | quail-current-key (quail-name)) | |
2649 | keymap (quail-translation-keymap))) | |
6c7b13cf | 2650 | (with-output-to-temp-buffer "*Help*" |
24790d0c | 2651 | (with-current-buffer standard-output |
d91eafdf KH |
2652 | (insert state-msg) |
2653 | (quail-help-insert-keymap-description | |
2654 | keymap | |
6c7b13cf | 2655 | "-----------------------\n") |
24790d0c | 2656 | ;; Isn't this redundant ? -stef |
d91eafdf KH |
2657 | (help-mode))))) |
2658 | (let (scroll-help) | |
2659 | (save-selected-window | |
6c7b13cf | 2660 | (select-window (get-buffer-window "*Help*")) |
d91eafdf KH |
2661 | (if (eq this-command last-command) |
2662 | (if (< (window-end) (point-max)) | |
2663 | (scroll-up) | |
2664 | (if (> (window-start) (point-min)) | |
2665 | (set-window-start (selected-window) (point-min))))) | |
2666 | (setq scroll-help | |
2667 | (if (< (window-end (selected-window) 'up-to-date) (point-max)) | |
2668 | "Type \\[quail-translation-help] to scroll up the help" | |
2669 | (if (> (window-start) (point-min)) | |
2670 | "Type \\[quail-translation-help] to see the head of help")))) | |
2671 | (if scroll-help | |
2672 | (progn | |
2673 | (message "%s" (substitute-command-keys scroll-help)) | |
2674 | (sit-for 1) | |
2675 | (message nil) | |
2676 | (quail-update-guidance) | |
2677 | )))) | |
817e162f | 2678 | \f |
4f013856 KH |
2679 | ;; Add KEY (string) to the element of TABLE (char-table) for CHAR if |
2680 | ;; it is not yet stored. As a result, the element is a string or a | |
2681 | ;; list of strings. | |
2682 | ||
570288ee | 2683 | (defun quail-store-decode-map-key (table char key) |
4f013856 KH |
2684 | (let ((elt (aref table char))) |
2685 | (if elt | |
2686 | (if (consp elt) | |
2687 | (or (member key elt) | |
2688 | (aset table char (cons key elt))) | |
2689 | (or (string= key elt) | |
2690 | (aset table char (list key elt)))) | |
1583f1f5 | 2691 | (aset table char key)) |
9dcb8cd0 EZ |
2692 | ;; Avoid "obsolete" warnings for translation-table-for-input. |
2693 | (with-no-warnings | |
2694 | (if (and translation-table-for-input | |
2695 | (setq char (aref translation-table-for-input char))) | |
2696 | (let ((translation-table-for-input nil)) | |
2697 | (quail-store-decode-map-key table char key)))))) | |
4f013856 KH |
2698 | |
2699 | ;; Helper function for quail-gen-decode-map. Store key strings to | |
2700 | ;; type each character under MAP in TABLE (char-table). MAP is an | |
2701 | ;; element of the current Quail map reached by typing keys in KEY | |
2702 | ;; (string). | |
2703 | ||
2704 | (defun quail-gen-decode-map1 (map key table) | |
2705 | (when (and (consp map) (listp (cdr map))) | |
2706 | (let ((trans (car map))) | |
2707 | (cond ((integerp trans) | |
2708 | (quail-store-decode-map-key table trans key)) | |
2709 | ((stringp trans) | |
2710 | (dotimes (i (length trans)) | |
2711 | (quail-store-decode-map-key table (aref trans i) key))) | |
2712 | ((or (vectorp trans) | |
2713 | (and (consp trans) | |
2714 | (setq trans (cdr trans)))) | |
2715 | (dotimes (i (length trans)) | |
2716 | (let ((elt (aref trans i))) | |
2717 | (if (stringp elt) | |
2718 | (if (= (length elt) 1) | |
2719 | (quail-store-decode-map-key table (aref elt 0) key)) | |
2720 | (quail-store-decode-map-key table elt key))))))) | |
2721 | (if (> (length key) 1) | |
2722 | (dolist (elt (cdr map)) | |
2723 | (quail-gen-decode-map1 (cdr elt) key table)) | |
2724 | (dolist (elt (cdr map)) | |
2725 | (quail-gen-decode-map1 (cdr elt) (format "%s%c" key (car elt)) | |
2726 | table))))) | |
2727 | ||
2728 | (put 'quail-decode-map 'char-table-extra-slots 0) | |
2729 | ||
3ed8598c | 2730 | ;; Generate a half-cooked decode map (char-table) for the current |
4f013856 | 2731 | ;; Quail map. An element for a character C is a key string or a list |
c80e3b4a | 2732 | ;; of a key strings to type to input C. The length of key string is at |
4f013856 KH |
2733 | ;; most 2. If it is 2, more keys may be required to input C. |
2734 | ||
2735 | (defun quail-gen-decode-map () | |
2736 | (let ((table (make-char-table 'quail-decode-map nil))) | |
2737 | (dolist (elt (cdr (quail-map))) | |
2738 | (quail-gen-decode-map1 (cdr elt) (string (car elt)) table)) | |
2739 | table)) | |
2740 | ||
1583f1f5 KH |
2741 | ;; Check if CHAR equals to TARGET while also trying to translate CHAR |
2742 | ;; by translation-table-for-input. | |
2743 | ||
2744 | (defsubst quail-char-equal-p (char target) | |
2745 | (or (= char target) | |
9dcb8cd0 EZ |
2746 | ;; Avoid "obsolete" warnings for translation-table-for-input. |
2747 | (with-no-warnings | |
2748 | (and translation-table-for-input | |
2749 | (setq char (aref translation-table-for-input char)) | |
2750 | (= char target))))) | |
1583f1f5 | 2751 | |
4f013856 KH |
2752 | ;; Helper function for quail-find-key. Prepend key strings to type |
2753 | ;; for inputting CHAR by the current input method to KEY-LIST and | |
2754 | ;; return the result. MAP is an element of the current Quail map | |
2755 | ;; reached by typing keys in KEY. | |
2756 | ||
2757 | (defun quail-find-key1 (map key char key-list) | |
2758 | (let ((trans (car map)) | |
2759 | (found-here nil)) | |
2760 | (cond ((stringp trans) | |
2761 | (setq found-here | |
1583f1f5 KH |
2762 | (and (= (length trans) 1) |
2763 | (quail-char-equal-p (aref trans 0) char)))) | |
4f013856 KH |
2764 | ((or (vectorp trans) (consp trans)) |
2765 | (if (consp trans) | |
2766 | (setq trans (cdr trans))) | |
2767 | (setq found-here | |
2768 | (catch 'tag | |
2769 | (dotimes (i (length trans)) | |
2770 | (let ((target (aref trans i))) | |
2771 | (if (integerp target) | |
1583f1f5 | 2772 | (if (quail-char-equal-p target char) |
4f013856 KH |
2773 | (throw 'tag t)) |
2774 | (if (and (= (length target) 1) | |
1583f1f5 | 2775 | (quail-char-equal-p (aref target 0) char)) |
4f013856 KH |
2776 | (throw 'tag t)))))))) |
2777 | ((integerp trans) | |
1583f1f5 | 2778 | (setq found-here (quail-char-equal-p trans char)))) |
4f013856 KH |
2779 | (if found-here |
2780 | (setq key-list (cons key key-list))) | |
2781 | (if (> (length key) 1) | |
2782 | (dolist (elt (cdr map)) | |
2783 | (setq key-list | |
2784 | (quail-find-key1 (cdr elt) (format "%s%c" key (car elt)) | |
2785 | char key-list)))) | |
2786 | key-list)) | |
2787 | ||
1583f1f5 KH |
2788 | ;; If non-nil, the value has the form (QUAIL-MAP . CODING-SYSTEM) |
2789 | ;; where QUAIL-MAP is a quail-map of which decode map was generated | |
2790 | ;; while buffer-file-coding-system was CODING-SYSTEM. | |
2791 | ||
2792 | (defvar quail-decode-map-generated nil) | |
2793 | ||
4f013856 | 2794 | (defun quail-find-key (char) |
2a3e58e6 KH |
2795 | "Return a list of keys to type to input CHAR in the current input method. |
2796 | If CHAR is an ASCII character and can be input by typing itself, return t." | |
1583f1f5 KH |
2797 | (let ((decode-map (or (and (or (not quail-decode-map-generated) |
2798 | (and (eq (car quail-decode-map-generated) (quail-map)) | |
2799 | (eq (cdr quail-decode-map-generated) | |
2800 | (or buffer-file-coding-system t)))) | |
2801 | (quail-decode-map)) | |
2802 | (let ((map (quail-gen-decode-map))) | |
2803 | (setq quail-decode-map-generated | |
2804 | (cons (quail-map) (or buffer-file-coding-system t))) | |
2805 | (setcar (nthcdr 10 quail-current-package) map) | |
2806 | map))) | |
4f013856 KH |
2807 | (key-list nil)) |
2808 | (if (consp decode-map) | |
2809 | (let ((str (string char))) | |
2810 | (mapc #'(lambda (elt) | |
2811 | (if (string= str (car elt)) | |
2812 | (setq key-list (cons (cdr elt) key-list)))) | |
2813 | (cdr decode-map))) | |
2814 | (let ((key-head (aref decode-map char))) | |
2815 | (if (stringp key-head) | |
f6b1b0a8 | 2816 | (setq key-list (quail-find-key1 |
4f013856 KH |
2817 | (quail-lookup-key key-head nil t) |
2818 | key-head char nil)) | |
2819 | (mapc #'(lambda (elt) | |
2820 | (setq key-list | |
2821 | (quail-find-key1 | |
2822 | (quail-lookup-key elt nil t) elt char key-list))) | |
2823 | key-head)))) | |
2824 | (or key-list | |
2825 | (and (< char 128) | |
2826 | (not (quail-lookup-key (string char) 1)))))) | |
2827 | ||
2828 | (defun quail-show-key () | |
2829 | "Show a list of key strings to type for inputting a character at point." | |
2830 | (interactive) | |
2831 | (or current-input-method | |
2832 | (error "No input method is activated")) | |
fdb59445 | 2833 | (or (assoc current-input-method quail-package-alist) |
06d5f409 | 2834 | (error "The current input method does not use Quail")) |
4f013856 KH |
2835 | (let* ((char (following-char)) |
2836 | (key-list (quail-find-key char))) | |
2837 | (cond ((consp key-list) | |
2838 | (message "To input `%c', type \"%s\"" | |
2839 | char | |
2840 | (mapconcat 'identity key-list "\", \""))) | |
2841 | ((eq key-list t) | |
2842 | (message "To input `%s', just type it" | |
2843 | (single-key-description char))) | |
2844 | (t | |
2845 | (message "%c can't be input by the current input method" char))))) | |
2846 | ||
2847 | \f | |
817e162f KH |
2848 | ;; Quail map generator from state transition table. |
2849 | ||
2850 | (defun quail-map-from-table (table) | |
2851 | "Make quail map from state transition table TABLE. | |
2852 | ||
2853 | TABLE is an alist, the form is: | |
2854 | ((STATE-0 TRANSITION-0-1 TRANSITION-0-2 ...) (STATE-1 ...) ...) | |
2855 | ||
2856 | STATE-n are symbols to denote state. STATE-0 is the initial state. | |
2857 | ||
2858 | TRANSITION-n-m are transition rules from STATE-n, and have the form | |
2859 | \(RULES . STATE-x) or RULES, where STATE-x is one of STATE-n above, | |
2860 | RULES is a symbol whose value is an alist of keys \(string) vs the | |
bbd240ce | 2861 | corresponding characters or strings. The format of the symbol value of |
817e162f KH |
2862 | RULES is the same as arguments to `quail-define-rules'. |
2863 | ||
2864 | If TRANSITION-n-m has the form (RULES . STATE-x), it means that | |
2865 | STATE-n transits to STATE-x when keys in RULES are input. Recursive | |
2866 | transition is allowed, i.e. STATE-x may be STATE-n. | |
2867 | ||
2868 | If TRANSITION-n-m has the form RULES, the transition terminates | |
2869 | when keys in RULES are input. | |
2870 | ||
2871 | The generated map can be set for the current Quail package by the | |
2872 | function `quail-install-map' (which see)." | |
2873 | (let ((state-alist (mapcar (lambda (x) (list (car x))) table)) | |
2874 | tail elt) | |
bbd240ce | 2875 | ;; STATE-ALIST is an alist of states vs the corresponding sub Quail |
817e162f KH |
2876 | ;; map. It is now initialized to ((STATE-0) (STATE-1) ...). |
2877 | ;; Set key sequence mapping rules in cdr part of each element. | |
2878 | (while table | |
2879 | (quail-map-from-table-1 state-alist (car table)) | |
2880 | (setq table (cdr table))) | |
2881 | ||
2882 | ;; Now STATE-ALIST has the form ((STATE-0 MAPPING-RULES) ...). | |
2883 | ;; Elements of MAPPING-RULES may have the form (STATE-x). Replace | |
2884 | ;; them with MAPPING-RULES of STATE-x to make elements of | |
2885 | ;; STATE-ALIST valid Quail maps. | |
2886 | (setq tail state-alist) | |
2887 | (while tail | |
2888 | (setq elt (car tail) tail (cdr tail)) | |
2889 | (quail-map-from-table-2 state-alist elt)) | |
2890 | ||
2891 | ;; Return the Quail map for the initial state. | |
2892 | (car state-alist))) | |
2893 | ||
2894 | ;; STATE-INFO has the form (STATE TRANSITION ...). Set key sequence | |
2895 | ;; mapping rules in the element of STATE-ALIST that corresponds to | |
2896 | ;; STATE according to TRANSITION ... | |
2897 | (defun quail-map-from-table-1 (state-alist state-info) | |
2898 | (let* ((state (car state-info)) | |
2899 | (map (assq state state-alist)) | |
2900 | (transitions (cdr state-info)) | |
2901 | elt) | |
2902 | (while transitions | |
2903 | (setq elt (car transitions) transitions (cdr transitions)) | |
2904 | (let (rules dst-state key trans) | |
2905 | ;; ELT has the form (RULES-SYMBOL . STATE-x) or RULES-SYMBOL. | |
2906 | ;; STATE-x is one of car parts of STATE-ALIST's elements. | |
2907 | (if (consp elt) | |
2908 | (setq rules (symbol-value (car elt)) | |
2909 | ;; Set (STATE-x) as branches for all keys in RULES. | |
2910 | ;; It is replaced with actual branches for STATE-x | |
2911 | ;; later in `quail-map-from-table-2'. | |
2912 | dst-state (list (cdr elt))) | |
2913 | (setq rules (symbol-value elt))) | |
2914 | (while rules | |
2915 | (setq key (car (car rules)) trans (cdr (car rules)) | |
2916 | rules (cdr rules)) | |
2917 | (if (stringp trans) | |
2918 | (if (= (length trans) 1) | |
2919 | (setq trans (aref trans 0)) | |
2920 | (setq trans (string-to-vector trans)))) | |
2921 | (set-nested-alist key trans map nil dst-state)))))) | |
2922 | ||
2923 | ;; ELEMENT is one element of STATE-ALIST. ELEMENT is a nested alist; | |
2924 | ;; the form is: | |
2925 | ;; (STATE (CHAR NESTED-ALIST) ...) | |
2926 | ;; NESTED-ALIST is a nested alist; the form is: | |
2927 | ;; (TRANS (CHAR NESTED-ALIST) ...) | |
2928 | ;; or | |
2929 | ;; (TRANS (CHAR NESTED-ALIST) ... . (STATE-x)) | |
2930 | ;; Here, the task is to replace all occurrences of (STATE-x) with: | |
2931 | ;; (cdr (assq STATE-x STATE-ALIST)) | |
2932 | ||
2933 | (defun quail-map-from-table-2 (state-alist element) | |
2934 | (let ((prev element) | |
2935 | (tail (cdr element)) | |
2936 | elt) | |
2937 | (while (cdr tail) | |
2938 | (setq elt (car tail) prev tail tail (cdr tail)) | |
2939 | (quail-map-from-table-2 state-alist (cdr elt))) | |
2940 | (setq elt (car tail)) | |
2941 | (if (consp elt) | |
2942 | (quail-map-from-table-2 state-alist (cdr elt)) | |
2943 | (setcdr prev (cdr (assq elt state-alist)))))) | |
2944 | ||
2945 | ;; Concatenate translations for all heading substrings of KEY in the | |
2946 | ;; current Quail map. Here, `heading substring' means (substring KEY | |
2947 | ;; 0 LEN), where LEN is 1, 2, ... (length KEY). | |
2948 | (defun quail-lookup-map-and-concat (key) | |
2949 | (let* ((len (length key)) | |
2950 | (translation-list nil) | |
2951 | map) | |
2952 | (while (> len 0) | |
5b6156fa | 2953 | (setq map (quail-lookup-key key len t) |
817e162f KH |
2954 | len (1- len)) |
2955 | (if map | |
2956 | (let* ((def (quail-map-definition map)) | |
2957 | (trans (if (consp def) (aref (cdr def) (car (car def))) | |
2958 | def))) | |
2959 | (if (integerp trans) | |
2960 | (setq trans (char-to-string trans))) | |
2961 | (setq translation-list (cons trans translation-list))))) | |
2962 | (apply 'concat translation-list))) | |
4ed46869 | 2963 | |
ff913e92 KH |
2964 | \f |
2965 | (defvar quail-directory-name "quail" | |
cd30a521 | 2966 | "Name of Quail directory which contains Quail packages. |
ff913e92 KH |
2967 | This is a sub-directory of LEIM directory.") |
2968 | ||
2969 | ;;;###autoload | |
70fd2661 KH |
2970 | (defun quail-update-leim-list-file (dirname &rest dirnames) |
2971 | "Update entries for Quail packages in `LEIM' list file in directory DIRNAME. | |
2972 | DIRNAME is a directory containing Emacs input methods; | |
8cbe9074 | 2973 | normally, it should specify the `leim' subdirectory |
70fd2661 KH |
2974 | of the Emacs source tree. |
2975 | ||
2976 | It searches for Quail packages under `quail' subdirectory of DIRNAME, | |
2977 | and update the file \"leim-list.el\" in DIRNAME. | |
ff913e92 | 2978 | |
70fd2661 KH |
2979 | When called from a program, the remaining arguments are additional |
2980 | directory names to search for Quail packages under `quail' subdirectory | |
2981 | of each directory." | |
2982 | (interactive "FDirectory of LEIM: ") | |
2983 | (setq dirname (expand-file-name dirname)) | |
2984 | (let ((leim-list (expand-file-name leim-list-file-name dirname)) | |
23a01417 | 2985 | quail-dirs list-buf pkg-list pos) |
70fd2661 KH |
2986 | (if (not (file-writable-p leim-list)) |
2987 | (error "Can't write to file \"%s\"" leim-list)) | |
2988 | (message "Updating %s ..." leim-list) | |
2989 | (setq list-buf (find-file-noselect leim-list)) | |
2990 | ||
2991 | ;; At first, clean up the file. | |
24790d0c | 2992 | (with-current-buffer list-buf |
70fd2661 KH |
2993 | (goto-char 1) |
2994 | ||
2995 | ;; Insert the correct header. | |
2996 | (if (looking-at (regexp-quote leim-list-header)) | |
2997 | (goto-char (match-end 0)) | |
2998 | (insert leim-list-header)) | |
2999 | (setq pos (point)) | |
3000 | (if (not (re-search-forward leim-list-entry-regexp nil t)) | |
3001 | nil | |
3002 | ||
3ed8598c | 3003 | ;; Remove garbage after the header. |
70fd2661 KH |
3004 | (goto-char (match-beginning 0)) |
3005 | (if (< pos (point)) | |
3006 | (delete-region pos (point))) | |
3007 | ||
3008 | ;; Remove all entries for Quail. | |
3009 | (while (re-search-forward leim-list-entry-regexp nil 'move) | |
3010 | (goto-char (match-beginning 0)) | |
3011 | (setq pos (point)) | |
3012 | (condition-case nil | |
3013 | (let ((form (read list-buf))) | |
3014 | (when (equal (nth 3 form) ''quail-use-package) | |
3015 | (if (eolp) (forward-line 1)) | |
3016 | (delete-region pos (point)))) | |
3017 | (error | |
3018 | ;; Delete the remaining contents because it seems that | |
3019 | ;; this file is broken. | |
4be9beaf | 3020 | (message "Garbage in %s deleted" leim-list) |
70fd2661 KH |
3021 | (delete-region pos (point-max))))))) |
3022 | ||
cd30a521 | 3023 | ;; Search for `quail' subdirectory under each DIRNAMES. |
70fd2661 KH |
3024 | (setq dirnames (cons dirname dirnames)) |
3025 | (let ((l dirnames)) | |
3026 | (while l | |
3027 | (setcar l (expand-file-name (car l))) | |
3028 | (setq dirname (expand-file-name quail-directory-name (car l))) | |
3029 | (if (file-readable-p dirname) | |
3030 | (setq quail-dirs (cons dirname quail-dirs)) | |
4be9beaf | 3031 | (message "%s doesn't have `%s' subdirectory, just ignored" |
70fd2661 KH |
3032 | (car l) quail-directory-name) |
3033 | (setq quail-dirs (cons nil quail-dirs))) | |
3034 | (setq l (cdr l))) | |
3035 | (setq quail-dirs (nreverse quail-dirs))) | |
3036 | ||
3037 | ;; Insert input method registering forms. | |
3038 | (while quail-dirs | |
3039 | (setq dirname (car quail-dirs)) | |
3040 | (when dirname | |
3041 | (setq pkg-list (directory-files dirname 'full "\\.el$" 'nosort)) | |
3042 | (while pkg-list | |
3043 | (message "Checking %s ..." (car pkg-list)) | |
3044 | (with-temp-buffer | |
3045 | (insert-file-contents (car pkg-list)) | |
3046 | (goto-char (point-min)) | |
35fffde1 DL |
3047 | ;; Don't get fooled by commented-out code. |
3048 | (while (re-search-forward "^[ \t]*(quail-define-package" nil t) | |
ff913e92 | 3049 | (goto-char (match-beginning 0)) |
70fd2661 KH |
3050 | (condition-case nil |
3051 | (let ((form (read (current-buffer)))) | |
24790d0c | 3052 | (with-current-buffer list-buf |
70fd2661 KH |
3053 | (insert |
3054 | (format "(register-input-method | |
ff913e92 KH |
3055 | %S %S '%s |
3056 | %S %S | |
8cbe9074 | 3057 | %S)\n" |
70fd2661 KH |
3058 | (nth 1 form) ; PACKAGE-NAME |
3059 | (nth 2 form) ; LANGUAGE | |
3060 | 'quail-use-package ; ACTIVATE-FUNC | |
3061 | (nth 3 form) ; PACKAGE-TITLE | |
3062 | (progn ; PACKAGE-DESCRIPTION (one line) | |
3063 | (string-match ".*" (nth 5 form)) | |
3064 | (match-string 0 (nth 5 form))) | |
3065 | (file-relative-name ; PACKAGE-FILENAME | |
3066 | (file-name-sans-extension (car pkg-list)) | |
3067 | (car dirnames)))))) | |
3068 | (error | |
3069 | ;; Ignore the remaining contents of this file. | |
3070 | (goto-char (point-max)) | |
186b3352 | 3071 | (message "Some part of \"%s\" is broken" (car pkg-list)))))) |
70fd2661 KH |
3072 | (setq pkg-list (cdr pkg-list))) |
3073 | (setq quail-dirs (cdr quail-dirs) dirnames (cdr dirnames)))) | |
3074 | ||
3075 | ;; At last, write out LEIM list file. | |
24790d0c | 3076 | (with-current-buffer list-buf |
9ffcf5cb | 3077 | (let ((coding-system-for-write 'utf-8)) |
568199b3 | 3078 | (save-buffer 0))) |
70fd2661 KH |
3079 | (kill-buffer list-buf) |
3080 | (message "Updating %s ... done" leim-list))) | |
bb63aae5 KH |
3081 | \f |
3082 | (defun quail-advice (args) | |
74ace46a | 3083 | "Advise users about the characters input by the current Quail package. |
bb63aae5 KH |
3084 | The argument is a parameterized event of the form: |
3085 | (quail-advice STRING) | |
3086 | where STRING is a string containing the input characters. | |
3087 | If STRING has property `advice' and the value is a function, | |
3088 | call it with one argument STRING." | |
3089 | (interactive "e") | |
3090 | (let* ((string (nth 1 args)) | |
3091 | (func (get-text-property 0 'advice string))) | |
3092 | (if (functionp func) | |
3093 | (funcall func string)))) | |
3094 | ||
3095 | (global-set-key [quail-advice] 'quail-advice) | |
3096 | ||
4ed46869 KH |
3097 | ;; |
3098 | (provide 'quail) | |
3099 | ||
3100 | ;;; quail.el ends here |