mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 04:10:54 -08:00
(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.
This commit is contained in:
Richard M. Stallman
parent
77cc5db0c3
commit
bdbc768529
1 changed files with 98 additions and 75 deletions
173
lisp/tmm.el
173
lisp/tmm.el
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue