changeset 13916:00065bf711b8

(tmm-prompt): Major cleanups. Handle pop-menu case nicely. Arg BIND renamed to MENU. Look at MENU to decide whether it is a keymap. Arg IN-POPUP now used only in recursive call. Use "Menu bar" as the default menu name. Delete some debugging code.
author Richard M. Stallman <rms@gnu.org>
date Tue, 02 Jan 1996 06:35:43 +0000
parents 1319e4b9aa6c
children c7c63fcb828e
files lisp/tmm.el
diffstat 1 files changed, 98 insertions(+), 75 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/tmm.el	Tue Jan 02 05:59:20 1996 +0000
+++ b/lisp/tmm.el	Tue Jan 02 06:35:43 1996 +0000
@@ -105,91 +105,114 @@
   "What insert on top of completion buffer.")
 
 ;;;###autoload
-(defun tmm-prompt (bind &optional in-popup default-item)
+(defun tmm-prompt (menu &optional in-popup default-item)
   "Text-mode emulation of calling the bindings in keymap.
 Creates a text-mode menu of possible choices.  You can access the elements
 in the menu in two ways:
    *)  via history mechanism from minibuffer;
    *)  Or via completion-buffer that is automatically shown.
 The last alternative is currently a hack, you cannot use mouse reliably.
