diff lisp/international/quail.el @ 89943:4c90ffeb71c5

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-15 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-218 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-220 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-221 Restore deleted tagline in etc/TUTORIAL.ru * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-222 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-228 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-229 Remove TeX output files from the archive * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-230 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-247 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-248 src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-249 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-256 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-258 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-265 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-276 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-295 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-296 Allow restarting an existing debugger session that's exited * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-297 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-299 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-300 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-327 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-328 Update from CVS: src/.gdbinit (xsymbol): Fix last change. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-329 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-346 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-353 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-361 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-362 Support " [...]" style defaults in minibuffer-electric-default-mode * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-363 (read-number): Use canonical format for default in prompt. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-364 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-375 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-376 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-377 (Fdisplay_supports_face_attributes_p): Work around bootstrapping problem * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-378 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-380 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-381 Face merging cleanups * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-382 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-384 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-385 src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-386 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-395 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-396 Tweak arch tagging to make build/install-in-place less annoying * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-397 Work around vc-arch problems when building eshell * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-398 Tweak permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-399 Tweak directory permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-400 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-401 More build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-402 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-403 Yet more build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-404 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-409 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-410 Make sure image types are initialized for lookup too * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-411 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-416 Update from CVS

--- a/lisp/international/quail.el	Sat May 29 02:17:09 2004 +0000
+++ b/lisp/international/quail.el	Mon Jun 28 07:56:49 2004 +0000
@@ -1043,9 +1043,13 @@
 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))
