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