comparison lisp/international/quail.el @ 26891:651d521c8f52

(quail-install-map): New optional arg NAME. (quail-get-translation): If DEF is a symbol but not a function, ignore it. (quail-start-translation): Put a key sequence undefined in the translation keymap in unread-command-events, not generated-events. Return parameterized event (compose-last-chars N) if the input characters should be composed. (quail-map-definition): If DEF is t, treat it as nil. (quail-delete-last-char): Delete the quail region. (quail-show-translations): Don't show list of translations if the quail package is deterministic. (quail-completion-max-depth): New variable. (quail-completion-1): Pay attention to the above variable. Fix for the case that a translation is a function. (quail-map-from-table, quail-map-from-table-1, quail-map-from-table-2): New functions. (quail-lookup-map-and-concat): New function

26890:4cd9407a4683

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

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

		  (condition-case err
		      (call-interactively cmd)
		    (quail-error (message "%s" (cdr err)) (beep))))
	      ;; KEYSEQ is not defined in the translation keymap.
	      ;; Let's return the event(s) to the caller.
	      (setq generated-events
		    (string-to-list (this-single-command-raw-keys)))
	      (setq quail-translating nil))))
	(quail-delete-region)
	(if (and quail-current-str (> (length quail-current-str) 0))
	    (setq generated-events
		  (append (string-to-list
			   (if enable-multibyte-characters
			       quail-current-str
			     (string-make-unibyte quail-current-str)))
			  generated-events)))
	(if (and input-method-exit-on-first-char generated-events)
	    (list (car generated-events))
	  generated-events))

    ;; Since KEY doesn't start any translation, just return it.

;; Return the actual definition part of Quail map MAP.
(defun quail-map-definition (map)
  (let ((def (car map)))
    (if (and (consp def) (not (vectorp (cdr def))))
	(setq def (car def)))
    def))

;; Return a string to be shown as the current translation of key
;; sequence of length LEN.  DEF is a definition part of Quail map for
;; the sequence.

  "Delete the last input character from the current Quail key sequence."
  (interactive)
  (if (= (length quail-current-key) 1)
      (quail-abort-translation)
    (setq quail-current-key (substring quail-current-key 0 -1))
    (quail-update-translation (quail-translate-key))))

;; For conversion mode.

(defsubst quail-point-in-conversion-region ()

	      (insert (car keys))
	      (setq keys (cdr keys)))
	    (insert "]")))

      ;; Show list of translations.
      (if current-translations
	  (let* ((indices (car current-translations))
		 (cur (car indices))
		 (start (nth 1 indices))
		 (end (nth 2 indices))
		 (idx start))

		(if (= idx cur)
		    (move-overlay quail-overlay pos (point))))
	      (setq idx (1+ idx)))))
      )))

