-;;; quail.el --- Provides simple input method for multilingual text
+;;; quail.el --- provides simple input method for multilingual text
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
;; Author: Kenichi HANDA <handa@etl.go.jp>
;; Naoto TAKAHASHI <ntakahas@etl.go.jp>
;; Maintainer: Kenichi HANDA <handa@etl.go.jp>
-;; Keywords: mule, multilingual, input method
+;; Keywords: mule, multilingual, input method, i18n
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Kanji-and-Kana mixed text or Katakana text by commands specified in
;; CONVERSION-KEYS argument of the Quail package.
+;; [There was an input method for Mule 2.3 called `Tamago' from the
+;; Japanese `TAkusan MAtasete GOmenasai', or `Sorry for having you
+;; wait so long'; this couldn't be included in Emacs 20. `Tamago' is
+;; Japanese for `egg' (implicitly a hen's egg). Handa-san made a
+;; smaller and simpler system; the smaller quail egg is also eaten in
+;; Japan. Maybe others will be egged on to write more sorts of input
+;; methods.]
+
;;; Code:
-(require 'faces)
+(require 'help-mode)
+
+(defgroup quail nil
+ "Quail: multilingual input method."
+ :group 'leim)
;; Buffer local variables
(make-variable-buffer-local 'quail-current-package)
(put 'quail-current-package 'permanent-local t)
-;; Quail uses the following two buffers to assist users.
-;; A buffer to show available key sequence or translation list.
-(defvar quail-guidance-buf nil)
+;; Quail uses the following variables to assist users.
+;; A string containing available key sequences or translation list.
+(defvar quail-guidance-str nil)
;; A buffer to show completion list of the current key sequence.
(defvar quail-completion-buf nil)
+;; We may display the guidance string in a buffer on a one-line frame.
+(defvar quail-guidance-buf nil)
+(defvar quail-guidance-frame nil)
;; Each buffer in which Quail is activated should use different
-;; guidance buffers.
-(make-variable-buffer-local 'quail-guidance-buf)
-(put 'quail-guidance-buf 'permanent-local t)
-
-;; A main window showing Quail guidance buffer.
-(defvar quail-guidance-win nil)
-(make-variable-buffer-local 'quail-guidance-win)
+;; guidance string.
+(make-variable-buffer-local 'quail-guidance-str)
+(put 'quail-guidance-str 'permanent-local t)
(defvar quail-overlay nil
"Overlay which covers the current translation region of Quail.")
(defsubst quail-name ()
"Return the name of the current Quail package."
(nth 0 quail-current-package))
-(defsubst quail-title ()
+;;;###autoload
+(defun quail-title ()
"Return the title of the current Quail package."
- (nth 1 quail-current-package))
+ (let ((title (nth 1 quail-current-package)))
+ ;; TITLE may be a string or a list. If it is a list, each element
+ ;; is a string or the form (VAR STR1 STR2), and the interpretation
+ ;; of the list is the same as that of mode-line-format.
+ (if (stringp title)
+ title
+ (condition-case nil
+ (mapconcat
+ (lambda (x)
+ (cond ((stringp x) x)
+ ((and (listp x) (symbolp (car x)) (= (length x) 3))
+ (if (symbol-value (car x))
+ (nth 1 x) (nth 2 x)))
+ (t "")))
+ title "")
+ (error "")))))
(defsubst quail-map ()
"Return the translation map of the current Quail package."
(nth 2 quail-current-package))
;;;###autoload
(defun quail-use-package (package-name &rest libraries)
"Start using Quail package PACKAGE-NAME.
-The remaining arguments are libraries to be loaded before using the package."
+The remaining arguments are libraries to be loaded before using the package.
+
+This activates input method defined by PACKAGE-NAME by running
+`quail-activate', which see."
(let ((package (quail-package package-name)))
(if (null package)
;; Perhaps we have not yet loaded necessary libraries.
most use `quail-simple-translation-keymap' instead.
This map is activated while translation region is active.")
+(defvar quail-translation-docstring
+ "When you type keys, the echo area shows the possible characters
+which correspond to that key sequence, each preceded by a digit. You
+can select one of the characters shown by typing the corresponding
+digit. Alternatively, you can use C-f and C-b to move through the
+line to select the character you want, then type a letter to begin
+entering another Chinese character or type a space or punctuation
+character.
+
+If there are more than ten possible characters for the given spelling,
+the echo area shows ten characters at a time; you can use C-n to move
+to the next group of ten, and C-p to move back to the previous group
+of ten.")
+
+;; Categorize each Quail commands to make the output of quail-help
+;; concise. This is done by putting `quail-help' property. The value
+;; is:
+;; hide -- never show this command
+;; non-deterministic -- show only for non-deterministic input method
+(let ((l '((quail-other-command . hide)
+ (quail-self-insert-command . hide)
+ (quail-delete-last-char . hide)
+ (quail-next-translation . non-deterministic)
+ (quail-prev-translation . non-deterministic)
+ (quail-next-translation-block . non-deterministic)
+ (quail-prev-translation-block . non-deterministic))))
+ (while l
+ (put (car (car l)) 'quail-help (cdr (car l)))
+ (setq l (cdr l))))
+
(defvar quail-simple-translation-keymap
(let ((map (make-keymap))
(i 0))
This map is activated while conversion region is active but translation
region is not active.")
+;; Just a dummy definition.
+(defun quail-other-command ()
+ (interactive)
+ )
+
;;;###autoload
(defun quail-define-package (name language title
&optional guidance docstring translation-keys
shown.
If it is nil, the current key is shown.
-DOCSTRING is the documentation string of this package.
+DOCSTRING is the documentation string of this package. The command
+`describe-input-method' shows this string while replacing the form
+\\=\\<VAR> in the string by the value of VAR. That value should be a
+string. For instance, the form \\=\\<quail-translation-docstring> is
+replaced by a description about how to select a translation from a
+list of candidates.
TRANSLATION-KEYS specifies additional key bindings used while translation
region is active. It is an alist of single key character vs. corresponding
(let ((pos (point)))
(if (overlayp quail-overlay)
(move-overlay quail-overlay pos pos)
- (setq quail-overlay (make-overlay pos pos nil nil t))
+ (setq quail-overlay (make-overlay pos pos))
(if input-method-highlight-flag
(overlay-put quail-overlay 'face 'underline))
(let ((l (quail-overlay-plist)))
(if (overlayp quail-conv-overlay)
(if (not (overlay-start quail-conv-overlay))
(move-overlay quail-conv-overlay pos pos))
- (setq quail-conv-overlay (make-overlay pos pos nil nil t))
+ (setq quail-conv-overlay (make-overlay pos pos))
(if input-method-highlight-flag
(overlay-put quail-conv-overlay 'face 'underline))))))
(if (and (overlayp quail-conv-overlay) (overlay-start quail-conv-overlay))
(delete-overlay quail-conv-overlay)))
-;; Kill Quail guidance buffer. Set in kill-buffer-hook.
-(defun quail-kill-guidance-buf ()
- (if (buffer-live-p quail-guidance-buf)
- (kill-buffer quail-guidance-buf)))
-
(defun quail-inactivate ()
- "Inactivate Quail input method."
+ "Inactivate Quail input method.
+
+This function runs the normal hook `quail-inactivate-hook'."
(interactive)
(quail-activate -1))
"Activate Quail input method.
With arg, activate Quail input method if and only if arg is positive.
+This function runs `quail-activate-hook' if it activates the input
+method, `quail-inactivate-hook' if it deactivates it.
+
While this input method is active, the variable
`input-method-function' is bound to the function `quail-input-method'."
(if (and arg
;; Let's inactivate Quail input method.
(unwind-protect
(progn
- (quail-hide-guidance-buf)
(quail-delete-overlays)
(setq describe-current-input-method-function nil)
+ (quail-hide-guidance)
+ (remove-hook 'post-command-hook 'quail-show-guidance t)
(run-hooks 'quail-inactivate-hook))
(kill-local-variable 'input-method-function))
- ;; Let's active Quail input method.
+ ;; Let's activate Quail input method.
(if (null quail-current-package)
;; Quail package is not yet selected. Select one now.
(let (name)
(setq inactivate-current-input-method-function 'quail-inactivate)
(setq describe-current-input-method-function 'quail-help)
(quail-delete-overlays)
- (quail-show-guidance-buf)
+ (setq quail-guidance-str "")
+ (quail-show-guidance)
;; If we are in minibuffer, turn off the current input method
;; before exiting.
- (if (eq (selected-window) (minibuffer-window))
- (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
- (make-local-hook 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'quail-kill-guidance-buf nil t)
+ (when (eq (selected-window) (minibuffer-window))
+ (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)
+ (add-hook 'post-command-hook 'quail-show-guidance nil t))
(run-hooks 'quail-activate-hook)
(make-local-variable 'input-method-function)
(setq input-method-function 'quail-input-method)))
but the location of key \\ (backslash) is just right of key ' (single-quote),
not right of RETURN key.")
-(defvar quail-keyboard-layout quail-keyboard-layout-standard
- "A string which represents physical key layout of a particular keyboard.
-We assume there are six rows and each row has 15 keys (columns),
- the first row is above the `1' - `0' row,
- the first column of the second row is left of key `1',
- the first column of the third row is left of key `q',
- the first column of the fourth row is left of key `a',
- the first column of the fifth row is left of key `z',
- the sixth row is below the `z' - `/' row.
-Nth (N is even) and (N+1)th characters in the string are non-shifted
- and shifted characters respectively at the same location.
-The location of Nth character is row (N / 30) and column ((N mod 30) / 2).
-The command `quail-set-keyboard-layout' usually sets this variable.")
-
(defconst quail-keyboard-layout-len 180)
;; Here we provide several examples of famous keyboard layouts.
-
+;; This is a candidate for a language environment-dependent setting.
(defvar quail-keyboard-layout-alist
(list
+ (cons "standard" quail-keyboard-layout-standard)
'("sun-type3" . "\
\
1!2@3#4$5%6^7&8*9(0)-_=+\\|`~\
<>yYxXcCvVbBnNmM,;.:-_ \
")
- (cons "standard" quail-keyboard-layout-standard))
+ '("jp106" . "\
+ \
+ 1!2\"3#4$5%6&7'8(9)0~-=^~\\| \
+ qQwWeErRtTyYuUiIoOpP@`[{ \
+ aAsSdDfFgGhHjJkKlL;+:*]} \
+ zZxXcCvVbBnNmM,<.>/?\\_ \
+ ")
+ '("pc105-uk" . "\
+ \
+`\2541!2\"3\2434$5%6^7&8*9(0)-_=+ \
+ qQwWeErRtTyYuUiIoOpP[{]} \
+ aAsSdDfFgGhHjJkKlL;:'@#~ \
+\\|zZxXcCvVbBnNmM,<.>/? \
+ ")
+ )
"Alist of keyboard names and corresponding layout strings.
See the documentation of `quail-keyboard-layout' for the format of
- the layout string.")
+the layout string.")
+
+(defcustom quail-keyboard-layout quail-keyboard-layout-standard
+ "A string which represents physical key layout of a particular keyboard.
+We assume there are six rows and each row has 15 keys (columns),
+ the first row is above the `1' - `0' row,
+ the first column of the second row is left of key `1',
+ the first column of the third row is left of key `q',
+ the first column of the fourth row is left of key `a',
+ the first column of the fifth row is left of key `z',
+ the sixth row is below the `z' - `/' row.
+Nth (N is even) and (N+1)th characters in the string are non-shifted
+and shifted characters respectively at the same location.
+The location of Nth character is row (N / 30) and column ((N mod 30) / 2).
+The command `quail-set-keyboard-layout' usually sets this variable."
+ :group 'quail
+ :type `(choice
+ ,@(mapcar (lambda (pair)
+ (list 'const :tag (car pair) (cdr pair)))
+ quail-keyboard-layout-alist)
+ (string :tag "Other")))
+
+;; A non-standard keyboard layout may miss some key locations of the
+;; standard layout while having additional key locations not in the
+;; standard layout. This alist maps those additional key locations to
+;; the missing locations. The value is updated automatically by
+;; quail-set-keyboard-layout.
+(defvar quail-keyboard-layout-substitution nil)
+
+(defun quail-update-keyboard-layout (kbd-type)
+ (let ((layout (assoc kbd-type quail-keyboard-layout-alist)))
+ (if (null layout)
+ ;; Here, we had better ask a user to define his own keyboard
+ ;; layout interactively.
+ (error "Unknown keyboard type `%s'" kbd-type))
+ (setq quail-keyboard-layout (cdr layout))
+ (let ((i quail-keyboard-layout-len)
+ subst-list missing-list)
+ ;; Sum up additional key locations not in the standard layout in
+ ;; subst-list, and missing key locations in missing-list.
+ (while (> i 0)
+ (setq i (1- i))
+ (if (= (aref quail-keyboard-layout i) ? )
+ (if (/= (aref quail-keyboard-layout-standard i) ? )
+ (setq missing-list (cons i missing-list)))
+ (if (= (aref quail-keyboard-layout-standard i) ? )
+ (setq subst-list (cons (cons i nil) subst-list)))))
+ (setq quail-keyboard-layout-substitution subst-list)
+ ;; If there are additional key locations, map them to missing
+ ;; key locations.
+ (while missing-list
+ (while (and subst-list (cdr (car subst-list)))
+ (setq subst-list (cdr subst-list)))
+ (if subst-list
+ (setcdr (car subst-list) (car missing-list)))
+ (setq missing-list (cdr missing-list))))))
+
+(defcustom quail-keyboard-layout-type "standard"
+ "Type of keyboard layout used in Quail base input method.
+Available types are listed in the variable `quail-keyboard-layout-alist'."
+ :group 'quail
+ :type (cons 'choice (mapcar (lambda (elt)
+ (list 'const (car elt)))
+ quail-keyboard-layout-alist))
+ :set #'(lambda (symbol value)
+ (quail-update-keyboard-layout value)
+ (set symbol value)))
;;;###autoload
(defun quail-set-keyboard-layout (kbd-type)
(type (completing-read "Keyboard type: "
quail-keyboard-layout-alist)))
(list type)))
- (let ((layout (assoc kbd-type quail-keyboard-layout-alist)))
- (if (null layout)
- ;; Here, we had better ask a user to define his own keyboard
- ;; layout interactively.
- (error "Unknown keyboard type `%s'" kbd-type))
- (setq quail-keyboard-layout (cdr layout))))
+ (quail-update-keyboard-layout kbd-type)
+ (setq quail-keyboard-layout-type kbd-type))
-(defun quail-keyboard-translate (ch)
- "Translate CHAR according to `quail-keyboard-layout' and return the result."
+(defun quail-keyboard-translate (char)
+ "Translate CHAR to the one in the standard keyboard layout."
(if (eq quail-keyboard-layout quail-keyboard-layout-standard)
;; All Quail packages are designed based on
;; `quail-keyboard-layout-standard'.
- ch
+ char
(let ((i 0))
+ ;; Find the key location on the current keyboard layout.
(while (and (< i quail-keyboard-layout-len)
- (/= ch (aref quail-keyboard-layout i)))
+ (/= char (aref quail-keyboard-layout i)))
(setq i (1+ i)))
(if (= i quail-keyboard-layout-len)
- ;; CH is not in quail-keyboard-layout, which means that a
+ ;; CHAR is not in quail-keyboard-layout, which means that a
;; user typed a key which generated a character code to be
- ;; handled out of Quail. Just return CH and make
+ ;; handled out of Quail. Just return CHAR and make
;; quail-execute-non-quail-command handle it correctly.
- ch
- (let ((char (aref quail-keyboard-layout-standard i)))
- (if (= char ?\ )
- ;; A user typed a key at the location not converted by
- ;; quail-keyboard-layout-standard. Just return CH as
- ;; well as above.
- ch
- char))))))
+ char
+ (let ((ch (aref quail-keyboard-layout-standard i)))
+ (if (= ch ?\ )
+ ;; This location not available in the standard keyboard
+ ;; layout. Check if the location is used to substitute
+ ;; for the other location of the standard layout.
+ (if (setq i (cdr (assq i quail-keyboard-layout-substitution)))
+ (aref quail-keyboard-layout-standard i)
+ ;; Just return CHAR as well as above.
+ char)
+ ch))))))
+
+(defun quail-keyseq-translate (keyseq)
+ (apply 'string
+ (mapcar (function (lambda (x) (quail-keyboard-translate x)))
+ keyseq)))
+
+(defun quail-insert-kbd-layout (kbd-layout)
+"Insert the visual keyboard layout table according to KBD-LAYOUT.
+The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
+ (let (done-list layout i ch)
+ ;; At first, convert KBD-LAYOUT to the same size vector that
+ ;; contains translated character or string.
+ (setq layout (string-to-vector kbd-layout)
+ i 0)
+ (while (< i quail-keyboard-layout-len)
+ (setq ch (aref kbd-layout i))
+ (if (quail-kbd-translate)
+ (setq ch (quail-keyboard-translate ch)))
+ (let* ((map (cdr (assq ch (cdr (quail-map)))))
+ (translation (and map (quail-get-translation
+ (car map) (char-to-string ch) 1))))
+ (if translation
+ (progn
+ (if (consp translation)
+ (setq translation (aref (cdr translation) 0)))
+ (setq done-list (cons translation done-list)))
+ (setq translation ch))
+ (aset layout i translation))
+ (setq i (1+ i)))
+
+ (let ((pos (point))
+ (bar "|")
+ lower upper row)
+ ;; Make table without horizontal lines. Each column for a key
+ ;; has the form "| LU |" where L is for lower key and and U is
+ ;; for a upper key. If width of L (U) is greater than 1,
+ ;; preceding (following) space is not inserted.
+ (put-text-property 0 1 'face 'bold bar)
+ (setq i 0)
+ (while (< i quail-keyboard-layout-len)
+ (when (= (% i 30) 0)
+ (setq row (/ i 30))
+ (if (> row 1)
+ (insert-char 32 (+ row (/ (- row 2) 2)))))
+ (setq lower (aref layout i)
+ upper (aref layout (1+ i)))
+ (if (and (integerp lower) (>= lower 128) (< lower 256))
+ (setq lower (unibyte-char-to-multibyte lower)))
+ (if (and (integerp upper) (>= upper 128) (< upper 256))
+ (setq upper (unibyte-char-to-multibyte upper)))
+ (insert bar)
+ (if (= (if (stringp lower) (string-width lower) (char-width lower)) 1)
+ (insert " "))
+ (insert lower upper)
+ (if (= (if (stringp upper) (string-width upper) (char-width upper)) 1)
+ (insert " "))
+ (setq i (+ i 2))
+ (if (= (% i 30) 0)
+ (insert bar "\n")))
+ ;; Insert horizontal lines while deleting blank key columns at the
+ ;; beginning and end of each line.
+ (save-restriction
+ (narrow-to-region pos (point))
+ (goto-char pos)
+ ;;(while (looking-at "[| ]*$")
+ ;;(forward-line 1)
+ ;;(delete-region pos (point)))
+ (let ((from1 100) (to1 0) from2 to2)
+ (while (not (eobp))
+ (if (looking-at "[| ]*$")
+ ;; The entire row is blank.
+ (delete-region (point) (match-end 0))
+ ;; Delete blank key columns at the head.
+ (if (looking-at " *\\(| \\)+")
+ (subst-char-in-region (point) (match-end 0) ?| ? ))
+ ;; Delete blank key columns at the tail.
+ (if (re-search-forward "\\( |\\)+$" (line-end-position) t)
+ (delete-region (match-beginning 0) (point)))
+ (beginning-of-line))
+ ;; Calculate the start and end columns of a horizontal line.
+ (if (eolp)
+ (setq from2 from1 to2 to1)
+ (skip-chars-forward " ")
+ (setq from2 (current-column))
+ (end-of-line)
+ (setq to2 (current-column))
+ (if (< from2 from1)
+ (setq from1 from2))
+ (if (> to2 to1)
+ (setq to1 to2))
+ (beginning-of-line))
+ ;; If the previous or the current line has at least one key
+ ;; column, insert a horizontal line.
+ (when (> to1 0)
+ (insert-char 32 from1)
+ (setq pos (point))
+ (insert "+")
+ (insert-char ?- (- (- to1 from1) 2))
+ (insert "+")
+ (put-text-property pos (point) 'face 'bold)
+ (insert "\n"))
+ (setq from1 from2 to1 to2)
+ (forward-line 1)))
+ ;; Insert "space bar" box.
+ (forward-line -1)
+ (setq pos (point))
+ (insert
+" +-----------------------------+
+ | space bar |
+ +-----------------------------+
+")
+ (put-text-property pos (point) 'face 'bold)
+ (insert ?\n)))
+
+ done-list))
+
+;;;###autoload
+(defun quail-show-keyboard-layout (&optional keyboard-type)
+ "Show the physical layout of the keyboard type KEYBOARD-TYPE.
+
+The variable `quail-keyboard-layout-type' holds the currently selected
+keyboard type."
+ (interactive
+ (list (completing-read "Keyboard type (default current choice): "
+ quail-keyboard-layout-alist
+ nil t)))
+ (or (and keyboard-type (> (length keyboard-type) 0))
+ (setq keyboard-type quail-keyboard-layout-type))
+ (let ((layout (assoc keyboard-type quail-keyboard-layout-alist)))
+ (or layout
+ (error "Unknown keyboard type: %s" keyboard-type))
+ (with-output-to-temp-buffer "*Help*"
+ (with-current-buffer standard-output
+ (insert "Keyboard layout (keyboard type: "
+ keyboard-type
+ ")\n")
+ (quail-insert-kbd-layout (cdr layout))))))
;; Quail map
The installed decode map can be referred by the function `quail-decode-map'."
(if (null quail-current-package)
(error "No current Quail package"))
- (if (not (and (consp decode-map) (eq (car decode-map) 'decode-map)))
- (error "Invalid Quail decode map `%s'" decode-map))
- (setcar (nthcdr 10 quail-current-package) decode-map))
+ (if (if (consp decode-map)
+ (eq (car decode-map) 'decode-map)
+ (if (char-table-p decode-map)
+ (eq (char-table-subtype decode-map) 'quail-decode-map)))
+ (setcar (nthcdr 10 quail-current-package) decode-map)
+ (error "Invalid Quail decode map `%s'" decode-map)))
+
;;;###autoload
(defun quail-defrule (key translation &optional name append)
Optional 6th arg PROPS is a property list annotating TRANS. See the
function `quail-define-rules' for the detail."
- (if (null (stringp key))
- "Invalid Quail key `%s'" key)
+ (if (not (or (stringp key) (vectorp key)))
+ (error "Invalid Quail key `%s'" key))
(if (not (or (numberp trans) (stringp trans) (vectorp trans)
(consp trans)
(symbolp trans)
nil)
((stringp def)
- ;; Each character in DEF is a candidate of translation. Reform
- ;; it as (INDICES . VECTOR).
- (setq def (string-to-vector def))
- ;; But if the length is 1, we don't need vector but a single
- ;; candidate as the translation.
+ ;; If the length is 1, we don't need vector but a single candidate
+ ;; as the translation.
(if (= (length def) 1)
(aref def 0)
- (cons (list 0 0 0 0 nil) def)))
+ ;; Each character in DEF is a candidate of translation. Reform
+ ;; it as (INDICES . VECTOR).
+ (cons (list 0 0 0 0 nil) (string-to-vector def))))
((vectorp def)
- ;; Each element (string or character) in DEF is a candidate of
- ;; translation. Reform it as (INDICES . VECTOR).
- (cons (list 0 0 0 0 nil) def))
+ ;; If the length is 1, and the length of element string is 1, we
+ ;; don't need vector but a single candidate as the translation.
+ (if (and (= (length def) 1)
+ (= (length (aref def 0)) 1))
+ (aref (aref def 0) 0)
+ ;; Each element (string or character) in DEF is a candidate of
+ ;; translation. Reform it as (INDICES . VECTOR).
+ (cons (list 0 0 0 0 nil) def)))
(t
(error "Invalid object in Quail map: %s" def))))
-(defun quail-lookup-key (key &optional len)
+(defun quail-lookup-key (key &optional len not-reset-indices)
"Lookup KEY of length LEN in the current Quail map and return the definition.
The returned value is a Quail map specific to KEY."
(or len
(if (not (equal def translation))
;; We must reflect TRANSLATION to car part of MAP.
(setcar map translation)))
- (if (and (consp translation) (vectorp (cdr translation)))
+ (if (and (consp translation) (vectorp (cdr translation)))
(progn
(setq quail-current-translations translation)
- (if (quail-forget-last-selection)
+ (if (and (not not-reset-indices) (quail-forget-last-selection))
(setcar (car quail-current-translations) 0))))))
;; We may have to reform cdr part of MAP.
(if (and (cdr map) (functionp (cdr map)))
(defun quail-error (&rest args)
(signal 'quail-error (apply 'format args)))
+(defun quail-input-string-to-events (str)
+ "Convert input string STR to a list of events.
+Do so while interleaving with the following special events:
+\(compose-last-chars LEN COMPONENTS)
+\(quail-advice INPUT-STRING)"
+ (let* ((events (mapcar
+ (lambda (c)
+ ;; This gives us the chance to unify on input
+ ;; (e.g. using ucs-tables.el).
+ (or (and translation-table-for-input
+ (aref translation-table-for-input c))
+ c))
+ str))
+ (len (length str))
+ (idx len)
+ composition from to)
+ (while (and (> idx 0)
+ (setq composition (find-composition idx 0 str t)))
+ (setq from (car composition) to (nth 1 composition))
+ (setcdr (nthcdr (1- to) events)
+ (cons (list 'compose-last-chars (- to from)
+ (and (not (nth 3 composition)) (nth 2 composition)))
+ (nthcdr to events)))
+ (setq idx (1- from)))
+ (if (or (get-text-property 0 'advice str)
+ (next-single-property-change 0 'advice str))
+ (setq events
+ (nconc events (list (list 'quail-advice str)))))
+ events))
+
(defvar quail-translating nil)
(defvar quail-converting nil)
(defvar quail-conversion-str nil)
(list key)
(quail-setup-overlays (quail-conversion-keymap))
(let ((modified-p (buffer-modified-p))
- (buffer-undo-list t))
- (or (and quail-guidance-win
- (window-live-p quail-guidance-win)
- (eq (window-buffer quail-guidance-win) quail-guidance-buf)
- (not input-method-use-echo-area))
- (quail-show-guidance-buf))
+ (buffer-undo-list t)
+ (inhibit-modification-hooks t))
(unwind-protect
- (if (quail-conversion-keymap)
- (quail-start-conversion key)
- (quail-start-translation key))
+ (let ((input-string (if (quail-conversion-keymap)
+ (quail-start-conversion key)
+ (quail-start-translation key))))
+ (setq quail-guidance-str "")
+ (when (and (stringp input-string)
+ (> (length input-string) 0))
+ (if input-method-exit-on-first-char
+ (list (aref input-string 0))
+ (quail-input-string-to-events input-string))))
(quail-delete-overlays)
- (if (buffer-live-p quail-guidance-buf)
- (save-excursion
- (set-buffer quail-guidance-buf)
- (erase-buffer)))
- (if input-method-use-echo-area
- (quail-hide-guidance-buf))
(set-buffer-modified-p modified-p)
;; Run this hook only when the current input method doesn't require
;; conversion. When conversion is required, the conversion function
(overlay-end quail-overlay))))
(defun quail-start-translation (key)
- "Start translation of the typed character KEY by the current Quail package."
+ "Start translation of the typed character KEY by the current Quail package.
+Return the input string."
;; Check the possibility of translating KEY.
;; If KEY is nil, we can anyway start translation.
(if (or (and (integerp key)
(overriding-terminal-local-map (quail-translation-keymap))
(generated-events nil)
(input-method-function nil)
- (modified-p (buffer-modified-p)))
+ (modified-p (buffer-modified-p))
+ last-command-event last-command this-command)
(setq quail-current-key ""
quail-current-str ""
quail-translating t)
(setq unread-command-events (cons key unread-command-events)))
(while quail-translating
(set-buffer-modified-p modified-p)
- ;; Hide '... loaded' message.
- (message nil)
- (let* ((keyseq (read-key-sequence
- (and input-method-use-echo-area
- (concat input-method-previous-message
- quail-current-str))
- nil nil t))
+ (quail-show-guidance)
+ (let* ((prompt (if input-method-use-echo-area
+ (format "%s%s %s"
+ (or input-method-previous-message "")
+ quail-current-str
+ quail-guidance-str)))
+ (keyseq (read-key-sequence prompt nil nil t))
(cmd (lookup-key (quail-translation-keymap) keyseq)))
(if (if key
(and (commandp cmd) (not (eq cmd 'quail-other-command)))
(eq cmd 'quail-self-insert-command))
(progn
- (setq key t)
(setq last-command-event (aref keyseq (1- (length keyseq)))
last-command this-command
this-command cmd)
+ (setq key t)
(condition-case err
(call-interactively cmd)
(quail-error (message "%s" (cdr err)) (beep))))
(string-to-list (this-single-command-raw-keys)))
(setq quail-translating nil))))
(quail-delete-region)
- (if (and quail-current-str (> (length quail-current-str) 0))
- (let* ((len (length quail-current-str))
- (idx 0)
- (val (find-composition 0 len quail-current-str))
- (advice (get-text-property idx 'advice quail-current-str))
- char)
- ;; If the selected input has `advice' function, generate
- ;; a special event (quail-advice QUAIL-CURRENT-STR).
- (if advice
- (setq generated-events
- (cons (list 'quail-advice quail-current-str)
- generated-events)))
- ;; Push characters in quail-current-str one by one to
- ;; generated-events while interleaving it with a special
- ;; event (compose-last-chars LEN) at each composition
- ;; end.
- (while (<= idx len)
- (when (and val (= idx (nth 1 val)))
- (setq generated-events
- (cons (list 'compose-last-chars (- idx (car val)))
- generated-events))
- (setq val (find-composition idx len quail-current-str)))
- (when (< idx len)
- (setq char (aref quail-current-str idx))
- (or enable-multibyte-characters
- (setq char (multibyte-char-to-unibyte char)))
- (setq generated-events (cons char generated-events)))
- (setq idx (1+ idx)))
- ;; Reorder generated-events.
- (setq generated-events (nreverse generated-events))))
- (if (and input-method-exit-on-first-char generated-events)
- (list (car generated-events))
- generated-events))
+ quail-current-str)
;; Since KEY doesn't start any translation, just return it.
- (list key)))
+ ;; But translate KEY if necessary.
+ (if (quail-kbd-translate)
+ (setq key (quail-keyboard-translate key)))
+ (char-to-string key)))
(defun quail-start-conversion (key)
- "Start conversion of the typed character KEY by the current Quail package."
+ "Start conversion of the typed character KEY by the current Quail package.
+Return the input string."
;; Check the possibility of translating KEY.
;; If KEY is nil, we can anyway start translation.
(if (or (and (integerp key)
(overriding-terminal-local-map (quail-conversion-keymap))
(generated-events nil)
(input-method-function nil)
- (modified-p (buffer-modified-p)))
+ (modified-p (buffer-modified-p))
+ last-command-event last-command this-command)
(setq quail-current-key ""
quail-current-str ""
quail-translating t
quail-current-str ""
quail-translating t)
(quail-setup-overlays nil)))
- ;; Hide '... loaded' message.
- (message nil)
- (let* ((keyseq (read-key-sequence
- (and input-method-use-echo-area
- (concat input-method-previous-message
- quail-conversion-str
- quail-current-str))
- nil nil t))
+ (quail-show-guidance)
+ (let* ((prompt (if input-method-use-echo-area
+ (format "%s%s%s %s"
+ (or input-method-previous-message "")
+ quail-conversion-str
+ quail-current-str
+ quail-guidance-str)))
+ (keyseq (read-key-sequence prompt nil nil t))
(cmd (lookup-key (quail-conversion-keymap) keyseq)))
(if (if key (commandp cmd) (eq cmd 'quail-self-insert-command))
(progn
- (setq key t)
(setq last-command-event (aref keyseq (1- (length keyseq)))
last-command this-command
this-command cmd)
+ (setq key t)
(condition-case err
(call-interactively cmd)
(quail-error (message "%s" (cdr err)) (beep)))
(setq unread-command-events
(string-to-list (this-single-command-raw-keys)))
(setq quail-converting nil))))
+ (setq quail-translating nil)
(if (overlay-start quail-conv-overlay)
(delete-region (overlay-start quail-conv-overlay)
(overlay-end quail-conv-overlay)))
(if (> (length quail-conversion-str) 0)
- (setq generated-events
- (string-to-list
- (if enable-multibyte-characters
- quail-conversion-str
- (string-make-unibyte quail-conversion-str)))))
- (if (and input-method-exit-on-first-char generated-events)
- (list (car generated-events))
- generated-events))
+ quail-conversion-str))
;; Since KEY doesn't start any translation, just return it.
- (list key)))
+ ;; But translate KEY if necessary.
+ (if (quail-kbd-translate)
+ (setq key (quail-keyboard-translate key)))
+ (char-to-string key)))
(defun quail-terminate-translation ()
"Terminate the translation of the current key."
(setq quail-translating nil)
- (if (buffer-live-p quail-guidance-buf)
- (save-excursion
- (set-buffer quail-guidance-buf)
- (erase-buffer))))
+ (setq quail-guidance-str " "))
(defun quail-select-current ()
- "Select the current text shown in Quail translation region."
+ "Accept the currently selected translation."
(interactive)
(quail-terminate-translation))
-;; Update the current translation status according to CONTROL-FLAG.
-;; If CONTROL-FLAG is integer value, it is the number of keys in the
-;; head quail-current-key which can be translated. The remaining keys
-;; are put back to unread-command-events to be handled again. If
-;; CONTROL-FLAG is t, terminate the translation for the whole keys in
-;; quail-current-key. If CONTROL-FLAG is nil, proceed the translation
-;; with more keys.
-
(defun quail-update-translation (control-flag)
+"Update the current translation status according to CONTROL-FLAG.
+If CONTROL-FLAG is integer value, it is the number of keys in the
+head `quail-current-key' which can be translated. The remaining keys
+are put back to `unread-command-events' to be handled again. If
+CONTROL-FLAG is t, terminate the translation for the whole keys in
+`quail-current-key'. If CONTROL-FLAG is nil, proceed the translation
+with more keys."
(let ((func (quail-update-translation-function)))
(if func
(setq control-flag (funcall func control-flag))
- (if (numberp control-flag)
- (let ((len (length quail-current-key)))
- (if (= len 1)
- (setq control-flag t
- quail-current-str quail-current-key)
- (if input-method-exit-on-first-char
- (setq len control-flag)
- (while (> len control-flag)
- (setq len (1- len))
- (setq unread-command-events
- (cons (aref quail-current-key len)
- unread-command-events))))
- (if quail-current-str
- (if input-method-exit-on-first-char
- (setq control-flag t))
- (setq quail-current-str
- (substring quail-current-key 0 len)))))
- (if quail-current-str
- (if (and input-method-exit-on-first-char
- (quail-simple))
- (setq control-flag t))
- (setq quail-current-str quail-current-key)))))
+ (cond ((numberp control-flag)
+ (let ((len (length quail-current-key)))
+ (if (= control-flag 0)
+ (setq quail-current-str
+ (if (quail-kbd-translate)
+ (quail-keyseq-translate quail-current-key)
+ quail-current-key)))
+ (or input-method-exit-on-first-char
+ (while (> len control-flag)
+ (setq len (1- len))
+ (setq unread-command-events
+ (cons (aref quail-current-key len)
+ unread-command-events))))))
+ ((null control-flag)
+ (unless quail-current-str
+ (setq quail-current-str
+ (if (quail-kbd-translate)
+ (quail-keyseq-translate quail-current-key)
+ quail-current-key))
+ (if (and input-method-exit-on-first-char
+ (quail-simple))
+ (setq control-flag t)))))))
(or input-method-use-echo-area
- (progn
+ (let (pos)
(quail-delete-region)
- (insert quail-current-str)))
+ (setq pos (point))
+ (or enable-multibyte-characters
+ (let (char)
+ (if (stringp quail-current-str)
+ (catch 'tag
+ (mapc #'(lambda (ch)
+ (when (/= (unibyte-char-to-multibyte
+ (multibyte-char-to-unibyte ch))
+ ch)
+ (setq char ch)
+ (throw 'tag nil)))
+ quail-current-str))
+ (if (/= (unibyte-char-to-multibyte
+ (multibyte-char-to-unibyte quail-current-str))
+ quail-current-str)
+ (setq char quail-current-str)))
+ (when char
+ (message "Can't input %c in the current unibyte buffer" char)
+ (ding)
+ (sit-for 2)
+ (message nil)
+ (setq quail-current-str nil)
+ (throw 'quail-tag nil))))
+ (insert quail-current-str)
+ (move-overlay quail-overlay pos (point))
+ (if (overlayp quail-conv-overlay)
+ (if (not (overlay-start quail-conv-overlay))
+ (move-overlay quail-conv-overlay pos (point))
+ (if (< (overlay-end quail-conv-overlay) (point))
+ (move-overlay quail-conv-overlay
+ (overlay-start quail-conv-overlay)
+ (point)))))))
(let (quail-current-str)
(quail-update-guidance))
(or (stringp quail-current-str)
(quail-terminate-translation)))
(defun quail-self-insert-command ()
- "Add the typed character to the key for translation."
+ "Translate the typed key by the current Quail map, and insert."
(interactive "*")
(setq quail-current-key
(concat quail-current-key (char-to-string last-command-event)))
;; translation mode.
(setq quail-translating nil)))
-;; Return the actual definition part of Quail map MAP.
(defun quail-map-definition (map)
+"Return the actual definition part of Quail map MAP."
(let ((def (car map)))
(if (and (consp def) (not (vectorp (cdr def))))
(setq def (car def)))
(setq def nil))
def))
-;; Return a string to be shown as the current translation of key
-;; sequence of length LEN. DEF is a definition part of Quail map for
-;; the sequence.
(defun quail-get-current-str (len def)
+ "Return string to be shown as current translation of key sequence.
+LEN is the length of the sequence. DEF is a definition part of the
+Quail map for the sequence."
(or (and (consp def) (aref (cdr def) (car (car def))))
def
(and (> len 1)
- (let ((str (quail-get-current-str
- (1- len)
- (quail-map-definition (quail-lookup-key
- quail-current-key (1- len))))))
+ (let* ((str (quail-get-current-str
+ (1- len)
+ (quail-map-definition (quail-lookup-key
+ quail-current-key (1- len)))))
+ (substr1 (substring quail-current-key (1- len) len))
+ (str1 (and (quail-deterministic)
+ (quail-get-current-str
+ 1
+ (quail-map-definition (quail-lookup-key
+ substr1 1))))))
(if str
(concat (if (stringp str) str (char-to-string str))
- (substring quail-current-key (1- len) len)))))))
+ (if str1
+ (if (stringp str1) str1 (char-to-string str1))
+ substr1)))))))
(defvar quail-guidance-translations-starting-column 20)
-;; Update `quail-current-translations' to make RELATIVE-INDEX the
-;; current translation.
(defun quail-update-current-translations (&optional relative-index)
+ "Update `quail-current-translations'.
+Make RELATIVE-INDEX the current translation."
(let* ((indices (car quail-current-translations))
(cur (car indices))
(start (nth 1 indices))
(< cur start) ; We moved to the previous block.
(>= cur end)) ; We moved to the next block.
(let ((len (length (cdr quail-current-translations)))
- (maxcol (- (window-width quail-guidance-win)
+ (maxcol (- (window-width)
quail-guidance-translations-starting-column))
(block (nth 3 indices))
col idx width trans num-items blocks)
(setcar (nthcdr 2 indices) end)))
(if relative-index
(if (>= (+ start relative-index) end)
- (setcar indices end)
+ (setcar indices (1- end))
(setcar indices (+ start relative-index))))
(setq quail-current-str
(aref (cdr quail-current-translations) (car indices)))
;; giving up, we must check two possibilities.
(cond ((and
(quail-maximum-shortest)
- (>= len 4)
+ (>= len 3)
(setq def (quail-map-definition
(quail-lookup-key quail-current-key (- len 2))))
(quail-lookup-key (substring quail-current-key -2) 2))
;; And, we can terminate the current translation.
t)
+ ((quail-deterministic)
+ ;; No way to handle the last character in this context.
+ ;; Commit the longest successfully translated characters, and
+ ;; handle the remaining characters in a new loop.
+ (setq def nil)
+ (while (and (not def) (> len 1))
+ (setq len (1- len))
+ (setq def (quail-map-definition
+ (quail-lookup-key quail-current-key len))))
+ (if def (setq quail-current-str
+ (quail-get-current-str len def))
+ (setq quail-current-str (aref quail-current-key 0)))
+ len)
+
(t
;; No way to handle the last character in this context.
+ (setq def (quail-map-definition
+ (quail-lookup-key quail-current-key (1- len))))
+ (if def (setq quail-current-str
+ (quail-get-current-str (1- len) def)))
(1- len))))))
(defun quail-next-translation ()
;; Guidance, Completion, and Help buffer handlers.
-;; Make a new one-line frame for Quail guidance buffer.
-(defun quail-make-guidance-frame (buf)
+(defun quail-make-guidance-frame ()
+ "Make a new one-line frame for Quail guidance."
(let* ((fparam (frame-parameters))
(top (cdr (assq 'top fparam)))
(border (cdr (assq 'border-width fparam)))
(newtop (- top
(frame-char-height) (* internal-border 2) (* border 2))))
(if (< newtop 0)
- (setq newtop (+ top (frame-pixel-height))))
- (let* ((frame (make-frame (append '((user-position . t) (height . 1)
- (minibuffer) (menu-bar-lines . 0))
- (cons (cons 'top newtop) fparam))))
- (win (frame-first-window frame)))
- (set-window-buffer win buf)
- ;;(set-window-dedicated-p win t)
- )))
-
-;; Setup Quail completion buffer.
+ (setq newtop (+ top (frame-pixel-height) internal-border border)))
+ (make-frame (append '((user-position . t) (height . 1)
+ (minibuffer)
+ (menu-bar-lines . 0) (tool-bar-lines . 0))
+ (cons (cons 'top newtop) fparam)))))
+
(defun quail-setup-completion-buf ()
+ "Setup Quail completion buffer."
(unless (buffer-live-p quail-completion-buf)
- (setq quail-completion-buf (get-buffer-create "*Quail Completions*"))
- (save-excursion
- (set-buffer quail-completion-buf)
+ (let ((default-enable-multibyte-characters enable-multibyte-characters))
+ (setq quail-completion-buf (get-buffer-create "*Quail Completions*")))
+ (with-current-buffer quail-completion-buf
+ (setq buffer-read-only t)
(setq quail-overlay (make-overlay 1 1))
(overlay-put quail-overlay 'face 'highlight))))
-;; Return t iff the current Quail package requires showing guidance
-;; buffer.
(defun quail-require-guidance-buf ()
+ "Return t iff the current Quail package requires showing guidance buffer."
(and input-method-verbose-flag
(if (eq input-method-verbose-flag 'default)
(not (and (eq (selected-window) (minibuffer-window))
(not (quail-simple))
t))))
-(defun quail-show-guidance-buf ()
- "Display a guidance buffer for Quail input method in some window.
-Create the buffer if it does not exist yet.
-The buffer is normally displayed at the echo area,
-but if the current buffer is a minibuffer, it is shown in
-the bottom-most ordinary window of the same frame,
-or in a newly created frame (if the selected frame has no other windows)."
- (when (quail-require-guidance-buf)
- ;; At first, setup a guidance buffer.
- (or (buffer-live-p quail-guidance-buf)
- (setq quail-guidance-buf (generate-new-buffer " *Quail-guidance*")))
- (let ((name (quail-name))
- (title (quail-title)))
- (save-excursion
- (set-buffer quail-guidance-buf)
- ;; To show the title of Quail package.
- (setq current-input-method name
- current-input-method-title title)
- (erase-buffer)
- (or (overlayp quail-overlay)
- (progn
- (setq quail-overlay (make-overlay 1 1))
- (overlay-put quail-overlay 'face 'highlight)))
- (delete-overlay quail-overlay)
- (set-buffer-modified-p nil)))
- (bury-buffer quail-guidance-buf)
-
- ;; Assign the buffer " *Minibuf-N*" to all windows which are now
- ;; displaying quail-guidance-buf.
- (let ((win-list (get-buffer-window-list quail-guidance-buf t t)))
- (while win-list
- (set-window-buffer (car win-list)
- (format " *Minibuf-%d*" (minibuffer-depth)))
- (setq win-list (cdr win-list))))
-
- ;; Then, display it in an appropriate window.
- (let ((win (minibuffer-window)))
- (if (or (eq (selected-window) win)
- input-method-use-echo-area)
- ;; Since we are in minibuffer, we can't use it for guidance.
- (if (eq win (frame-root-window))
- ;; Create a frame. It is sure that we are using some
- ;; window system.
- (quail-make-guidance-frame quail-guidance-buf)
- ;; Find the bottom window and split it if necessary.
- (let (height)
- (setq win (window-at
- 0 (1- (- (frame-height) (window-height win)))))
- (setq height (window-height win))
- ;; If WIN is tall enough, split it vertically and use
- ;; the lower one.
- (if (>= height 4)
- (let ((window-min-height 2))
- ;; Here, `split-window' returns a lower window
- ;; which is what we wanted.
- (setq win (split-window win (- height 2)))))
- (set-window-buffer win quail-guidance-buf)
- ;;(set-window-dedicated-p win t)
- ))
- (set-window-buffer win quail-guidance-buf)
- (set-minibuffer-window win))
- (setq quail-guidance-win win)))
-
- ;; And, create a buffer for completion.
+
+;; Quail specific version of minibuffer-message. It displays STRING
+;; with timeout 1000000 seconds instead of two seconds.
+
+(defun quail-minibuffer-message (string)
+ (message nil)
+ (let ((point-max (point-max))
+ (inhibit-quit t))
+ (save-excursion
+ (goto-char point-max)
+ (insert string))
+ (sit-for 1000000)
+ (delete-region point-max (point-max))
+ (when quit-flag
+ (setq quit-flag nil
+ unread-command-events '(7)))))
+
+(defun quail-show-guidance ()
+ "Display a guidance for Quail input method in some window.
+The guidance is normally displayed at the echo area,
+or in a newly created frame (if the current buffer is a
+minibuffer and the selected frame has no other windows)."
+ ;; At first, setup a buffer for completion.
(quail-setup-completion-buf)
- (bury-buffer quail-completion-buf))
-
-(defun quail-hide-guidance-buf ()
- "Hide the Quail guidance buffer."
- (if (buffer-live-p quail-guidance-buf)
- (let ((win-list (get-buffer-window-list quail-guidance-buf t t))
- win)
- (while win-list
- (setq win (car win-list) win-list (cdr win-list))
- (if (window-minibuffer-p win)
- ;; We are using echo area for the guidance buffer.
- ;; Vacate it to the deepest minibuffer.
- (set-window-buffer win
- (format " *Minibuf-%d*" (minibuffer-depth)))
- (if (eq win (frame-root-window (window-frame win)))
- (progn
- ;; We are using a separate frame for guidance buffer.
- ;;(set-window-dedicated-p win nil)
- (delete-frame (window-frame win)))
- ;;(set-window-dedicated-p win nil)
- (delete-window win))))
- (setq quail-guidance-win nil))))
+ (bury-buffer quail-completion-buf)
+
+ ;; Then, show the guidance.
+ (when (and (quail-require-guidance-buf)
+ (not input-method-use-echo-area)
+ (null unread-command-events)
+ (null unread-post-input-method-events))
+ (if (eq (selected-window) (minibuffer-window))
+ (if (eq (minibuffer-window) (frame-root-window))
+ ;; Use another frame. It is sure that we are using some
+ ;; window system.
+ (let ((guidance quail-guidance-str))
+ (or (frame-live-p quail-guidance-frame)
+ (setq quail-guidance-frame
+ (quail-make-guidance-frame)))
+ (or (buffer-live-p quail-guidance-buf)
+ (setq quail-guidance-buf
+ (get-buffer-create " *Quail-guidance*")))
+ (save-excursion
+ (set-buffer quail-guidance-buf)
+ (erase-buffer)
+ (setq cursor-type nil)
+ (insert guidance))
+ (set-window-buffer (frame-root-window quail-guidance-frame)
+ quail-guidance-buf)
+ (quail-minibuffer-message
+ (format " [%s]" current-input-method-title)))
+ ;; Show the guidance in the next line of the currrent
+ ;; minibuffer.
+ (quail-minibuffer-message
+ (format " [%s]\n%s"
+ current-input-method-title quail-guidance-str)))
+ ;; Show the guidance in echo area without logging.
+ (let ((message-log-max nil))
+ (message "%s" quail-guidance-str)))))
+
+(defun quail-hide-guidance ()
+ "Hide the Quail guidance."
+ (when (and (quail-require-guidance-buf)
+ (or (eq (selected-window) (minibuffer-window))
+ input-method-use-echo-area)
+ (eq (minibuffer-window) (frame-root-window)))
+ ;; We are using another frame for the guidance.
+ (if (frame-live-p quail-guidance-frame)
+ (delete-frame quail-guidance-frame))
+ (if (buffer-live-p quail-guidance-buf)
+ (kill-buffer quail-guidance-buf))))
(defun quail-update-guidance ()
"Update the Quail guidance buffer and completion buffer (if displayed now)."
- ;; Update guidance buffer.
- (if (quail-require-guidance-buf)
- (let ((guidance (quail-guidance)))
- (or (and (eq (selected-frame) (window-frame (minibuffer-window)))
- (eq (selected-frame) (window-frame quail-guidance-win)))
- (quail-show-guidance-buf))
- (cond ((or (eq guidance t)
- (consp guidance))
- ;; Show the current possible translations.
- (quail-show-translations))
- ((null guidance)
- ;; Show the current input keys.
- (let ((key quail-current-key))
- (save-excursion
- (set-buffer quail-guidance-buf)
- (erase-buffer)
- (insert key)))))))
+ ;; Update the guidance string.
+ (when (quail-require-guidance-buf)
+ (let ((guidance (quail-guidance)))
+ (cond ((or (eq guidance t)
+ (consp guidance))
+ ;; Show the current possible translations.
+ (setq quail-guidance-str
+ (quail-get-translations)))
+ ((null guidance)
+ ;; Show the current input keys.
+ (let ((key quail-current-key))
+ (if (quail-kbd-translate)
+ (setq key (quail-keyseq-translate key)))
+ (setq quail-guidance-str (if (stringp key) key (string key)))))
+ (t
+ (setq quail-guidance-str " ")))))
;; Update completion buffer if displayed now. We highlight the
;; selected candidate string in *Completion* buffer if any.
(delete-overlay quail-overlay)
(setq pos (point))
(if (and str (search-forward (concat "." str) nil t))
- (move-overlay quail-overlay (1+ (match-beginning 0)) (point))
- (move-overlay quail-overlay (match-beginning 0) (point)))
+ (move-overlay quail-overlay (1+ (match-beginning 0)) (point))
+ (move-overlay quail-overlay (match-beginning 0) (point)))
;; Now POS points end of KEY and (point) points end of STR.
(if (pos-visible-in-window-p (point) win)
;; STR is already visible.
(set-window-start win pos))
))))))
-(defun quail-show-translations ()
- "Show the current possible translations."
- (let* ((key quail-current-key)
- (map (quail-lookup-key quail-current-key))
- (current-translations quail-current-translations))
+(defun quail-get-translations ()
+ "Return a string containing the current possible translations."
+ (let ((map (quail-lookup-key quail-current-key nil t))
+ (str (copy-sequence quail-current-key)))
(if quail-current-translations
(quail-update-current-translations))
- (save-excursion
- (set-buffer quail-guidance-buf)
- (erase-buffer)
-
- ;; Show the current key.
- (let ((guidance (quail-guidance)))
- (if (listp guidance)
- ;; We must show the specified PROMPTKEY instead of the
- ;; actual typed keys.
- (let ((i 0)
- (len (length key))
- prompt-key)
- (while (< i len)
- (setq prompt-key (cdr (assoc (aref key i) guidance)))
- (insert (or prompt-key (aref key i)))
- (setq i (1+ i))))
- (insert key)))
- ;; Show followable keys.
- (if (and (> (length key) 0) (cdr map))
- (let ((keys (mapcar (function (lambda (x) (car x)))
- (cdr map))))
- (setq keys (sort keys '<))
- (insert "[")
- (while keys
- (insert (car keys))
- (setq keys (cdr keys)))
- (insert "]")))
+ ;; Show the current key.
+ (let ((guidance (quail-guidance)))
+ (if (listp guidance)
+ ;; We must replace thetyped key with the specified PROMPTKEY.
+ (dotimes (i (length str))
+ (let ((prompt-key (cdr (assoc (aref str i) guidance))))
+ (if prompt-key
+ (aset str i (aref prompt-key 0)))))))
+ ;; Show followable keys.
+ (if (and (> (length quail-current-key) 0) (cdr map))
+ (setq str
+ (format "%s[%s]"
+ str
+ (concat (sort (mapcar (function (lambda (x) (car x)))
+ (cdr map))
+ '<)))))
;; Show list of translations.
- (if (and current-translations
+ (if (and quail-current-translations
(not (quail-deterministic)))
- (let* ((indices (car current-translations))
+ (let* ((indices (car quail-current-translations))
(cur (car indices))
(start (nth 1 indices))
(end (nth 2 indices))
(idx start))
- (indent-to (- quail-guidance-translations-starting-column 7))
- (insert (format "(%02d/"(nth 3 indices))
- (if (nth 4 indices)
- (format "%02d)" (nth 4 indices))
- "??)"))
+ (if (< (string-width str)
+ (- quail-guidance-translations-starting-column 7))
+ (setq str
+ (concat str
+ (make-string
+ (- quail-guidance-translations-starting-column
+ 7 (string-width str))
+ 32))))
+ (setq str (format "%s(%02d/%s)"
+ str (nth 3 indices)
+ (if (nth 4 indices)
+ (format "%02d" (nth 4 indices))
+ "??")))
(while (< idx end)
- (insert (format " %d." (if (= (- idx start) 9) 0
- (1+ (- idx start)))))
- (let ((pos (point)))
- (insert (aref (cdr current-translations) idx))
+ (let ((len (length str))
+ (trans (aref (cdr quail-current-translations) idx)))
+ (or (stringp trans)
+ (setq trans (string trans)))
+ (setq str (format "%s %d.%s"
+ str
+ (if (= (- idx start) 9) 0
+ (1+ (- idx start)))
+ trans))
(if (= idx cur)
- (move-overlay quail-overlay pos (point))))
- (setq idx (1+ idx)))))
- )))
+ (put-text-property (+ len 3) (length str)
+ 'face 'highlight str))
+ (setq idx (1+ idx))))))
+
+ str))
(defvar quail-completion-max-depth 5
"The maximum depth of Quail completion list.")
(quail-setup-completion-buf)
(let ((win (get-buffer-window quail-completion-buf 'visible))
(key quail-current-key)
- (map (quail-lookup-key quail-current-key))
+ (map (quail-lookup-key quail-current-key nil t))
(require-update nil))
- (save-excursion
- (set-buffer quail-completion-buf)
+ (with-current-buffer quail-completion-buf
(if (and win
(equal key quail-current-key)
(eq last-command 'quail-completion))
;; shown. We just scroll it appropriately.
(if (pos-visible-in-window-p (point-max) win)
(set-window-start win (point-min))
- (let ((other-window-scroll-buffer quail-completion-buf))
+ (let ((other-window-scroll-buffer quail-completion-buf)
+ ;; This nil binding is necessary to surely scroll
+ ;; quail-completion-buf.
+ (minibuffer-scroll-window nil))
(scroll-other-window)))
(setq quail-current-key key)
- (erase-buffer)
- (insert "Possible completion and corresponding translations are:\n")
- (quail-completion-1 key map 1)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert "Possible completion and corresponding characters are:\n")
+ (quail-completion-1 key map 1)
+ (set-buffer-modified-p nil))
(goto-char (point-min))
(display-buffer (current-buffer))
(setq require-update t)))
(quail-update-guidance)))
(setq this-command 'quail-completion))
-;; List all completions of KEY in MAP with indentation INDENT.
(defun quail-completion-1 (key map indent)
+"List all completions of KEY in MAP with indentation INDENT."
(let ((len (length key)))
(indent-to indent)
(insert key ":")
(while (< i len)
(aset newkey i (aref key i))
(setq i (1+ i)))
+ (setq l (reverse l))
(while l ; L = ((CHAR . DEFN) ....) ;
(aset newkey len (car (car l)))
(quail-completion-1 newkey (cdr (car l)) indent)
(setq l (cdr l)))))))
-;; List all possible translations of KEY in Quail map MAP with
-;; indentation INDENT.
(defun quail-completion-list-translations (map key indent)
+ "List all possible translations of KEY in Quail MAP with indentation INDENT."
(let (beg (translations
(quail-get-translation (car map) key (length key))))
(if (integerp translations)
(setq i (1+ i)))
(insert "\n")))))
-;; Choose a completion in *Quail Completions* buffer with mouse-2.
-
(defun quail-mouse-choose-completion (event)
"Click on an alternative in the `*Quail Completions*' buffer to choose it."
(interactive "e")
;; This function is an exact copy of the mouse.el function
- ;; `mouse-choose-completion' except that we:
+ ;; `mouse-choose-completion' except that we:
;; 1) add two lines from `choose-completion' in simple.el to give
;; the `mouse-2' click a little more leeway.
- ;; 2) don't bury *Quail Completions* buffer so comment a section, and
+ ;; 2) don't bury *Quail Completions* buffer, so comment a section, and
;; 3) delete/terminate the current quail selection here.
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let ((buffer (window-buffer))
choice
base-size)
- (save-excursion
- (set-buffer (window-buffer (posn-window (event-start event))))
+ (with-current-buffer (window-buffer (posn-window (event-start event)))
(if completion-reference-buffer
(setq buffer completion-reference-buffer))
(setq base-size completion-base-size)
(quail-choose-completion-string choice buffer base-size)
(quail-terminate-translation)))
-;; Modify the simple.el function `choose-completion-string', because
-;; the simple.el function `choose-completion-delete-max-match' breaks
-;; on Mule data, since the semantics of `forward-char' have changed.
-
+;; BASE-SIZE here is for compatibility with an (unused) arg of a
+;; previous implementation.
(defun quail-choose-completion-string (choice &optional buffer base-size)
- (let ((buffer (or buffer completion-reference-buffer)))
- ;; If BUFFER is a minibuffer, barf unless it's the currently
- ;; active minibuffer.
- (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
- (or (not (active-minibuffer-window))
- (not (equal buffer
- (window-buffer (active-minibuffer-window))))))
- (quail-error "Minibuffer is not active for completion")
- ;; Store the completion in `quail-current-str', which will later
- ;; be converted to a character event list, then inserted into
- ;; the buffer where completion was requested.
- (set-buffer buffer)
-; (if base-size
-; (delete-region (+ base-size (point-min)) (point))
-; (choose-completion-delete-max-match choice))
- (setq quail-current-str choice)
- ;; Update point in the window that BUFFER is showing in.
- (let ((window (get-buffer-window buffer t)))
- (set-window-point window (point)))
- ;; If completing for the minibuffer, exit it with this choice.
- (and (not completion-no-auto-exit)
- (equal buffer (window-buffer (minibuffer-window)))
- minibuffer-completion-table
- ;; If this is reading a file name, and the file name chosen
- ;; is a directory, don't exit the minibuffer.
- (if (and (eq minibuffer-completion-table 'read-file-name-internal)
- (file-directory-p (buffer-string)))
- (select-window (active-minibuffer-window))
- (exit-minibuffer))))))
-
-(defun quail-help ()
- "Show brief description of the current Quail package."
+ (setq quail-current-str choice)
+ (choose-completion-string choice buffer))
+
+(defun quail-build-decode-map (map-list key decode-map num
+ &optional maxnum ignores)
+ "Build a decoding map.
+Accumulate in the cdr part of DECODE-MAP all pairs of key sequences
+vs the corresponding translations defined in the Quail map
+specified by the first element MAP-LIST. Each pair has the form
+\(KEYSEQ . TRANSLATION). DECODE-MAP should have the form
+\(decode-map . ALIST), where ALIST is an alist of length NUM. KEY
+is a key sequence to reach MAP.
+Optional 5th arg MAXNUM limits the number of accumulated pairs.
+Optional 6th arg IGNORES is a list of translations to ignore."
+ (let* ((map (car map-list))
+ (translation (quail-get-translation (car map) key (length key)))
+ elt)
+ (cond ((integerp translation)
+ ;; Accept only non-ASCII chars not listed in IGNORES.
+ (when (and (> translation 255) (not (memq translation ignores)))
+ (setcdr decode-map
+ (cons (cons key translation) (cdr decode-map)))
+ (setq num (1+ num))))
+ ((consp translation)
+ (setq translation (cdr translation))
+ (let ((multibyte nil))
+ (mapc (function (lambda (x)
+ ;; Accept only non-ASCII chars not
+ ;; listed in IGNORES.
+ (if (and (if (integerp x) (> x 255)
+ (> (string-bytes x) (length x)))
+ (not (member x ignores)))
+ (setq multibyte t))))
+ translation)
+ (when multibyte
+ (setcdr decode-map
+ (cons (cons key translation) (cdr decode-map)))
+ (setq num (+ num (length translation)))))))
+ (if (and maxnum (> num maxnum))
+ (- num)
+ (setq map (cdr map))
+ ;; Recursively check the deeper map.
+ (while (and map (>= num 0))
+ (setq elt (car map) map (cdr map))
+ (when (and (integerp (car elt)) (consp (cdr elt))
+ (not (memq (cdr elt) map-list)))
+ (setq num (quail-build-decode-map (cons (cdr elt) map-list)
+ (format "%s%c" key (car elt))
+ decode-map num maxnum ignores))))
+ num)))
+
+(defun quail-insert-decode-map (decode-map)
+ "Insert pairs of key sequences vs the corresponding translations.
+These are stored in DECODE-MAP using the concise format. DECODE-MAP
+should be made by `quail-build-decode-map' (which see)."
+ (setq decode-map
+ (sort (cdr decode-map)
+ (function (lambda (x y)
+ (setq x (car x) y (car y))
+ (or (> (length x) (length y))
+ (and (= (length x) (length y))
+ (not (string< x y))))))))
+ (let ((window-width (window-width (get-buffer-window
+ (current-buffer) 'visible)))
+ (single-key-width 3)
+ (single-trans-width 4)
+ (multiple-key-width 3)
+ (single-list nil)
+ (multiple-list nil)
+ elt trans width pos cols rows col row str col-width)
+ ;; Divide the elements of decoding map into single ones (i.e. the
+ ;; one that has single translation) and multibyte ones (i.e. the
+ ;; one that has multiple translations).
+ (while decode-map
+ (setq elt (car decode-map) decode-map (cdr decode-map)
+ trans (cdr elt))
+ (if (and (vectorp trans) (= (length trans) 1))
+ (setq trans (aref trans 0)))
+ (if (vectorp trans)
+ (setq multiple-list (cons elt multiple-list))
+ (setq single-list (cons (cons (car elt) trans) single-list)
+ width (if (stringp trans) (string-width trans)
+ (char-width trans)))
+ (if (> width single-trans-width)
+ (setq single-trans-width width)))
+ (setq width (length (car elt)))
+ (if (> width single-key-width)
+ (setq single-key-width width))
+ (if (> width multiple-key-width)
+ (setq multiple-key-width width)))
+ (when single-list
+ (setq col-width (+ single-key-width 1 single-trans-width 1)
+ cols (/ window-width col-width)
+ rows (/ (length single-list) cols))
+ (if (> (% (length single-list) cols) 0)
+ (setq rows (1+ rows)))
+ (insert "key")
+ (indent-to (1+ single-key-width))
+ (insert "char")
+ (indent-to (1+ col-width))
+ (insert "[type a key sequence to insert the corresponding character]\n")
+ (setq pos (point))
+ (insert-char ?\n (+ rows 2))
+ (goto-char pos)
+ (setq col (- col-width) row 0)
+ (while single-list
+ (setq elt (car single-list) single-list (cdr single-list))
+ (when (= (% row rows) 0)
+ (goto-char pos)
+ (setq col (+ col col-width))
+ (move-to-column col t)
+ (insert-char ?- single-key-width)
+ (insert ? )
+ (insert-char ?- single-trans-width)
+ (forward-line 1))
+ (move-to-column col t)
+ (insert (car elt))
+ (indent-to (+ col single-key-width 1))
+ (insert (cdr elt))
+ (forward-line 1)
+ (setq row (1+ row)))
+ (goto-char (point-max)))
+
+ (when multiple-list
+ (insert "key")
+ (indent-to (1+ multiple-key-width))
+ (insert "character(s) [type a key (sequence) and select one from the list]\n")
+ (insert-char ?- multiple-key-width)
+ (insert " ------------\n")
+ (while multiple-list
+ (setq elt (car multiple-list) multiple-list (cdr multiple-list))
+ (insert (car elt))
+ (indent-to multiple-key-width)
+ (if (vectorp (cdr elt))
+ (mapc (function
+ (lambda (x)
+ (let ((width (if (integerp x) (char-width x)
+ (string-width x))))
+ (when (> (+ (current-column) 1 width) window-width)
+ (insert "\n")
+ (indent-to multiple-key-width))
+ (insert " " x))))
+ (cdr elt))
+ (insert " " (cdr elt)))
+ (insert ?\n))
+ (insert ?\n))))
+
+(define-button-type 'quail-keyboard-layout-button
+ :supertype 'help-xref
+ 'help-function '(lambda (layout)
+ (help-setup-xref `(quail-keyboard-layout-button ,layout) nil)
+ (quail-show-keyboard-layout layout))
+ 'help-echo (purecopy "mouse-2, RET: show keyboard layout"))
+
+(define-button-type 'quail-keyboard-customize-button
+ :supertype 'help-customize-variable
+ 'help-echo (purecopy "mouse-2, RET: customize keyboard layout"))
+
+(defun quail-help (&optional package)
+ "Show brief description of the current Quail package.
+Optional arg PACKAGE specifies the name of alternative Quail
+package to describe."
(interactive)
- (let ((package quail-current-package))
- (with-output-to-temp-buffer "*Quail-Help*"
- (save-excursion
- (set-buffer standard-output)
- (let ((quail-current-package package))
- (insert "Quail input method (name:"
- (quail-name)
- ", mode line indicator:["
- (quail-title)
- "])\n---- Documentation ----\n"
- (quail-docstring))
- (newline)
- (if (quail-show-layout) (quail-show-kbd-layout))
+ (let ((help-xref-mule-regexp help-xref-mule-regexp-template)
+ (default-enable-multibyte-characters enable-multibyte-characters)
+ (package-def
+ (if package
+ (assoc package quail-package-alist)
+ quail-current-package)))
+ ;; At first, make sure that the help buffer has window.
+ (let ((temp-buffer-show-hook nil))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (setq quail-current-package package-def))))
+ ;; Then, insert text in the help buffer while paying attention to
+ ;; the width of the window in which the buffer displayed.
+ (with-current-buffer (help-buffer)
+ (setq buffer-read-only nil)
+ (insert "Input method: " (quail-name)
+ " (mode line indicator:"
+ (quail-title)
+ ")\n\n")
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (quail-docstring))
+ (goto-char (point-min))
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ (while (re-search-forward "\\\\<\\sw\\(\\sw\\|\\s_\\)+>" nil t)
+ (let ((sym (intern-soft
+ (buffer-substring (+ (match-beginning 0) 2)
+ (1- (point))))))
+ (if (and (boundp sym)
+ (stringp (symbol-value sym)))
+ (replace-match (symbol-value sym) t t)))))
+ (goto-char (point-max)))
+ (or (bolp)
+ (insert "\n"))
+ (insert "\n")
+
+ (let ((done-list nil))
+ ;; Show keyboard layout if the current package requests it..
+ (when (quail-show-layout)
+ (insert "
+KEYBOARD LAYOUT
+---------------
+This input method works by translating individual input characters.
+Assuming that your actual keyboard has the `")
+ (help-insert-xref-button
+ quail-keyboard-layout-type
+ 'quail-keyboard-layout-button
+ quail-keyboard-layout-type)
+ (insert "' layout,
+translation results in the following \"virtual\" keyboard layout:
+")
+ (setq done-list
+ (quail-insert-kbd-layout quail-keyboard-layout))
+ (insert "If your keyboard has a different layout, rearranged from
+`")
+ (help-insert-xref-button
+ "standard"
+ 'quail-keyboard-layout-button "standard")
+ (insert "', the \"virtual\" keyboard you get with this input method
+will be rearranged in the same way.
+
+You can set the variable `quail-keyboard-layout-type' to specify
+the physical layout of your keyboard; the tables shown in
+documentation of input methods including this one are based on the
+physical keyboard layout as specified with that variable.
+")
+ (help-insert-xref-button
+ "[customize keyboard layout]"
+ 'quail-keyboard-customize-button 'quail-keyboard-layout-type)
+ (insert "\n"))
+
+ ;; Show key sequences.
+ (let ((decode-map (list 'decode-map))
+ elt pos num)
+ (setq num (quail-build-decode-map (list (quail-map)) "" decode-map
+ 0 512 done-list))
+ (when (> num 0)
+ (insert "
+KEY SEQUENCE
+-----------
+")
+ (if (quail-show-layout)
+ (insert "You can also input more characters")
+ (insert "You can input characters"))
+ (insert " by the following key sequences:\n")
+ (quail-insert-decode-map decode-map))))
+
+ (quail-help-insert-keymap-description
+ (quail-translation-keymap)
+ "\
+KEY BINDINGS FOR TRANSLATION
+----------------------------\n")
+ (insert ?\n)
+ (if (quail-conversion-keymap)
(quail-help-insert-keymap-description
- (quail-translation-keymap)
- "--- Key bindings (while translating) ---
-key binding
---- -------\n")
- (if (quail-conversion-keymap)
- (quail-help-insert-keymap-description
- (quail-conversion-keymap)
- "--- Key bindings (while converting) ---
-key binding
---- -------\n"))
- (help-mode))))))
+ (quail-conversion-keymap)
+ "\
+KEY BINDINGS FOR CONVERSION
+---------------------------\n"))
+ (setq quail-current-package nil)
+ ;; Resize the help window again, now that it has all its contents.
+ (save-selected-window
+ (select-window (get-buffer-window (current-buffer) t))
+ (run-hooks 'temp-buffer-show-hook)))))
(defun quail-help-insert-keymap-description (keymap &optional header)
- (let (from to)
+ (let (pos1 pos2 eol)
+ (setq pos1 (point))
(if header
(insert header))
(save-excursion
- (save-window-excursion
- (let ((overriding-terminal-local-map keymap))
- (describe-bindings))
- (set-buffer "*Help*")
- (goto-char (point-min))
- (forward-line 4)
- (setq from (point))
- (search-forward "Global Bindings:" nil 'move)
- (beginning-of-line)
- (setq to (point))))
- (insert-buffer-substring "*Help*" from to)))
-
-(defun quail-show-kbd-layout ()
- "Show keyboard layout with key tops of multilingual characters."
- (insert "--- Keyboard layout ---\n")
- (let ((blink-matching-paren nil)
- (i 0)
- ch)
- (while (< i quail-keyboard-layout-len)
- (if (= (% i 30) 0)
- (progn
- (newline)
- (indent-to (/ i 30)))
- (if (= (% i 2) 0)
- (insert " ")))
- (setq ch (aref quail-keyboard-layout i))
- (when (and (quail-kbd-translate)
- (/= ch ?\ ))
- ;; This is the case that the current input method simulates
- ;; some keyboard layout (which means it requires keyboard
- ;; translation) and a key at location `i' exists on users
- ;; keyboard. We must translate that key by
- ;; `quail-keyboard-layout-standard'. But if if there's no
- ;; corresponding key in that standard layout, we must simulate
- ;; what is inserted if that key is pressed by setting CH a
- ;; minus value.
- (setq ch (aref quail-keyboard-layout-standard i))
- (if (= ch ?\ )
- (setq ch (- (aref quail-keyboard-layout i)))))
- (if (< ch 0)
- (let ((last-command-event (- ch)))
- (self-insert-command 1))
- (if (= ch ?\ )
- (insert ch)
- (let* ((map (cdr (assq ch (cdr (quail-map)))))
- (translation (and map (quail-get-translation
- (car map) (char-to-string ch) 1))))
- (if (integerp translation)
- (insert translation)
- (if (consp translation)
- (insert (aref (cdr translation) (car (car translation))))
- (let ((last-command-event ch))
- (self-insert-command 1)))))))
- (setq i (1+ i))))
- (newline))
+ (insert (substitute-command-keys "\\{keymap}")))
+ ;; Skip headers "key bindings", etc.
+ (forward-line 3)
+ (setq pos2 (point))
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ (while (re-search-forward "\\sw\\(\\sw\\|\\s_\\)+" nil t)
+ (let ((sym (intern-soft (buffer-substring (match-beginning 0)
+ (point)))))
+ (if (and sym (fboundp sym)
+ (or (eq (get sym 'quail-help) 'hide)
+ (and (quail-deterministic)
+ (eq (get sym 'quail-help) 'non-deterministic))))
+ (delete-region (line-beginning-position)
+ (1+ (line-end-position)))))))
+ (goto-char pos2)
+ (while (not (eobp))
+ (if (looking-at "[ \t]*$")
+ (delete-region (point) (1+ (line-end-position)))
+ (forward-line 1)))
+ (goto-char pos2)
+ (if (eobp)
+ (delete-region pos1 (point)))
+ (goto-char (point-max))))
(defun quail-translation-help ()
"Show help message while translating in Quail input method."
(format "Translating key sequence %S by input method %S.\n"
quail-current-key (quail-name))
keymap (quail-translation-keymap)))
- (with-output-to-temp-buffer "*Quail-Help*"
- (save-excursion
- (set-buffer standard-output)
+ (with-output-to-temp-buffer "*Help*"
+ (with-current-buffer standard-output
(insert state-msg)
(quail-help-insert-keymap-description
keymap
- "-----------------------
-key binding
---- -------\n")
+ "-----------------------\n")
+ ;; Isn't this redundant ? -stef
(help-mode)))))
(let (scroll-help)
(save-selected-window
- (select-window (get-buffer-window "*Quail-Help*"))
+ (select-window (get-buffer-window "*Help*"))
(if (eq this-command last-command)
(if (< (window-end) (point-max))
(scroll-up)
(quail-update-guidance)
))))
\f
+;; Add KEY (string) to the element of TABLE (char-table) for CHAR if
+;; it is not yet stored. As a result, the element is a string or a
+;; list of strings.
+
+(defsubst quail-store-decode-map-key (table char key)
+ (let ((elt (aref table char)))
+ (if elt
+ (if (consp elt)
+ (or (member key elt)
+ (aset table char (cons key elt)))
+ (or (string= key elt)
+ (aset table char (list key elt))))
+ (aset table char key))
+ (if (and translation-table-for-input
+ (setq char (aref translation-table-for-input char)))
+ (let ((translation-table-for-input nil))
+ (quail-store-decode-map-key table char key)))))
+
+;; Helper function for quail-gen-decode-map. Store key strings to
+;; type each character under MAP in TABLE (char-table). MAP is an
+;; element of the current Quail map reached by typing keys in KEY
+;; (string).
+
+(defun quail-gen-decode-map1 (map key table)
+ (when (and (consp map) (listp (cdr map)))
+ (let ((trans (car map)))
+ (cond ((integerp trans)
+ (quail-store-decode-map-key table trans key))
+ ((stringp trans)
+ (dotimes (i (length trans))
+ (quail-store-decode-map-key table (aref trans i) key)))
+ ((or (vectorp trans)
+ (and (consp trans)
+ (setq trans (cdr trans))))
+ (dotimes (i (length trans))
+ (let ((elt (aref trans i)))
+ (if (stringp elt)
+ (if (= (length elt) 1)
+ (quail-store-decode-map-key table (aref elt 0) key))
+ (quail-store-decode-map-key table elt key)))))))
+ (if (> (length key) 1)
+ (dolist (elt (cdr map))
+ (quail-gen-decode-map1 (cdr elt) key table))
+ (dolist (elt (cdr map))
+ (quail-gen-decode-map1 (cdr elt) (format "%s%c" key (car elt))
+ table)))))
+
+(put 'quail-decode-map 'char-table-extra-slots 0)
+
+;; Generate a halfly-cooked decode map (char-table) for the current
+;; Quail map. An element for a character C is a key string or a list
+;; of a key strings to type to input C. The lenth of key string is at
+;; most 2. If it is 2, more keys may be required to input C.
+
+(defun quail-gen-decode-map ()
+ (let ((table (make-char-table 'quail-decode-map nil)))
+ (dolist (elt (cdr (quail-map)))
+ (quail-gen-decode-map1 (cdr elt) (string (car elt)) table))
+ table))
+
+;; Check if CHAR equals to TARGET while also trying to translate CHAR
+;; by translation-table-for-input.
+
+(defsubst quail-char-equal-p (char target)
+ (or (= char target)
+ (and translation-table-for-input
+ (setq char (aref translation-table-for-input char))
+ (= char target))))
+
+;; Helper function for quail-find-key. Prepend key strings to type
+;; for inputting CHAR by the current input method to KEY-LIST and
+;; return the result. MAP is an element of the current Quail map
+;; reached by typing keys in KEY.
+
+(defun quail-find-key1 (map key char key-list)
+ (let ((trans (car map))
+ (found-here nil))
+ (cond ((stringp trans)
+ (setq found-here
+ (and (= (length trans) 1)
+ (quail-char-equal-p (aref trans 0) char))))
+ ((or (vectorp trans) (consp trans))
+ (if (consp trans)
+ (setq trans (cdr trans)))
+ (setq found-here
+ (catch 'tag
+ (dotimes (i (length trans))
+ (let ((target (aref trans i)))
+ (if (integerp target)
+ (if (quail-char-equal-p target char)
+ (throw 'tag t))
+ (if (and (= (length target) 1)
+ (quail-char-equal-p (aref target 0) char))
+ (throw 'tag t))))))))
+ ((integerp trans)
+ (setq found-here (quail-char-equal-p trans char))))
+ (if found-here
+ (setq key-list (cons key key-list)))
+ (if (> (length key) 1)
+ (dolist (elt (cdr map))
+ (setq key-list
+ (quail-find-key1 (cdr elt) (format "%s%c" key (car elt))
+ char key-list))))
+ key-list))
+
+;; If non-nil, the value has the form (QUAIL-MAP . CODING-SYSTEM)
+;; where QUAIL-MAP is a quail-map of which decode map was generated
+;; while buffer-file-coding-system was CODING-SYSTEM.
+
+(defvar quail-decode-map-generated nil)
+
+(defun quail-find-key (char)
+ "Return a list of keys to type to input CHAR in the current input method.
+If CHAR is an ASCII character and can be input by typing itself, return t."
+ (let ((decode-map (or (and (or (not quail-decode-map-generated)
+ (and (eq (car quail-decode-map-generated) (quail-map))
+ (eq (cdr quail-decode-map-generated)
+ (or buffer-file-coding-system t))))
+ (quail-decode-map))
+ (let ((map (quail-gen-decode-map)))
+ (setq quail-decode-map-generated
+ (cons (quail-map) (or buffer-file-coding-system t)))
+ (setcar (nthcdr 10 quail-current-package) map)
+ map)))
+ (key-list nil))
+ (if (consp decode-map)
+ (let ((str (string char)))
+ (mapc #'(lambda (elt)
+ (if (string= str (car elt))
+ (setq key-list (cons (cdr elt) key-list))))
+ (cdr decode-map)))
+ (let ((key-head (aref decode-map char)))
+ (if (stringp key-head)
+ (setq key-list (quail-find-key1
+ (quail-lookup-key key-head nil t)
+ key-head char nil))
+ (mapc #'(lambda (elt)
+ (setq key-list
+ (quail-find-key1
+ (quail-lookup-key elt nil t) elt char key-list)))
+ key-head))))
+ (or key-list
+ (and (< char 128)
+ (not (quail-lookup-key (string char) 1))))))
+
+(defun quail-show-key ()
+ "Show a list of key strings to type for inputting a character at point."
+ (interactive)
+ (or current-input-method
+ (error "No input method is activated"))
+ (or (assoc current-input-method quail-package-alist)
+ (error "The current input method does not use Quail"))
+ (let* ((char (following-char))
+ (key-list (quail-find-key char)))
+ (cond ((consp key-list)
+ (message "To input `%c', type \"%s\""
+ char
+ (mapconcat 'identity key-list "\", \"")))
+ ((eq key-list t)
+ (message "To input `%s', just type it"
+ (single-key-description char)))
+ (t
+ (message "%c can't be input by the current input method" char)))))
+
+\f
;; Quail map generator from state transition table.
(defun quail-map-from-table (table)
(translation-list nil)
map)
(while (> len 0)
- (setq map (quail-lookup-key key len)
+ (setq map (quail-lookup-key key len t)
len (1- len))
(if map
(let* ((def (quail-map-definition map))
(setq list-buf (find-file-noselect leim-list))
;; At first, clean up the file.
- (save-excursion
- (set-buffer list-buf)
+ (with-current-buffer list-buf
(goto-char 1)
;; Insert the correct header.
(with-temp-buffer
(insert-file-contents (car pkg-list))
(goto-char (point-min))
- (while (search-forward "(quail-define-package" nil t)
+ ;; Don't get fooled by commented-out code.
+ (while (re-search-forward "^[ \t]*(quail-define-package" nil t)
(goto-char (match-beginning 0))
(condition-case nil
(let ((form (read (current-buffer))))
- (save-excursion
- (set-buffer list-buf)
+ (with-current-buffer list-buf
(insert
(format "(register-input-method
%S %S '%s
(error
;; Ignore the remaining contents of this file.
(goto-char (point-max))
- (message "Some part of \"%s\" is broken" dirname)))))
+ (message "Some part of \"%s\" is broken" (car pkg-list))))))
(setq pkg-list (cdr pkg-list)))
(setq quail-dirs (cdr quail-dirs) dirnames (cdr dirnames))))
;; At last, write out LEIM list file.
- (save-excursion
- (set-buffer list-buf)
+ (with-current-buffer list-buf
(setq buffer-file-coding-system 'iso-2022-7bit)
(save-buffer 0))
(kill-buffer list-buf)
(message "Updating %s ... done" leim-list)))
\f
(defun quail-advice (args)
- "Advice users about the characters input by the current Quail package.
+ "Advise users about the characters input by the current Quail package.
The argument is a parameterized event of the form:
(quail-advice STRING)
where STRING is a string containing the input characters.
;;
(provide 'quail)
+;;; arch-tag: 46d7db54-5467-42c4-a2a9-53ca90a1e886
;;; quail.el ends here