-If the optional argument IN-POPUP is non-nil, it should compatible with 
-`x-popup-menu', otherwise the argument BIND should be keymap."
-  (if in-popup (if bind (setq bind in-popup) (x-popup-menu nil in-popup)))
-  (let (gl-str tmm-km-list out history history-len tmm-table-undef tmm-c-prompt
-	       tmm-old-mb-map tmm-old-comp-map tmm-short-cuts)
+
+MENU is like the MENU argument to `x-popup-menu': either a
+keymap or an alist of alists.
+DEFAULT-ITEM, if non-nil, specifies an initial default choice.
+Its value should be an event that has a binding in MENU."
+  ;; If the optional argument IN-POPUP is t,
+  ;; then MENU is an alist of elements of the form (STRING . VALUE).
+  ;; That is used for recursive calls only.
+  (let ((gl-str "Menu bar")  ;; The menu bar itself is not a menu keymap
+					; so it doesn't have a name.
+	tmm-km-list out history history-len tmm-table-undef tmm-c-prompt
+	tmm-old-mb-map tmm-old-comp-map tmm-short-cuts
+	chosen-string choice
+	(not-menu (not (keymapp menu))))
     (run-hooks 'activate-menubar-hook)
+    ;; Compute tmm-km-list from MENU.
+    ;; tmm-km-list is an alist of (STRING . MEANING).
+    ;; It has no other elements.
+    ;; The order of elements in tmm-km-list is the order of the menu bar.
     (mapcar (function (lambda (elt)
 			(if (stringp elt)
 			    (setq gl-str elt)
-			  (and (listp elt) (tmm-get-keymap elt in-popup)))))
-	    bind)
-    (setq foo default-item foo1 bind)
-    (and tmm-km-list
-	 (let ((index-of-default 0))
-	   (if tmm-mid-prompt
-	       (setq tmm-km-list (tmm-add-shortcuts tmm-km-list))
-	     t)
-	   ;; Find the default item's index within the menu bar.
-	   ;; We use this to decide the initial minibuffer contents
-	   ;; and initial history position.
-	   (if default-item
-	       (let ((tail bind))
-		 (while (and tail
-			     (not (eq (car-safe (car tail)) default-item)))
-		   ;; Be careful to count only the elements of BIND
-		   ;; that actually constitute menu bar items.
-		   (if (and (consp (car tail))
-			    (stringp (car-safe (cdr (car tail)))))
-		       (setq index-of-default (1+ index-of-default)))
-		   (setq tail (cdr tail)))))
-	   (setq history (reverse (mapcar 'car tmm-km-list)))
-	   (setq history-len (length history))
-	   (setq history (append history history history history))
-	   (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history))
-	   (add-hook 'minibuffer-setup-hook 'tmm-add-prompt)
-	   (unwind-protect
-	       (setq out
-		     (completing-read
-		      (concat gl-str " (up/down to change, PgUp to menu): ")
-		      tmm-km-list nil t nil
-		      (cons 'history (- (* 2 history-len) index-of-default))))
-	     (save-excursion
-	       (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
-	       (if (get-buffer "*Completions*")
-		   (progn
-		     (set-buffer "*Completions*")
-		     (use-local-map tmm-old-comp-map)
-		     (bury-buffer (current-buffer)))))
-	     )))
-    (setq bind (cdr (assoc out tmm-km-list)))
-    (and (null bind)
-	 (> (length out) (length tmm-c-prompt))
-	 (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt)
-	 (setq out (substring out (length tmm-c-prompt))
-	       bind (cdr (assoc out tmm-km-list))))
-    (and (null bind)
-	 (setq out (try-completion out tmm-km-list)
-	       bind (cdr (assoc  out tmm-km-list))))
-    (setq last-command-event (car bind))
-    (setq bind (cdr bind))
-    (if bind
-	 (if in-popup (tmm-prompt t bind)
-	   (if (keymapp bind)
-	       (if (listp bind)
-		   (progn
-		     (condition-case nil
-			 (require 'mouse)
-		       (error nil))
-		     (condition-case nil
-			 (x-popup-menu nil bind) ; Get the shortcuts
-		       (error nil))
-		     (tmm-prompt bind))
-		 (tmm-prompt (symbol-value bind))
-		 )
-	     (if last-command-event
-		 (call-interactively bind)
-	       bind)))
-      gl-str)))
+			  (and (listp elt) (tmm-get-keymap elt not-menu)))))
+	    menu)
+    ;; Choose an element of tmm-km-list; put it in choice.
+    (if (and not-menu (= 1 (length tmm-km-list)))
+	;; If this is the top-level of an x-popup-menu menu,
+	;; and there is just one pane, choose that one silently.
+	;; This way we only ask the user one question,
+	;; for which element of that pane.
+	(setq choice (cdr (car tmm-km-list)))
+      (and tmm-km-list
+	   (let ((index-of-default 0))
+	     (if tmm-mid-prompt
+		 (setq tmm-km-list (tmm-add-shortcuts tmm-km-list))
+	       t)
+	     ;; Find the default item's index within the menu bar.
+	     ;; We use this to decide the initial minibuffer contents
+	     ;; and initial history position.
+	     (if default-item
+		 (let ((tail menu))
+		   (while (and tail
+			       (not (eq (car-safe (car tail)) default-item)))
+		     ;; Be careful to count only the elements of MENU
+		     ;; that actually constitute menu bar items.
+		     (if (and (consp (car tail))
+			      (stringp (car-safe (cdr (car tail)))))
+			 (setq index-of-default (1+ index-of-default)))
+		     (setq tail (cdr tail)))))
+	     (setq history (reverse (mapcar 'car tmm-km-list)))
+	     (setq history-len (length history))
+	     (setq history (append history history history history))
+	     (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history))
+	     (add-hook 'minibuffer-setup-hook 'tmm-add-prompt)
+	     (unwind-protect
+		 (setq out
+		       (completing-read
+			(concat gl-str " (up/down to change, PgUp to menu): ")
+			tmm-km-list nil t nil
+			(cons 'history (- (* 2 history-len) index-of-default))))
+	       (save-excursion
+		 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
+		 (if (get-buffer "*Completions*")
+		     (progn
+		       (set-buffer "*Completions*")
+		       (use-local-map tmm-old-comp-map)
+		       (bury-buffer (current-buffer)))))
+	       )))
+      (setq choice (cdr (assoc out tmm-km-list)))
+      (and (null choice)
+	   (> (length out) (length tmm-c-prompt))
+	   (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt)
+	   (setq out (substring out (length tmm-c-prompt))
+		 choice (cdr (assoc out tmm-km-list))))
+      (and (null choice)
+	   (setq out (try-completion out tmm-km-list)
+		 choice (cdr (assoc  out tmm-km-list)))))
+    ;; CHOICE is now (STRING . MEANING).  Separate the two parts.
+    (setq chosen-string (car choice))
+    (setq choice (cdr choice))
+    (cond (in-popup
+	   ;; We just did the inner level of a -popup menu.
+	   choice)
+	  ;; We just did the outer level.  Do the inner level now.
+	  (not-menu (tmm-prompt choice t)) 
+	  ;; We just handled a menu keymap and found another keymap.
+	  ((keymapp choice)
+	   (if (symbolp choice)
+	       (setq choice (indirect-function choice)))
+	   (condition-case nil
+	       (require 'mouse)
+	     (error nil))
+	   (condition-case nil
+	       (x-popup-menu nil choice) ; Get the shortcuts
+	     (error nil))
+	   (tmm-prompt choice))
+	  ;; We just handled a menu keymap and found a command.
+	  (choice
+	   (if chosen-string
+	       (call-interactively choice)
+	     choice)))))
 
 
 (defun tmm-add-shortcuts (list)