+  (if (if (consp decode-map)
+	  (eq (car decode-map) 'decode-map)
+	(if (char-table-p decode-map)
+	    (eq (char-table-subtype decode-map) 'quail-decode-map)))
+      (setcar (nthcdr 10 quail-current-package) decode-map)
+    (error "Invalid Quail decode map `%s'" decode-map)))
+
 
 ;;;###autoload
 (defun quail-defrule (key translation &optional name append)
@@ -1218,7 +1222,7 @@
    (t
     (error "Invalid object in Quail map: %s" def))))
 
-(defun quail-lookup-key (key &optional len)
+(defun quail-lookup-key (key &optional len not-reset-indices)
   "Lookup KEY of length LEN in the current Quail map and return the definition.
 The returned value is a Quail map specific to KEY."
   (or len
@@ -1256,7 +1260,7 @@
 	  (if (and (consp translation) (vectorp (cdr translation)))
 	      (progn
 		(setq quail-current-translations translation)
-		(if (quail-forget-last-selection)
+		(if (and (not not-reset-indices) (quail-forget-last-selection))
 		    (setcar (car quail-current-translations) 0))))))
     ;; We may have to reform cdr part of MAP.
     (if (and (cdr map) (functionp (cdr map)))
@@ -1512,6 +1516,28 @@
       (let (pos)
 	(quail-delete-region)
 	(setq pos (point))
+	(or enable-multibyte-characters
+	    (let (char)
+	      (if (stringp quail-current-str)
+		  (catch 'tag
+		    (mapc #'(lambda (ch)
+			      (when (/= (unibyte-char-to-multibyte
+					 (multibyte-char-to-unibyte ch))
+					ch)
+				  (setq char ch)
+				  (throw 'tag nil)))
+			  quail-current-str))
+		(if (/= (unibyte-char-to-multibyte
+			 (multibyte-char-to-unibyte quail-current-str))
+			quail-current-str)
+		    (setq char quail-current-str)))
+	      (when char
+		(message "Can't input %c in the current unibyte buffer" char)
+		(ding)
+		(sit-for 2)
+		(message nil)
+		(setq quail-current-str nil)
+		(throw 'quail-tag nil))))
 	(insert quail-current-str)
 	(move-overlay quail-overlay pos (point))
 	(if (overlayp quail-conv-overlay)
@@ -2009,7 +2035,7 @@
 
 (defun quail-get-translations ()
   "Return a string containing the current possible translations."
-  (let ((map (quail-lookup-key quail-current-key))
+  (let ((map (quail-lookup-key quail-current-key nil t))
 	(str (copy-sequence quail-current-key)))
     (if quail-current-translations
 	(quail-update-current-translations))
@@ -2080,7 +2106,7 @@
   (quail-setup-completion-buf)
   (let ((win (get-buffer-window quail-completion-buf 'visible))
 	(key quail-current-key)
-	(map (quail-lookup-key quail-current-key))
+	(map (quail-lookup-key quail-current-key nil t))
 	(require-update nil))
     (with-current-buffer quail-completion-buf
       (if (and win
@@ -2556,6 +2582,143 @@
 	  (quail-update-guidance)
 	  ))))
 
+;; Add KEY (string) to the element of TABLE (char-table) for CHAR if
+;; it is not yet stored.  As a result, the element is a string or a
+;; list of strings.
+
+(defsubst quail-store-decode-map-key (table char key)
+  (let ((elt (aref table char)))
+    (if elt
+	(if (consp elt)
+	    (or (member key elt)
+		(aset table char (cons key elt)))
+	  (or (string= key elt)
+	      (aset table char (list key elt))))
+      (aset 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
+;; element of the current Quail map reached by typing keys in KEY
+;; (string).
+
+(defun quail-gen-decode-map1 (map key table)
+  (when (and (consp map) (listp (cdr map)))
+    (let ((trans (car map)))
+      (cond ((integerp trans)
+	     (quail-store-decode-map-key table trans key))
+	    ((stringp trans)
+	     (dotimes (i (length trans))
+	       (quail-store-decode-map-key table (aref trans i) key)))
+	    ((or (vectorp trans)
+		 (and (consp trans)
+		      (setq trans (cdr trans))))
+	     (dotimes (i (length trans))
+	       (let ((elt (aref trans i)))
+		 (if (stringp elt)
+		     (if (= (length elt) 1)
+			 (quail-store-decode-map-key table (aref elt 0) key))
+		   (quail-store-decode-map-key table elt key)))))))
+    (if (> (length key) 1)
+	(dolist (elt (cdr map))
+	  (quail-gen-decode-map1 (cdr elt) key table))
+      (dolist (elt (cdr map))
+	(quail-gen-decode-map1 (cdr elt) (format "%s%c" key (car elt))
+				 table)))))
+
+(put 'quail-decode-map 'char-table-extra-slots 0)
+
+;; Generate a halfly-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
+;; most 2.  If it is 2, more keys may be required to input C.
+
+(defun quail-gen-decode-map ()
+  (let ((table (make-char-table 'quail-decode-map nil)))
+    (dolist (elt (cdr (quail-map)))
+      (quail-gen-decode-map1 (cdr elt) (string (car elt)) table))
+    table))
+
+;; Helper function for quail-find-key.  Prepend key strings to type
+;; for inputting CHAR by the current input method to KEY-LIST and
+;; return the result.  MAP is an element of the current Quail map
+;; reached by typing keys in KEY.
+
+(defun quail-find-key1 (map key char key-list)
+  (let ((trans (car map))
+	(found-here nil))
+    (cond ((stringp trans)
+	   (setq found-here
+		 (and (= (length trans) 1) (= (aref trans 0) char))))
+	  ((or (vectorp trans) (consp trans))
+	   (if (consp trans)
+	       (setq trans (cdr trans)))
+	   (setq found-here
+		 (catch 'tag
+		   (dotimes (i (length trans))
+		     (let ((target (aref trans i)))
+		       (if (integerp target)
+			   (if (= target char)
+			       (throw 'tag t))
+			 (if (and (= (length target) 1)
+				  (= (aref target 0) char))
+			     (throw 'tag t))))))))
+	    ((integerp trans)
+	     (if (= trans char)
+		 (setq found-here t))))
+    (if found-here
+	(setq key-list (cons key key-list)))
+    (if (> (length key) 1)
+	(dolist (elt (cdr map))
+	  (setq key-list
+		(quail-find-key1 (cdr elt) (format "%s%c" key (car elt))
+				     char key-list))))
+    key-list))
+
+(defun quail-find-key (char)
+  "Return a list of keys to type to input CHAR in the current input method.
+If CHAR is an ASCII character and can be input by typing itself, return t."
+  (let ((decode-map (or (quail-decode-map)
+			(setcar (nthcdr 10 quail-current-package)
+				(quail-gen-decode-map))))
+	(key-list nil))
+    (if (consp decode-map)
+	(let ((str (string char)))
+	  (mapc #'(lambda (elt)
+		    (if (string= str (car elt))
+			(setq key-list (cons (cdr elt) key-list))))
+		(cdr decode-map)))
+      (let ((key-head (aref decode-map char)))
+	(if (stringp key-head)
+	    (setq key-list (quail-find-key1 
+			    (quail-lookup-key key-head nil t)
+			    key-head char nil))
+	  (mapc #'(lambda (elt)
+		    (setq key-list
+			  (quail-find-key1
+			   (quail-lookup-key elt nil t) elt char key-list)))
+		key-head))))
+    (or key-list
+	(and (< char 128)
+	     (not (quail-lookup-key (string char) 1))))))
+
+(defun quail-show-key ()
+  "Show a list of key strings to type for inputting a character at point."
+  (interactive)
+  (or current-input-method
+      (error "No input method is activated"))
+  (let* ((char (following-char))
+	 (key-list (quail-find-key char)))
+    (cond ((consp key-list)
+	   (message "To input `%c', type \"%s\""
+		    char
+		    (mapconcat 'identity key-list "\", \"")))
+	  ((eq key-list t)
+	   (message "To input `%s', just type it"
+		    (single-key-description char)))
+	  (t
+	   (message "%c can't be input by the current input method" char)))))
+
+
 ;; Quail map generator from state transition table.
 
 (defun quail-map-from-table (table)
@@ -2661,7 +2824,7 @@
 	 (translation-list nil)
 	 map)
     (while (> len 0)
-      (setq map (quail-lookup-key key len)
+      (setq map (quail-lookup-key key len t)
 	    len (1- len))
       (if map
 	  (let* ((def (quail-map-definition map))