comparison lisp/international/quail.el @ 30656:321084a896d1

(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.

30655:10eb745f65eb

If it is a vector, each element (string or character) is a candidate
  for the translation.
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)))
	(while l
	  (quail-defrule-internal (car (car l)) (car (cdr (car l))) map t)
	  (setq l (cdr l)))
	map)))

;;;###autoload
(defun quail-install-map (map &optional name)
  "Install the Quail map MAP in the current Quail package.

  (if (null quail-current-package)
      (error "No current Quail package"))
  (if (null (quail-map-p map))
      (error "Invalid Quail map `%s'" map))
  (setcar (cdr (cdr quail-current-package)) 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.

	    (error "No Quail package `%s'" name))
	(setq quail-current-package package)))
  (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."
  (if (null (stringp key))
      "Invalid Quail key `%s'" key)
  (if (not (or (numberp trans) (stringp trans) (vectorp trans)
	       (consp trans)
	       (symbolp trans)

		    ;; define a rule for "AB" as a symbol but a rule
		    ;; for "ABC" is already defined.
		    (error "Quail key %s is too short" key)
		  (setcdr entry trans))
	      (setcdr entry (append trans (cdr 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)))

	(quail-delete-region)
	(if (and quail-current-str (> (length quail-current-str) 0))
	    (let* ((len (length quail-current-str))
		   (idx 0)
		   (val (find-composition 0 len quail-current-str))
		   char)
	      ;; 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
	      ;; end.
	      (while (<= idx len)

      (set-buffer list-buf)
      (setq buffer-file-coding-system 'iso-2022-7bit)
      (save-buffer 0))
    (kill-buffer list-buf)
    (message "Updating %s ... done" leim-list)))
;;
(provide 'quail)

;;; quail.el ends here

30656:321084a896d1

If it is a vector, each element (string or character) is a candidate
  for the translation.
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.

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
	  (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)
  "Install the Quail map MAP in the current Quail package.

  (if (null quail-current-package)
      (error "No current Quail package"))
  (if (null (quail-map-p map))
      (error "Invalid Quail map `%s'" map))
  (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.

	    (error "No Quail package `%s'" name))
	(setq quail-current-package package)))
  (quail-defrule-internal key translation (quail-map) append))

;;;###autoload
(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)
	       (consp trans)
	       (symbolp trans)

		    ;; define a rule for "AB" as a symbol but a rule
		    ;; for "ABC" is already defined.
		    (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)
		  (setq prev (vector prev))
		(setq prev (cdr prev)))

	(quail-delete-region)
	(if (and quail-current-str (> (length quail-current-str) 0))
	    (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
	      ;; end.
	      (while (<= idx len)

      (set-buffer list-buf)
      (setq buffer-file-coding-system 'iso-2022-7bit)
      (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)

;;; quail.el ends here