# HG changeset patch # User Richard M. Stallman # Date 820564543 0 # Node ID 00065bf711b804de6df41be9c503cf93e095c121 # Parent 1319e4b9aa6cf723634c47813922d6997a8b8017 (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. diff -r 1319e4b9aa6c -r 00065bf711b8 lisp/tmm.el --- 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)