# HG changeset patch # User Kenichi Handa # Date 965698766 0 # Node ID 321084a896d12fdb01ede07c637cf342ad0bc2b7 # Parent 10eb745f65eb6f89b8b1dd38e97fb08481e65b8f (quail-define-rules): Handle Quail decode map correctly. Add code for supporting annotations. (quail-install-decode-map): New function. (quail-defrule-internal): New optional arguments decode-map and props. (quail-advice): New function. diff -r 10eb745f65eb -r 321084a896d1 lisp/international/quail.el --- a/lisp/international/quail.el Tue Aug 08 01:38:47 2000 +0000 +++ b/lisp/international/quail.el Tue Aug 08 01:39:26 2000 +0000 @@ -676,14 +676,70 @@ 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, - it is used to handle KEY." - `(quail-install-map - ',(let ((l rules) - (map (list nil))) + it is used to handle KEY. + +The first argument may be an alist of annotations for the following +rules. Each element has the form (ANNOTATION . VALUE), where +ANNOTATION is a symbol indicating the annotation type. Currently +the following annotation types are supported. + + append -- the value non-nil means that the following rules should + be appended to the rules of the current Quail package. + + face -- the value is a face to use for displaying TRANSLATIONs in + candidate list. + + advice -- the value is a function to call after one of RULES is + selected. The function is called with one argument, the + selected TRANSLATION string, after the TRANSLATION is + inserted. + + no-decode-map --- the value non-nil means that decoding map is not + generated for the following translations." + (let ((l rules) + append no-decode-map props) + ;; If the first argument is an alist of annotations, handle them. + (if (consp (car (car l))) + (let ((annotations (car l))) + (setq append (assq 'append annotations)) + (if append + (setq annotations (delete append annotations) + append (cdr append))) + (setq no-decode-map (assq 'no-decode-map annotations)) + (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 + (setq props + (cons (car (car annotations)) + (cons (cdr (car annotations)) + props)) + annotations (cdr annotations))) + (setq l (cdr l)))) + ;; Process the remaining arguments one by one. + (if append + ;; There's no way to add new rules at compiling time. + `(let ((tail ',l) + (map (quail-map)) + (decode-map (and (quail-decode-map) (not ,no-decode-map))) + (properties ',props) + key trans) + (while tail + (setq key (car (car tail)) trans (car (cdr (car tail))) + tail (cdr tail)) + (quail-defrule-internal key trans map t decode-map properties))) + ;; We can build up quail map and decode map at compiling time. + (let ((map (list nil)) + (decode-map (if (not no-decode-map) (list 'decode-map))) + key trans) (while l - (quail-defrule-internal (car (car l)) (car (cdr (car l))) map t) - (setq l (cdr l))) - map))) + (setq key (car (car l)) trans (car (cdr (car l))) l (cdr l)) + (quail-defrule-internal key trans map t decode-map props)) + `(if (not (quail-decode-map)) + (quail-install-map ',map) + (quail-install-map ',map) + (quail-install-decode-map ',decode-map)))))) ;;;###autoload (defun quail-install-map (map &optional name) @@ -700,6 +756,20 @@ (setcar (cdr (cdr quail-current-package)) map)) ;;;###autoload +(defun quail-install-decode-map (decode-map &optional name) + "Install the Quail decode map DECODE-MAP in the current Quail package. + +Optional 2nd arg NAME, if non-nil, is a name of Quail package for +which to install 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)) + +;;;###autoload (defun quail-defrule (key translation &optional name append) "Add one translation rule, KEY to TRANSLATION, in the current Quail package. KEY is a string meaning a sequence of keystrokes to be translated. @@ -732,8 +802,16 @@ (quail-defrule-internal key translation (quail-map) append)) ;;;###autoload -(defun quail-defrule-internal (key trans map &optional append) - "Define KEY as TRANS in a Quail map MAP." +(defun quail-defrule-internal (key trans map &optional append decode-map props) + "Define KEY as TRANS in a Quail map MAP. + +If Optional 4th arg APPEND is non-nil, TRANS is appended to the +current translations for KEY instead of replacing them. + +Optional 5th arg DECODE-MAP is a Quail decode map. + +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 (numberp trans) (stringp trans) (vectorp trans) @@ -782,6 +860,28 @@ (error "Quail key %s is too short" key) (setcdr entry trans)) (setcdr entry (append trans (cdr map))))) + ;; If PROPS is non-nil or DECODE-MAP is non-nil, convert TRANS + ;; to a vector of strings, add PROPS to each string and record + ;; this rule in DECODE-MAP. + (when (and (or props decode-map) + (not (consp trans)) (not (symbolp trans))) + (if (integerp trans) + (setq trans (vector trans)) + (if (stringp trans) + (setq trans (string-to-vector trans)))) + (let ((len (length trans)) + elt) + (while (> len 0) + (setq len (1- len)) + (setq elt (aref trans len)) + (if (integerp elt) + (setq elt (char-to-string elt))) + (aset trans len elt) + (if props + (add-text-properties 0 (length elt) props elt)) + (if decode-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) @@ -984,7 +1084,14 @@ (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 @@ -2251,6 +2358,22 @@ (save-buffer 0)) (kill-buffer list-buf) (message "Updating %s ... done" leim-list))) + +(defun quail-advice (args) + "Advice 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. +If STRING has property `advice' and the value is a function, +call it with one argument STRING." + (interactive "e") + (let* ((string (nth 1 args)) + (func (get-text-property 0 'advice string))) + (if (functionp func) + (funcall func string)))) + +(global-set-key [quail-advice] 'quail-advice) + ;; (provide 'quail)