(defun quail-completion ()
  "List all completions for the current key.
All possible translations of the current key and whole possible longer keys
 are shown."
  (interactive)
  (quail-setup-completion-buf)
  (let ((win (get-buffer-window quail-completion-buf 'visible))
	(key quail-current-key)
	(map (quail-lookup-key quail-current-key))

	(setq map (funcall map key len)))
    (if (car map)
	(quail-completion-list-translations map key (+ indent len 1))
      (insert " -\n"))
    (setq indent (+ indent 2))
    (if (cdr map)
	(let ((l (cdr map))
	      (newkey (make-string (1+ len) 0))
	      (i 0))
	  ;; Set KEY in the first LEN characters of NEWKEY.
	  (while (< i len)
	    (aset newkey i (aref key i))
	    (setq i (1+ i)))
	  (while l			; L = ((CHAR . DEFN) ....) ;

	  (message "%s" (substitute-command-keys scroll-help))
	  (sit-for 1)
	  (message nil)
	  (quail-update-guidance)
	  ))))


(defvar quail-directory-name "quail"
  "Name of Quail directory which contains Quail packages.
This is a sub-directory of LEIM directory.")

26891:651d521c8f52

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

Optional 2nd arg NAME, if non-nil, is a name of Quail package for
which to install MAP.

The installed map can be referred by the function `quail-map'."
  (if (null quail-current-package)
      (error "No current Quail package"))
  (if (null (quail-map-p map))
      (error "Invalid Quail map `%s'" map))

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."
  (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)))
  (if (and (consp def) (not (vectorp (cdr def))))
      (setq def (car def)))

  (cond
   ((or (integerp def) (consp def))

		  (condition-case err
		      (call-interactively cmd)
		    (quail-error (message "%s" (cdr err)) (beep))))
	      ;; KEYSEQ is not defined in the translation keymap.
	      ;; Let's return the event(s) to the caller.
	      (setq unread-command-events
		    (string-to-list (this-single-command-raw-keys)))
	      (setq quail-translating nil))))
	(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)
		(when (and val (= idx (nth 1 val)))
		  (setq generated-events
			(cons (list 'compose-last-chars (- idx (car val)))
			      generated-events))
		  (setq val (find-composition idx len quail-current-str)))
		(when (< idx len)
		  (setq char (aref quail-current-str idx))
		  (or enable-multibyte-characters
		      (setq char (multibyte-char-to-unibyte char)))
		  (setq generated-events (cons char generated-events)))
		(setq idx (1+ idx)))
	      ;; Reorder generated-events.
	      (setq generated-events (nreverse generated-events))))
	(if (and input-method-exit-on-first-char generated-events)
	    (list (car generated-events))
	  generated-events))

    ;; Since KEY doesn't start any translation, just return it.

;; Return the actual definition part of Quail map MAP.
(defun quail-map-definition (map)
  (let ((def (car map)))
    (if (and (consp def) (not (vectorp (cdr def))))
	(setq def (car def)))
    (if (eq def t)
	(setq def nil))
    def))

;; Return a string to be shown as the current translation of key
;; sequence of length LEN.  DEF is a definition part of Quail map for
;; the sequence.

  "Delete the last input character from the current Quail key sequence."
  (interactive)
  (if (= (length quail-current-key) 1)
      (quail-abort-translation)
    (setq quail-current-key (substring quail-current-key 0 -1))
    (quail-delete-region)
    (quail-update-translation (quail-translate-key))))

;; For conversion mode.

(defsubst quail-point-in-conversion-region ()

	      (insert (car keys))
	      (setq keys (cdr keys)))
	    (insert "]")))

      ;; Show list of translations.
      (if (and current-translations
	       (not (quail-deterministic)))
	  (let* ((indices (car current-translations))
		 (cur (car indices))
		 (start (nth 1 indices))
		 (end (nth 2 indices))
		 (idx start))

		(if (= idx cur)
		    (move-overlay quail-overlay pos (point))))
	      (setq idx (1+ idx)))))
      )))

(defvar quail-completion-max-depth 5
  "The maximum depth of Quail completion list.")

(defun quail-completion ()
  "List all completions for the current key.
All possible translations of the current key and whole possible longer keys
are shown (at most to the depth specified `quail-completion-max-depth')."
  (interactive)
  (quail-setup-completion-buf)
  (let ((win (get-buffer-window quail-completion-buf 'visible))
	(key quail-current-key)
	(map (quail-lookup-key quail-current-key))

	(setq map (funcall map key len)))
    (if (car map)
	(quail-completion-list-translations map key (+ indent len 1))
      (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))
	  (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)))
	  (while l			; L = ((CHAR . DEFN) ....) ;

	  (message "%s" (substitute-command-keys scroll-help))
	  (sit-for 1)
	  (message nil)
	  (quail-update-guidance)
	  ))))

;; Quail map generator from state transition table.

(defun quail-map-from-table (table)
  "Make quail map from state transition table TABLE.

TABLE is an alist, the form is:
  ((STATE-0 TRANSITION-0-1 TRANSITION-0-2 ...) (STATE-1 ...) ...)

STATE-n are symbols to denote state.  STATE-0 is the initial state.

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
RULES is the same as arguments to `quail-define-rules'.

If TRANSITION-n-m has the form (RULES . STATE-x), it means that
STATE-n transits to STATE-x when keys in RULES are input.  Recursive
transition is allowed, i.e. STATE-x may be STATE-n.

If TRANSITION-n-m has the form RULES, the transition terminates
when keys in RULES are input.

The generated map can be set for the current Quail package by the
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
    ;; map.  It is now initialized to ((STATE-0) (STATE-1) ...).
    ;; Set key sequence mapping rules in cdr part of each element.
    (while table
      (quail-map-from-table-1 state-alist (car table))
      (setq table (cdr table)))

    ;; Now STATE-ALIST has the form ((STATE-0 MAPPING-RULES) ...).
    ;; Elements of MAPPING-RULES may have the form (STATE-x).  Replace
    ;; them with MAPPING-RULES of STATE-x to make elements of
    ;; STATE-ALIST valid Quail maps.
    (setq tail state-alist)
    (while tail
      (setq elt (car tail) tail (cdr tail))
      (quail-map-from-table-2 state-alist elt))

    ;; Return the Quail map for the initial state.
    (car state-alist)))

