;;; Code:
-(require 'faces)
+(defgroup quail nil
+ "Quail: multilingual input method."
+ :group 'leim)
;; Buffer local variables
most use `quail-simple-translation-keymap' instead.
This map is activated while translation region is active.")
+;; Hide some verbose commands to make the output of quail-help
+;; concise.
+(let ((l '(quail-other-command
+ quail-self-insert-command
+ quail-delete-last-char)))
+ (while l
+ (put (car l) 'quail-help-hide t)
+ (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
(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,<.>/?\\_ \
+ ")
+ )
"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.")
+
+;; 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 'string
+ :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))))))
+
+;; Insert the visual keyboard layout table according to KBD-LAYOUT.
+;; The format of KBD-LAYOUT is the same as `quail-keyboard-layout'.
+(defun quail-insert-kbd-layout (kbd-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 keyboard layout."
+ (interactive
+ (list (completing-read "Keyboard type (default, current choise): "
+ 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*"
+ (save-excursion
+ (set-buffer standard-output)
+ (insert "Keyboard layout (keyboard type: "
+ keyboard-type
+ ")\n")
+ (quail-insert-kbd-layout (cdr layout))))))
;; Quail map
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))))
(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)))
(select-window (active-minibuffer-window))
(exit-minibuffer))))))
+(defun quail-build-decode-map (map key decode-map num &optional maxnum ignores)
+ (let ((translation (quail-get-translation (car map) key (length key)))
+ elt)
+ (cond ((integerp translation)
+ (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)
+ (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))
+ (while (and map (>= num 0))
+ (setq elt (car map) map (cdr map))
+ (when (and (integerp (car elt)) (consp (cdr elt)))
+ (setq num (quail-build-decode-map (cdr elt)
+ (format "%s%c" key (car elt))
+ decode-map num maxnum ignores))))
+ num)))
+
+(defun quail-insert-decode-map (decode-map)
+ (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 ((frame-width (frame-width))
+ (short-key-width 3)
+ (short-trans-width 4)
+ (long-key-width 3)
+ (short-list nil)
+ (long-list nil)
+ elt trans width pos cols rows col row str col-width)
+ ;; Divide the decoding map into shorter one and longer one.
+ (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 long-list (cons elt long-list))
+ (setq short-list (cons (cons (car elt) trans) short-list)
+ width (if (stringp trans) (string-width trans)
+ (char-width trans)))
+ (if (> width short-trans-width)
+ (setq short-trans-width width)))
+ (setq width (length (car elt)))
+ (if (> width short-key-width)
+ (setq short-key-width width))
+ (if (> width long-key-width)
+ (setq long-key-width width)))
+ (when short-list
+ (setq col-width (+ short-key-width 1 short-trans-width 1)
+ cols (/ frame-width col-width)
+ rows (/ (length short-list) cols))
+ (if (> (% (length short-list) cols) 0)
+ (setq rows (1+ rows)))
+ (insert "key")
+ (indent-to (1+ short-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 short-list
+ (setq elt (car short-list) short-list (cdr short-list))
+ (when (= (% row rows) 0)
+ (goto-char pos)
+ (setq col (+ col col-width))
+ (move-to-column col t)
+ (insert-char ?- short-key-width)
+ (insert ? )
+ (insert-char ?- short-trans-width)
+ (forward-line 1))
+ (move-to-column col t)
+ (insert (car elt))
+ (indent-to (+ col short-key-width 1))
+ (insert (cdr elt))
+ (forward-line 1)
+ (setq row (1+ row)))
+ (goto-char (point-max)))
+
+ (when long-list
+ (insert "key")
+ (indent-to (1+ long-key-width))
+ (insert "character(s) [type a key (sequence) and select one from the list]\n")
+ (insert-char ?- long-key-width)
+ (insert " ------------\n")
+ (while long-list
+ (setq elt (car long-list) long-list (cdr long-list))
+ (insert (car elt))
+ (indent-to long-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) frame-width)
+ (insert "\n")
+ (indent-to long-key-width))
+ (insert " " x))))
+ (cdr elt))
+ (insert " " (cdr elt)))
+ (insert ?\n))
+ (insert ?\n))))
+
(defun quail-help (&optional package)
"Show brief description of the current Quail package.
Optional 2nd arg PACKAGE specifies the alternative Quail package to describe."
(interactive)
- (or package
- (setq package quail-current-package))
+ (if package
+ (setq package (assoc package quail-package-alist))
+ (setq package quail-current-package))
(let ((help-xref-mule-regexp help-xref-mule-regexp-template))
(with-output-to-temp-buffer "*Help*"
(save-excursion
(set-buffer standard-output)
(setq quail-current-package package)
- (insert "Quail input method (name:"
- (quail-name)
- ", mode line indicator:["
+ (insert "Input method: " (quail-name)
+ " (mode line indicator:"
(quail-title)
- "])\n\n---- Documentation ----\n"
+ ")\n\n"
(quail-docstring))
- (newline)
- (if (quail-show-layout) (quail-show-kbd-layout))
+ (or (bolp)
+ (insert "\n"))
+ (insert "\n")
+
+ (let ((done-list nil))
+ ;; Show keyboard layout if the current package requests it..
+ (when (quail-show-layout)
+ (insert
+"Physical key layout for this input method is as below.
+You can input a character in the table by typing a key
+at the same location on your keyboard.\n")
+ (setq done-list
+ (quail-insert-kbd-layout quail-keyboard-layout))
+ (insert "It is assumed that your keyboard type is `")
+ (help-insert-xref-button
+ quail-keyboard-layout-type
+ #'quail-show-keyboard-layout quail-keyboard-layout-type
+ "mouse-2, RET: show this layout")
+ (insert "'.
+If the layout is different from your keyboard, or you see the
+different characters when you type keys according to this layout,
+adjust the variable `quail-keyboard-layout-type' ")
+ (help-insert-xref-button
+ "[customize it]"
+ #'customize-variable 'quail-keyboard-layout-type
+ "mouse-2, RET: set keyboard layout type")
+ (insert ".\n"))
+
+ ;; Show key sequences.
+ (let ((decode-map (list 'decode-map))
+ elt pos num)
+ (setq num (quail-build-decode-map (quail-map) "" decode-map
+ 0 512 done-list))
+ (when (> num 0)
+ (insert ?\n)
+ (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)
- (format "--- Key bindings%s ---\n"
- (if (quail-conversion-keymap)
- " (while translating)"
- "")))
+ "--- key bindings for selecting a character ---\n")
+ (insert ?\n)
(if (quail-conversion-keymap)
(quail-help-insert-keymap-description
(quail-conversion-keymap)
- "\n--- Key bindings (while converting) ---\n"))
+ "--- Key bindings for converting a character (sequence) ---\n"))
(setq quail-current-package nil)
(help-setup-xref (list #'quail-help package)
(interactive-p))))))
(defun quail-help-insert-keymap-description (keymap &optional header)
- (let (pos)
+ (let (pos1 pos2 eol)
+ (setq pos1 (point))
(if header
(insert header))
- (setq pos (point))
(insert (substitute-command-keys "\\{keymap}"))
- (goto-char pos)
- (while (search-forward "quail-other-command" nil 'move)
- (delete-region (line-beginning-position) (1+ (line-end-position))))))
-
-(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))
+ (goto-char pos1)
+ ;; 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)
+ (get sym 'quail-help-hide))
+ (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."
projects / emacs.git / commitdiff