"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)
projects / emacs.git / commitdiff