;; STATE-INFO has the form (STATE TRANSITION ...).  Set key sequence
;; mapping rules in the element of STATE-ALIST that corresponds to
;; STATE according to TRANSITION ...
(defun quail-map-from-table-1 (state-alist state-info)
  (let* ((state (car state-info))
	 (map (assq state state-alist))
	 (transitions (cdr state-info))
	 elt)
    (while transitions
      (setq elt (car transitions) transitions (cdr transitions))
      (let (rules dst-state key trans)
	;; ELT has the form (RULES-SYMBOL . STATE-x) or RULES-SYMBOL.
	;; STATE-x is one of car parts of STATE-ALIST's elements.
	(if (consp elt)
	    (setq rules (symbol-value (car elt))
		  ;; Set (STATE-x) as branches for all keys in RULES.
		  ;; It is replaced with actual branches for STATE-x
		  ;; later in `quail-map-from-table-2'.
		  dst-state (list (cdr elt)))
	  (setq rules (symbol-value elt)))
	(while rules
	  (setq key (car (car rules)) trans (cdr (car rules))
		rules (cdr rules))
	  (if (stringp trans)
	      (if (= (length trans) 1)
		  (setq trans (aref trans 0))
		(setq trans (string-to-vector trans))))
	  (set-nested-alist key trans map nil dst-state))))))

;; ELEMENT is one element of STATE-ALIST.  ELEMENT is a nested alist;
;; the form is:
;;	(STATE (CHAR NESTED-ALIST) ...)
;; NESTED-ALIST is a nested alist; the form is:
;;	(TRANS (CHAR NESTED-ALIST) ...)
;; or
;;	(TRANS (CHAR NESTED-ALIST) ... . (STATE-x))
;; Here, the task is to replace all occurrences of (STATE-x) with:
;;	(cdr (assq STATE-x STATE-ALIST))

(defun quail-map-from-table-2 (state-alist element)
  (let ((prev element)
	(tail (cdr element))
	 elt)
    (while (cdr tail)
      (setq elt (car tail) prev tail tail (cdr tail))
      (quail-map-from-table-2 state-alist (cdr elt)))
    (setq elt (car tail))
    (if (consp elt)
	(quail-map-from-table-2 state-alist (cdr elt))
      (setcdr prev (cdr (assq elt state-alist))))))

;; Concatenate translations for all heading substrings of KEY in the
;; current Quail map.  Here, `heading substring' means (substring KEY
;; 0 LEN), where LEN is 1, 2, ... (length KEY).
(defun quail-lookup-map-and-concat (key)
  (let* ((len (length key))
	 (translation-list nil)
	 map)
    (while (> len 0)
      (setq map (quail-lookup-key key len)
	    len (1- len))
      (if map
	  (let* ((def (quail-map-definition map))
		 (trans (if (consp def) (aref (cdr def) (car (car def)))
			  def)))
	    (if (integerp trans)
		(setq trans (char-to-string trans)))
	    (setq translation-list (cons trans translation-list)))))
    (apply 'concat translation-list)))


(defvar quail-directory-name "quail"
  "Name of Quail directory which contains Quail packages.
This is a sub-directory of LEIM directory.")