;;; quail.el --- provides simple input method for multilingual text
-;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008
+;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; 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
+;; Japanese `TAkusan MAtasete GOmen-nasai', 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
;;; Code:
(require 'help-mode)
+(eval-when-compile (require 'cl-lib))
(defgroup quail nil
"Quail: multilingual input method."
(defsubst quail-name ()
"Return the name of the current Quail package."
(nth 0 quail-current-package))
+
+(defun quail-indent-to (col)
+ (indent-to col)
+ (let ((end (point)))
+ (save-excursion
+ (unless (zerop (skip-chars-backward "\t "))
+ (put-text-property (point) end 'display (list 'space :align-to col))))))
+
;;;###autoload
(defun quail-title ()
"Return the title of the current Quail 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."
(setq translation-keymap (copy-keymap
(if simple quail-simple-translation-keymap
quail-translation-keymap)))
- (while translation-keys
- (define-key translation-keymap
- (car (car translation-keys)) (cdr (car translation-keys)))
- (setq translation-keys (cdr translation-keys))))
+ (dolist (trans translation-keys)
+ (define-key translation-keymap (car trans) (cdr trans))))
(setq translation-keymap
(if simple quail-simple-translation-keymap
quail-translation-keymap)))
(when conversion-keys
(setq conversion-keymap (copy-keymap quail-conversion-keymap))
- (while conversion-keys
- (define-key conversion-keymap
- (car (car conversion-keys)) (cdr (car conversion-keys)))
- (setq conversion-keys (cdr conversion-keys))))
+ (dolist (conv conversion-keys)
+ (define-key conversion-keymap (car conv) (cdr conv))))
(quail-add-package
(list name title (list nil) guidance (or docstring "")
translation-keymap
(if (and (overlayp quail-conv-overlay) (overlay-start quail-conv-overlay))
(delete-overlay quail-conv-overlay)))
-(defun quail-inactivate ()
- "Inactivate Quail input method.
+(defun quail-deactivate ()
+ "Deactivate Quail input method.
-This function runs the normal hook `quail-inactivate-hook'."
+This function runs the normal hook `quail-deactivate-hook'."
(interactive)
(quail-activate -1))
+(define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.3")
+
(defun quail-activate (&optional arg)
"Activate Quail input method.
-With arg, activate Quail input method if and only if arg is positive.
+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.
+method, `quail-deactivate-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
(< (prefix-numeric-value arg) 0))
- ;; Let's inactivate Quail input method.
+ ;; Let's deactivate Quail input method.
(unwind-protect
(progn
(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))
+ (run-hooks
+ 'quail-inactivate-hook ; for backward compatibility
+ 'quail-deactivate-hook))
(kill-local-variable 'input-method-function))
;; Let's activate Quail input method.
(if (null quail-current-package)
(setq name (car (car quail-package-alist)))
(error "No Quail package loaded"))
(quail-select-package name)))
- (setq inactivate-current-input-method-function 'quail-inactivate)
+ (setq deactivate-current-input-method-function 'quail-deactivate)
(setq describe-current-input-method-function 'quail-help)
(quail-delete-overlays)
(setq quail-guidance-str "")
(make-local-variable 'input-method-function)
(setq input-method-function 'quail-input-method)))
+(define-obsolete-variable-alias
+ 'quail-inactivate-hook
+ 'quail-deactivate-hook "24.3")
+
(defun quail-exit-from-minibuffer ()
- (inactivate-input-method)
+ (deactivate-input-method)
(if (<= (minibuffer-depth) 1)
(remove-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)))
")
'("pc105-uk" . "\
\
-`\2541!2\"3\2434$5%6^7&8*9(0)-_=+ \
+`\2541!2\"3\2434$5%6^7&8*9(0)-_=+ \
qQwWeErRtTyYuUiIoOpP[{]} \
aAsSdDfFgGhHjJkKlL;:'@#~ \
\\|zZxXcCvVbBnNmM,<.>/? \
(setq quail-keyboard-layout-substitution subst-list)
;; If there are additional key locations, map them to missing
;; key locations.
- (while missing-list
+ (dolist (missing 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))))))
+ (setcdr (car subst-list) missing))))))
(defcustom quail-keyboard-layout-type "standard"
"Type of keyboard layout used in Quail base input method.
(if translation
(progn
(if (consp translation)
- (if (> (length (cdr translation)) 0)
- (setq translation (aref (cdr translation) 0))
- (setq translation " ")))
+ (setq translation
+ (if (> (length (cdr translation)) 0)
+ (aref (cdr translation) 0)
+ " ")))
(setq done-list (cons translation done-list)))
- (setq translation ch))
+ (setq translation (aref kbd-layout i)))
(aset layout i translation))
(setq i (1+ i)))
(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
+ ;; has the form "| LU |" where L is for lower key 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)
(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)
+ (if (< (if (stringp lower) (string-width lower) (char-width lower)) 2)
(insert " "))
- (insert lower upper)
- (if (= (if (stringp upper) (string-width upper) (char-width upper)) 1)
+ (if (characterp lower)
+ (setq lower
+ (if (eq (get-char-code-property lower 'general-category) 'Mn)
+ ;; Pad the left and right of non-spacing characters.
+ (compose-string (string lower) 0 1
+ (format "\t%c\t" lower))
+ (string lower))))
+ (if (characterp upper)
+ (setq upper
+ (if (eq (get-char-code-property upper 'general-category) 'Mn)
+ ;; Pad the left and right of non-spacing characters.
+ (compose-string (string upper) 0 1
+ (format "\t%c\t" upper))
+ (string upper))))
+ (insert (bidi-string-mark-left-to-right lower)
+ (propertize " " 'invisible t)
+ (bidi-string-mark-left-to-right upper))
+ (if (< (string-width upper) 2)
(insert " "))
(setq i (+ i 2))
(if (= (% i 30) 0)
;;(delete-region pos (point)))
(let ((from1 100) (to1 0) from2 to2)
(while (not (eobp))
- (if (looking-at "[| ]*$")
+ (if (looking-at "[| \u202c\u202d]*$")
;; The entire row is blank.
(delete-region (point) (match-end 0))
;; Delete blank key columns at the head.
- (if (looking-at " *\\(| \\)+")
+ (if (looking-at "\u202d? *\\(| \\)+")
(subst-char-in-region (point) (match-end 0) ?| ? ))
;; Delete blank key columns at the tail.
- (if (re-search-forward "\\( |\\)+$" (line-end-position) t)
+ (if (re-search-forward "\\( |\\)+\u202c?$"
+ (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 " ")
+ (skip-chars-forward " \u202d")
(setq from2 (current-column))
(end-of-line)
(setq to2 (current-column))
(if no-decode-map
(setq annotations (delete no-decode-map annotations)
no-decode-map (cdr no-decode-map)))
- ;; Convert the remaining annoations to property list PROPS.
- (while annotations
+ ;; Convert the remaining annotations to property list PROPS.
+ (dolist (annotation annotations)
(setq props
- (cons (car (car annotations))
- (cons (cdr (car annotations))
- props))
- annotations (cdr annotations)))
+ (cons (car annotation)
+ (cons (cdr annotation)
+ props))))
(setq l (cdr l))))
;; Process the remaining arguments one by one.
(if append
(let ((map (list nil))
(decode-map (if (not no-decode-map) (list 'decode-map)))
key trans)
- (while l
- (setq key (car (car l)) trans (car (cdr (car l))) l (cdr l))
+ (dolist (el l)
+ (setq key (car el) trans (car (cdr el)))
(quail-defrule-internal key trans map t decode-map props))
- `(if (not (quail-decode-map))
- (quail-install-map ',map)
- (quail-install-map ',map)
+ `(if (prog1 (quail-decode-map)
+ (quail-install-map ',map))
(quail-install-decode-map ',decode-map))))))
;;;###autoload
(setq quail-current-package package)))
(quail-defrule-internal key translation (quail-map) append))
+(defun quail-vunion (v1 v2)
+ (apply 'vector
+ ;; No idea why this was here, but it seems to cause the
+ ;; incorrect ordering, according to Nils Anders Danielsson.
+ ;; (nreverse
+ (delete-dups (nconc (append v1 ()) (append v2 ()))))) ;; )
+
;;;###autoload
(defun quail-defrule-internal (key trans map &optional append decode-map props)
"Define KEY as TRANS in a Quail map MAP.
(setcdr decode-map
(cons (cons elt key) (cdr decode-map)))))))
(if (and (car map) append)
- (let ((prev (quail-get-translation (car map) key len)))
- (if (integerp prev)
- (setq prev (vector prev))
- (setq prev (cdr prev)))
+ (let* ((prev (quail-get-translation (car map) key len))
+ (prevchars (if (integerp prev)
+ (vector prev)
+ (cdr prev))))
(if (integerp trans)
(setq trans (vector trans))
(if (stringp trans)
(setq trans (string-to-vector trans))))
- (setq trans
- (cons (list 0 0 0 0 nil)
- (vconcat prev trans)))))
+ (let ((new (quail-vunion prevchars trans)))
+ (setq trans
+ (if (equal new prevchars)
+ ;; Nothing to change, get back to orig value.
+ prev
+ (cons (list 0 0 0 0 nil) new))))))
(setcar map trans)))))
(defun quail-get-translation (def key len)
the translation, and INDEX points into VECTOR to specify the currently
selected translation."
(if (and def (symbolp def))
- (if (functionp def)
- ;; DEF is a symbol of a function which returns valid translation.
- (setq def (funcall def key len))
- (setq def nil)))
+ ;; DEF is a symbol of a function which returns valid translation.
+ (setq def (if (functionp def) (funcall def key len))))
(if (and (consp def) (not (vectorp (cdr def))))
(setq def (car def)))
\(quail-advice STR)"
(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))
+ (or
+ ;; Avoid "obsolete" warnings for translation-table-for-input.
+ (with-no-warnings
+ (and translation-table-for-input
+ (aref translation-table-for-input c)))
+ c))
str)))
(if (or (get-text-property 0 'advice str)
(next-single-property-change 0 'advice str))
(let* ((echo-keystrokes 0)
(help-char nil)
(overriding-terminal-local-map (quail-translation-keymap))
- (generated-events nil)
+ (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
last-command-event last-command this-command)
(set-buffer-modified-p modified-p)
(quail-show-guidance)
(let* ((prompt (if input-method-use-echo-area
- (format "%s%s %s"
+ (format "%s%s %s"
(or input-method-previous-message "")
quail-current-str
quail-guidance-str)))
(let* ((echo-keystrokes 0)
(help-char nil)
(overriding-terminal-local-map (quail-conversion-keymap))
- (generated-events nil)
+ (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
last-command-event last-command this-command)
(quail-setup-overlays nil)))
(quail-show-guidance)
(let* ((prompt (if input-method-use-echo-area
- (format "%s%s%s %s"
+ (format "%s%s%s %s"
(or input-method-previous-message "")
quail-conversion-str
quail-current-str
(maxcol (- (window-width)
quail-guidance-translations-starting-column))
(block (nth 3 indices))
- col idx width trans num-items blocks)
+ col idx width trans num-items)
(if (< cur start)
;; We must calculate from the head.
(setq start 0 block 0)
(frame-char-height) (* internal-border 2) (* border 2))))
(if (< newtop 0)
(setq newtop (+ top (frame-pixel-height) internal-border border)))
+ ;; If I leave the `parent-id' parameter, my frame ends up with 13 lines
+ ;; rather than just 1. Not sure what is really going on, but
+ ;; clearly this parameter is not needed. --Stef
+ (setq fparam (delq (assoc 'parent-id fparam) fparam))
(make-frame (append '((user-position . t) (height . 1)
(minibuffer)
(menu-bar-lines . 0) (tool-bar-lines . 0))
(not input-method-use-echo-area)
(null unread-command-events)
(null unread-post-input-method-events))
- (if (eq (selected-window) (minibuffer-window))
+ (if (minibufferp)
(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
+ (setq quail-guidance-frame
(quail-make-guidance-frame)))
(or (buffer-live-p quail-guidance-buf)
(setq quail-guidance-buf
(erase-buffer)
(setq cursor-type nil)
(insert guidance))
- (set-window-buffer (frame-root-window quail-guidance-frame)
- quail-guidance-buf)
+ (let ((win (frame-root-window quail-guidance-frame)))
+ (set-window-buffer win quail-guidance-buf)
+ (set-window-dedicated-p win t))
(quail-minibuffer-message
(format " [%s]" current-input-method-title)))
- ;; Show the guidance in the next line of the currrent
+ ;; Show the guidance in the next line of the current
;; minibuffer.
(quail-minibuffer-message
- (format " [%s]\n%s"
+ (format " [%s]\n%s"
current-input-method-title quail-guidance-str)))
;; Show the guidance in echo area without logging.
(let ((message-log-max nil))
(- quail-guidance-translations-starting-column
7 (string-width str))
32))))
- (setq str (format "%s(%02d/%s)"
+ (setq str (format "%s(%02d/%s)"
str (nth 3 indices)
(if (nth 4 indices)
(format "%02d" (nth 4 indices))
(trans (aref (cdr quail-current-translations) idx)))
(or (stringp trans)
(setq trans (string trans)))
- (setq str (format "%s %d.%s"
+ (setq str (format "%s %d.%s"
str
(if (= (- idx start) 9) 0
(1+ (- idx start)))
(setq this-command 'quail-completion))
(defun quail-completion-1 (key map indent)
-"List all completions of KEY in MAP with indentation INDENT."
+ "List all completions of KEY in MAP with indentation INDENT."
(let ((len (length key)))
- (indent-to indent)
+ (quail-indent-to indent)
(insert key ":")
(if (and (symbolp map) (fboundp map))
(setq map (funcall map key len)))
(insert " -\n"))
(setq indent (+ indent 2))
(if (and (cdr map) (< (/ (1- indent) 2) quail-completion-max-depth))
- (let ((l (cdr map))
- (newkey (make-string (1+ len) 0))
- (i 0))
+ (let ((l (cdr map)))
(if (functionp l)
(setq l (funcall l)))
- ;; Set KEY in the first LEN characters of NEWKEY.
- (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)))))))
+ (dolist (elt (reverse l)) ; L = ((CHAR . DEFN) ....) ;
+ (quail-completion-1 (concat key (string (car elt)))
+ (cdr elt) indent))))))
(defun quail-completion-list-translations (map key indent)
"List all possible translations of KEY in Quail MAP with indentation INDENT."
(setq translations (cdr translations))
;; Insert every 10 elements with indices in a line.
(let ((len (length translations))
- (i 0)
- num)
+ (i 0))
(while (< i len)
(when (zerop (% i 10))
(when (>= i 10)
(insert "\n")
- (indent-to indent))
+ (quail-indent-to indent))
(insert (format "(%d/%d)" (1+ (/ i 10)) (1+ (/ len 10)))))
;; We show the last digit of FROM while converting
;; 0,1,..,9 to 1,2,..,0.
(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:
- ;; 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
;; 3) delete/terminate the current quail selection here.
+ ;; FIXME: Consolidate with `choose-completion'. The point number
+ ;; 1 has been done, already. The point number 3 should be fairly
+ ;; easy to move to a choose-completion-string-function. So all
+ ;; that's left is point number 2.
+ (interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let ((buffer (window-buffer))
- choice
- base-size)
+ choice)
(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)
(save-excursion
(goto-char (posn-point (event-start event)))
(let (beg end)
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
(setq choice (buffer-substring beg end)))))
-; (let ((owindow (selected-window)))
-; (select-window (posn-window (event-start event)))
-; (if (and (one-window-p t 'selected-frame)
-; (window-dedicated-p (selected-window)))
-; ;; This is a special buffer's frame
-; (iconify-frame (selected-frame))
-; (or (window-dedicated-p (selected-window))
-; (bury-buffer)))
-; (select-window owindow))
+ ;; (let ((owindow (selected-window)))
+ ;; (select-window (posn-window (event-start event)))
+ ;; (if (and (one-window-p t 'selected-frame)
+ ;; (window-dedicated-p (selected-window)))
+ ;; ;; This is a special buffer's frame
+ ;; (iconify-frame (selected-frame))
+ ;; (or (window-dedicated-p (selected-window))
+ ;; (bury-buffer)))
+ ;; (select-window owindow))
(quail-delete-region)
- (quail-choose-completion-string choice buffer base-size)
+ (setq quail-current-str choice)
+ ;; FIXME: We need to pass `base-position' here.
+ ;; FIXME: why do we need choose-completion-string with all its
+ ;; completion-specific logic?
+ (choose-completion-string choice buffer)
(quail-terminate-translation)))
-;; BASE-SIZE here is for compatibility with an (unused) arg of a
-;; previous implementation.
-(defun quail-choose-completion-string (choice &optional buffer base-size)
- (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.
elt)
(cond ((integerp translation)
;; Accept only non-ASCII chars not listed in IGNORES.
- (when (and (> translation 255) (not (memq translation ignores)))
+ (when (and (> translation 127) (not (memq translation ignores)))
(setcdr decode-map
(cons (cons key translation) (cdr decode-map)))
(setq num (1+ num))))
(mapc (function (lambda (x)
;; Accept only non-ASCII chars not
;; listed in IGNORES.
- (if (and (if (integerp x) (> x 255)
+ (if (and (if (integerp x) (> x 127)
(string-match-p "[^[:ascii:]]" x))
(not (member x ignores)))
(setq multibyte t))))
(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)
+ trans)
;; 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 single translation) and multiple 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))
+ (dolist (elt decode-map)
+ (setq 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)))
+ (push elt multiple-list)
+ (push (cons (car elt) trans) single-list)
+ (let ((width (if (stringp trans) (string-width trans)
+ (char-width trans))))
+ (if (> width single-trans-width)
+ (setq single-trans-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)))
+ ;; Figure out how many columns can fit.
+ (let* ((len (length single-list))
+ ;; The longest key is at the end, by virtue of the above `sort'.
+ (max-key-width (max 3 (length (caar (last single-list)))))
+ ;; Starting point: worst case.
+ (col-width (+ max-key-width 1 single-trans-width 1))
+ (cols (/ window-width col-width))
+ rows)
+ ;; Now, let's see if we can pack in a few more columns since
+ ;; the first columns can often be made narrower thanks to the
+ ;; length-sorting.
+ (while (let ((newrows (/ (+ len cols) (1+ cols))) ;Round up.
+ (width 0))
+ (dotimes (col (1+ cols))
+ (let ((last-col-elt (or (nth (1- (* (1+ col) newrows))
+ single-list)
+ (car (last single-list)))))
+ (cl-incf width (+ (max 3 (length (car last-col-elt)))
+ 1 single-trans-width 1))))
+ (< width window-width))
+ (cl-incf cols))
+ (setq rows (/ (+ len cols -1) cols)) ;Round up.
+ (let ((key-width (max 3 (length (car (nth (1- rows) single-list))))))
+ (insert "key")
+ (quail-indent-to (1+ key-width))
+ (insert "char")
+ (quail-indent-to (+ 1 key-width 1 single-trans-width 1)))
+ (insert "[type a key sequence to insert the corresponding character]\n")
+ (let ((pos (point))
+ (col 0))
+ (insert-char ?\n (+ rows 2))
+ (while single-list
+ (goto-char pos)
+ (let* ((key-width (max 3 (length
+ (car (or (nth (1- rows) single-list)
+ (car (last single-list)))))))
+ (col-width (+ key-width 1 single-trans-width 1)))
+ ;; Insert the header-line.
+ (move-to-column col)
+ (quail-indent-to col)
+ (insert-char ?- key-width)
+ (insert ?\s)
+ (insert-char ?- single-trans-width)
+ (forward-line 1)
+ ;; Insert the key-tran pairs.
+ (dotimes (row rows)
+ (let ((elt (pop single-list)))
+ (when elt
+ (move-to-column col)
+ (quail-indent-to col)
+ (insert (propertize (car elt)
+ 'face 'font-lock-comment-face))
+ (quail-indent-to (+ col key-width 1))
+ (insert (cdr elt))
+ (forward-line 1))))
+ (setq col (+ col col-width)))))
+ (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))))
+ ;; Since decode-map is sorted, we known the longest key is at the end.
+ (let ((max-key-width (max 3 (length (caar (last multiple-list))))))
+ (insert "key")
+ (quail-indent-to (1+ max-key-width))
+ (insert "character(s) [type a key (sequence) and select one from the list]\n")
+ (insert-char ?- max-key-width)
+ (insert " ------------\n")
+ (dolist (elt multiple-list)
+ (insert (propertize (car elt)
+ 'face 'font-lock-comment-face))
+ (quail-indent-to max-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")
+ (quail-indent-to max-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-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
;; the width of the window in which the buffer displayed.
(with-current-buffer (help-buffer)
(setq buffer-read-only nil)
+ ;; Without this, a keyboard layout with R2L characters might be
+ ;; displayed reversed, right to left. See the thread starting at
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00062.html
+ ;; for a description of one such situation.
+ (setq bidi-paragraph-direction 'left-to-right)
(insert "Input method: " (quail-name)
" (mode line indicator:"
(quail-title)
(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))
+ (let* ((decode-map (list 'decode-map))
+ (num (quail-build-decode-map (list (quail-map)) "" decode-map
+ ;; We used to use 512 here, but
+ ;; TeX has more than 1000 and
+ ;; it's good to see the list.
+ 0 5120 done-list)))
(when (> num 0)
(insert "
KEY SEQUENCE
(run-hooks 'temp-buffer-show-hook)))))
(defun quail-help-insert-keymap-description (keymap &optional header)
- (let (pos1 pos2 eol)
- (setq pos1 (point))
+ (let ((pos1 (point))
+ pos2)
(if header
(insert header))
(save-excursion
(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)))))
+ ;; Avoid "obsolete" warnings for translation-table-for-input.
+ (with-no-warnings
+ (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
(put 'quail-decode-map 'char-table-extra-slots 0)
-;; Generate a halfly-cooked decode map (char-table) for the current
+;; Generate a half-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
+;; of a key strings to type to input C. The length of key string is at
;; most 2. If it is 2, more keys may be required to input C.
(defun quail-gen-decode-map ()
(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))))
+ ;; Avoid "obsolete" warnings for translation-table-for-input.
+ (with-no-warnings
+ (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
(cdr decode-map)))
(let ((key-head (aref decode-map char)))
(if (stringp key-head)
- (setq key-list (quail-find-key1
+ (setq key-list (quail-find-key1
(quail-lookup-key key-head nil t)
key-head char nil))
(mapc #'(lambda (elt)
TRANSITION-n-m are transition rules from STATE-n, and have the form
\(RULES . STATE-x) or RULES, where STATE-x is one of STATE-n above,
RULES is a symbol whose value is an alist of keys \(string) vs the
-correponding characters or strings. The format of the symbol value of
+corresponding characters or strings. The format of the symbol value of
RULES is the same as arguments to `quail-define-rules'.
If TRANSITION-n-m has the form (RULES . STATE-x), it means that
function `quail-install-map' (which see)."
(let ((state-alist (mapcar (lambda (x) (list (car x))) table))
tail elt)
- ;; STATE-ALIST is an alist of states vs the correponding sub Quail
+ ;; STATE-ALIST is an alist of states vs the corresponding sub Quail
;; map. It is now initialized to ((STATE-0) (STATE-1) ...).
;; Set key sequence mapping rules in cdr part of each element.
(while table
(interactive "FDirectory of LEIM: ")
(setq dirname (expand-file-name dirname))
(let ((leim-list (expand-file-name leim-list-file-name dirname))
- quail-dirs list-buf pkg-list pkg-buf pos)
+ quail-dirs list-buf pkg-list pos)
(if (not (file-writable-p leim-list))
(error "Can't write to file \"%s\"" leim-list))
(message "Updating %s ..." leim-list)
(if (not (re-search-forward leim-list-entry-regexp nil t))
nil
- ;; Remove garbages after the header.
+ ;; Remove garbage after the header.
(goto-char (match-beginning 0))
(if (< pos (point))
(delete-region pos (point)))
;; At last, write out LEIM list file.
(with-current-buffer list-buf
- (let ((coding-system-for-write 'iso-2022-7bit))
+ (let ((coding-system-for-write 'utf-8))
(save-buffer 0)))
(kill-buffer list-buf)
(message "Updating %s ... done" leim-list)))
;;
(provide 'quail)
-;; arch-tag: 46d7db54-5467-42c4-a2a9-53ca90a1e886
;;; quail.el ends here
HCoop / bpt / emacs.git / blobdiff