Commit bdbc7685 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(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.
parent 77cc5db0
......@@ -105,91 +105,114 @@ marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel.
"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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment