(defvar quail-current-translations nil
"Cons of indices and vector of possible translations of the current key.")
+(defvar quail-current-data nil
+ "Any Lisp object holding information of current translation status.
+When a key sequence is mapped to TRANS and TRANS is a cons
+of actual translation and some Lisp object to be refered
+for translating the longer key sequence, this variable is set
+to that Lisp object.")
+
;; A flag to control conversion region. Normally nil, but if set to
;; t, it means we must start the new conversion region if new key to
;; be translated is input.
(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."
- (while libraries
- (if (not (load (car libraries) t))
- (progn
- (with-output-to-temp-buffer "*Help*"
- (princ "Quail package \"")
- (princ package-name)
- (princ "\" can't be activated\n because library \"")
- (princ (car libraries))
- (princ "\" is not in `load-path'.
+ (let ((package (quail-package package-name)))
+ (if (null package)
+ ;; Perhaps we have not yet loaded necessary libraries.
+ (while libraries
+ (if (not (load (car libraries) t))
+ (progn
+ (with-output-to-temp-buffer "*Help*"
+ (princ "Quail package \"")
+ (princ package-name)
+ (princ "\" can't be activated\n because library \"")
+ (princ (car libraries))
+ (princ "\" is not in `load-path'.
The most common case is that you have not yet installed appropriate
libraries in LEIM (Libraries of Emacs Input Method) which is
distributed separately from Emacs.
-Installation of LEIM for Quail is very simple, just copy Quail
-packages (byte-compiled Emacs Lisp files) to somewhere in your
-`load-path'.
-
LEIM is available from the same ftp directory as Emacs."))
- (error "Can't use the Quail package `%s'" package-name))
- (setq libraries (cdr libraries))))
+ (error "Can't use the Quail package `%s'" package-name))
+ (setq libraries (cdr libraries))))))
(quail-select-package package-name)
(setq current-input-method-title (quail-title))
(quail-mode 1))
This map is activated while convesion region is active but translation
region is not active.")
+;;;###autoload
(defun quail-define-package (name language title
&optional guidance docstring translation-keys
forget-last-selection deterministic
forget-last-selection deterministic kbd-translate show-layout
(if create-decode-map (list 'decode-map) nil)
maximum-shortest overlay-plist update-translation-function
- conversion-keymap)))
- (register-input-method language (list name 'quail-use-package))
+ conversion-keymap))
+ ;; Update TITLE field.
+ (let ((slot (assoc name input-method-alist)))
+ (if slot (setcar (nthcdr 4 slot) docstring))))
(quail-select-package name))
;; Quail minor mode handlers.
(if (overlayp quail-conv-overlay)
(delete-overlay quail-conv-overlay)))
-;; While translating and converting, we enter the recursive edit and
-;; exit it frequently, which results in frequent and annoying change
-;; of and annoying in mode line. To avoid it, we use a modified
-;; mode-line-format.
+;; While translating and converting, we enter and exit the recursive
+;; edit frequently, which results in frequent and annoying change of
+;; mode line. To avoid it, we use a modified mode-line-format.
(defvar quail-mode-line-format nil)
;; Return a modified mode-line-format which doesn't show the recursive
format \(INDEX . VECTOR), as described above."
(and (consp object)
(let ((translation (car object)))
- (or (integerp translation) (consp translation) (null translation)
+ (or (integerp translation) (null translation)
(vectorp translation) (stringp translation)
- (symbolp translation)))
+ (symbolp translation)
+ (and (consp translation) (not (vectorp (cdr translation))))))
(let ((alist (cdr object)))
- (or (listp alist) (symbolp alist)))))
+ (or (and (listp alist) (consp (car alist)))
+ (symbolp alist)))))
+;;;###autoload
(defmacro quail-define-rules (&rest rules)
"Define translation rules of the current Quail package.
Each argument is a list of KEY and TRANSLATION.
(setq l (cdr l)))
map)))
+;;;###autoload
(defun quail-install-map (map)
"Install the Quail map MAP in the current Quail package.
The installed map can be referred by the function `quail-map'."
(error "Invalid Quail map `%s'" map))
(setcar (cdr (cdr quail-current-package)) map))
+;;;###autoload
(defun quail-defrule (key translation &optional name)
"Add one translation rule, KEY to TRANSLATION, in the current Quail package.
KEY is a string meaning a sequence of keystrokes to be translated.
-TRANSLATION is a character, a string, a vector, a Quail map, or a function.
+TRANSLATION is a character, a string, a vector, a Quail map,
+a function, or a cons.
It it is a character, it is the sole translation of KEY.
If it is a string, each character is a candidate for the translation.
If it is a vector, each element (string or character) is a candidate
for the translation.
+If it is a cons, the car is one of the above and the cdr is a function
+to call when translating KEY.
In these cases, a key specific Quail map is generated and assigned to KEY.
If TRANSLATION is a Quail map or a function symbol which returns a Quail map,
(quail-defrule-internal key translation (quail-map)))
;; Define KEY as TRANS in a Quail map MAP.
+;;;###autoload
(defun quail-defrule-internal (key trans map)
(if (null (stringp key))
"Invalid Quail key `%s'" key)
(if (not (or (numberp trans) (stringp trans) (vectorp trans)
+ (consp trans)
(symbolp trans)
(quail-map-p trans)))
(error "Invalid Quail translation `%s'" trans))
(let ((len (length key))
(idx 0)
ch entry)
+ ;; Make a map for registering TRANS if necessary.
(while (< idx len)
(if (null (consp map))
;; We come here, for example, when we try to define a rule
(setcdr entry (append trans (cdr map)))))
(setcar map trans)))))
-(defun quail-get-translation (map key len)
- "Return the translation specified in Quail map MAP for KEY of length LEN.
+(defun quail-get-translation (def key len)
+ "Return the translation specified as DEF for KEY of length LEN.
The translation is either a character or a cons of the form (INDEX . VECTOR),
where VECTOR is a vector of candidates (character or string) for
the translation, and INDEX points into VECTOR to specify the currently
selected translation."
- (let ((def (car map)))
- (if (and def (symbolp def))
- ;; DEF is a symbol of a function which returns valid translation.
- (setq def (funcall def key len)))
- (cond
- ((or (integerp def) (consp def))
- def)
-
- ((null def)
- ;; No translation.
- nil)
-
- ((stringp def)
- ;; Each character in DEF is a candidate of translation. Reform
- ;; it as (INDEX . VECTOR).
- (setq def (string-to-vector def))
- ;; But if the length is 1, we don't need vector but a single
- ;; character as the translation.
- (if (= (length def) 1)
- (aref def 0)
- (cons 0 def)))
-
- ((vectorp def)
- ;; Each element (string or character) in DEF is a candidate of
- ;; translation. Reform it as (INDEX . VECTOR).
- (cons 0 def))
-
- (t
- (error "Invalid object in Quail map: %s" def)))))
+ (if (and def (symbolp def))
+ ;; DEF is a symbol of a function which returns valid translation.
+ (setq def (funcall def key len)))
+ (if (and (consp def) (not (vectorp (cdr def))))
+ (setq def (car def)))
+
+ (cond
+ ((or (integerp def) (consp def))
+ def)
+
+ ((null def)
+ ;; No translation.
+ nil)
+
+ ((stringp def)
+ ;; Each character in DEF is a candidate of translation. Reform
+ ;; it as (INDEX . 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 (= (length def) 1)
+ (aref def 0)
+ (cons 0 def)))
+
+ ((vectorp def)
+ ;; Each element (string or character) in DEF is a candidate of
+ ;; translation. Reform it as (INDEX . VECTOR).
+ (cons 0 def))
+
+ (t
+ (error "Invalid object in Quail map: %s" def))))
(defun quail-lookup-key (key len)
"Lookup KEY of length LEN in the current Quail map and return the definition.
(let ((idx 0)
(map (quail-map))
(kbd-translate (quail-kbd-translate))
- slot ch translation)
+ slot ch translation def)
(while (and map (< idx len))
(setq ch (if kbd-translate (quail-keyboard-translate (aref key idx))
(aref key idx)))
(if (and (cdr slot) (symbolp (cdr slot)))
(setcdr slot (funcall (cdr slot) key idx)))
(setq map (cdr slot)))
- (if (and map (setq translation (quail-get-translation map key len)))
+ (setq def (car map))
+ (if (and map (setq translation (quail-get-translation def key len)))
(progn
- ;; We may have to reform car part of MAP.
- (if (not (equal (car map) translation))
- (setcar map translation))
- (if (consp translation)
+ (if (and (consp def) (not (vectorp (cdr def))))
+ (progn
+ (if (not (equal (car def) translation))
+ ;; We must reflect TRANSLATION to car part of DEF.
+ (setcar def translation))
+ (setq quail-current-data
+ (if (functionp (cdr def))
+ (funcall (cdr def))
+ (cdr def))))
+ (if (not (equal def translation))
+ ;; We must reflect TRANSLATION to car part of MAP.
+ (setcar map translation)))
+ (if (and (consp translation) (vectorp (cdr translation)))
(progn
(setq quail-current-translations translation)
(if (quail-forget-last-selection)
def ch)
(if map
(let ((def (car map)))
+ (if (and (consp def) (not (vectorp (cdr def))))
+ (setq def (car def)))
(setq quail-current-str
(if (consp def) (aref (cdr def) (car def)) def))
;; Return t only if we can terminate the current translation.
(quail-maximum-shortest)
(>= len 4)
(setq def (car (quail-lookup-key quail-current-key (- len 2))))
+ (if (and (consp def) (not (vectorp (cdr def))))
+ (setq def (car def)))
(quail-lookup-key (substring quail-current-key -2) 2))
;; Now the sequence is "...ABCD", which can be split into
;; "...AB" and "CD..." to get valid translation.
;; Delete the window for guidance buffer.
(if (or (null input-method-tersely-flag)
(not (eq (selected-window) (minibuffer-window))))
- (progn
- (setq win (get-buffer-window quail-guidance-buf))
- (set-window-dedicated-p win nil)
- (delete-window win))))))
+ (if (setq win (get-buffer-window quail-guidance-buf))
+ (progn
+ (set-window-dedicated-p win nil)
+ (delete-window win)))))))
(defun quail-update-guidance ()
"Update the Quail guidance buffer and completion buffer (if displayed now)."
(defun quail-show-translations ()
"Show the current possible translations."
- (let ((key quail-current-key)
- (map (quail-lookup-key quail-current-key (length quail-current-key))))
+ (let* ((key quail-current-key)
+ (map (quail-lookup-key quail-current-key (length quail-current-key)))
+ (def (car map)))
+ (if (and (consp def) (not (vectorp (cdr def))))
+ (setq def (car def)))
(save-excursion
(set-buffer quail-guidance-buf)
(erase-buffer)
(insert "]")))
;; Show list of translations.
- (if (consp (car map))
- (let* ((idx (car (car map)))
- (translations (cdr (car map)))
+ (if (and (not (quail-deterministic)) (consp def))
+ (let* ((idx (car def))
+ (translations (cdr def))
(from (* (/ idx 10) 10))
(to (min (+ from 10) (length translations))))
(indent-to 10)
;; indentation INDENT.
(defun quail-completion-list-translations (map key indent)
(let ((translations
- (quail-get-translation map key (length key))))
+ (quail-get-translation (car map) key (length key))))
(if (integerp translations)
(insert "(1/1) 1." translations "\n")
;; We need only vector part.
(insert ch)
(let* ((map (cdr (assq ch (cdr (quail-map)))))
(translation (and map (quail-get-translation
- map (char-to-string ch) 1))))
+ (car map) (char-to-string ch) 1))))
(if (integerp translation)
(insert translation)
(if (consp translation)
(set-buffer-modified-p nil))
(display-buffer buf)))
+\f
+(defvar quail-directory-name "quail"
+ "Name of Quail directory which cotains Quail packages.
+This is a sub-directory of LEIM directory.")
+
+;;;###autoload
+(defun quail-update-leim-list-file (dirname)
+ "Update entries for Quail packages in LEIM list file of directory DIRNAME.
+LEIM is a library of Emacs input method."
+ (interactive "FDirectory of LEIM: ")
+ (setq dirname (file-name-as-directory (expand-file-name dirname)))
+ (let ((quail-dir (concat dirname quail-directory-name))
+ (filename (concat dirname leim-list-file-name))
+ list-buf pkg-list pkg-buf pos)
+ (if (not (file-exists-p quail-dir))
+ nil
+ (if (not (file-readable-p quail-dir))
+ (message "Can't write to file \"%s\"" filename)
+ (if (not (file-writable-p filename))
+ (message "Can't write to file \"%s\"" filename)
+ (setq list-buf (find-file-noselect filename))
+ (setq pkg-list (directory-files quail-dir 'full ".*\\.el$" 'nosort))
+ (message "Updating %s ..." filename)
+
+ ;; At first, clean up the file.
+ (save-excursion
+ (set-buffer list-buf)
+ (goto-char 1)
+
+ ;; Insert the correct header.
+ (if (looking-at (regexp-quote leim-list-header))
+ (goto-char (match-end 0))
+ (insert leim-list-header))
+ (setq pos (point))
+ (if (not (re-search-forward leim-list-entry-regexp nil t))
+ nil
+
+ ;; Remove garbages after the header.
+ (goto-char (match-beginning 0))
+ (if (< pos (point))
+ (delete-region pos (point)))
+
+ ;; Remove all entries for Quail.
+ (while (re-search-forward leim-list-entry-regexp nil 'move)
+ (goto-char (match-beginning 0))
+ (setq pos (point))
+ (let ((form (read list-buf)))
+ (if (equal (nth 3 form) ''quail-use-package)
+ (progn
+ (if (eolp) (forward-line 1))
+ (delete-region pos (point))))))))
+
+ ;; Insert entries for Quail.
+ (while pkg-list
+ (message "Checking %s ..." (car pkg-list))
+ (setq pkg-buf (find-file-noselect (car pkg-list)))
+ (save-excursion
+ (set-buffer pkg-buf)
+ (while (search-forward "(quail-define-package" nil t)
+ (goto-char (match-beginning 0))
+ (let ((form (read (current-buffer))))
+ (save-excursion
+ (set-buffer list-buf)
+ (insert (format "(register-input-method
+ %S %S '%s
+ %S %S
+ %S)\n" (nth 1 form) ; PACKAGE-NAME
+ (nth 2 form) ; LANGUAGE
+ 'quail-use-package ; ACTIVATE-FUNC
+ (nth 3 form) ; PACKAGE-TITLE
+ (progn ; PACKAGE-DESCRIPTION (one line)
+ (string-match ".*" (nth 5 form))
+ (match-string 0 (nth 5 form)))
+ (file-relative-name ; PACKAGE-FILENAME
+ (file-name-sans-extension (car pkg-list)) dirname)
+ ))))))
+ (kill-buffer pkg-buf)
+ (setq pkg-list (cdr pkg-list)))
+ (save-excursion
+ (set-buffer list-buf)
+ (setq buffer-file-coding-system 'iso-2022-7bit)
+ (save-buffer))
+ (kill-buffer list-buf)
+ (message "Updating %s ... done" (buffer-file-name list-buf)))))))
;;
(provide 'quail)
projects / emacs.git / commitdiff