# HG changeset patch # User Kenichi Handa # Date 968294326 0 # Node ID 82c028678fee4084bb79a0980ba11e5a8794c3ba # Parent afa66a3f39dcdb223131234b08bb80c08b64c1ea Don't require face. (quail): New group. (quail-other-command): Dummy command to make quail-help works better. (quail-keyboard-layout-alist): Add Keyboard type "jp106". (quail-keyboard-layout-substitution): New variable. (quail-update-keyboard-layout): New function. (quail-keyboard-layout-type): New customizable variable. (quail-set-keyboard-layout): Call quail-update-keyboard-layout. (quail-keyboard-translate): Pay attention to quail-keyboard-layout-substitution. (quail-insert-kbd-layout): New function. (quail-show-keyboard-layout): New function. (quail-get-translation): If the definition is a vector of length 1, and the element is a string of lenght 1, return the character in that string. (quail-update-current-translations): Fix the case of relative-index out of range. (quail-build-decode-map, quail-insert-decode-map): New Functions. (quail-help): Show keyboard layout by quail-insert-kbd-layout. Show key sequences for all avairable characters. (quail-help-insert-keymap-description): Don't show such verbose key bindings as quail-self-insert-command. diff -r afa66a3f39dc -r 82c028678fee lisp/international/quail.el --- a/lisp/international/quail.el Thu Sep 07 02:38:07 2000 +0000 +++ b/lisp/international/quail.el Thu Sep 07 02:38:46 2000 +0000 @@ -43,7 +43,9 @@ ;;; Code: -(require 'faces) +(defgroup quail nil + "Quail: multilingual input method." + :group 'leim) ;; Buffer local variables @@ -270,6 +272,15 @@ 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)) @@ -319,6 +330,11 @@ 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 @@ -562,6 +578,7 @@ (defvar quail-keyboard-layout-alist (list + (cons "standard" quail-keyboard-layout-standard) '("sun-type3" . "\ \ 1!2@3#4$5%6^7&8*9(0)-_=+\\|`~\ @@ -585,10 +602,61 @@ <>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) @@ -604,36 +672,166 @@ (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 @@ -921,19 +1119,23 @@ 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)))) @@ -1346,7 +1548,7 @@ (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))) @@ -1992,92 +2194,225 @@ (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."