Mercurial > emacs
changeset 13915:1319e4b9aa6c
(tmm-menubar-mouse): New function, handles [menu-bar mouse-1].
(tmm-menubar): New arg x-position.
(tmm-prompt): New arg default-item specifies item to offer by default.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 02 Jan 1996 05:59:20 +0000 |
parents | 18d26aa4c25a |
children | 00065bf711b8 |
files | lisp/tmm.el |
diffstat | 1 files changed, 55 insertions(+), 16 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/tmm.el Tue Jan 02 01:16:39 1996 +0000 +++ b/lisp/tmm.el Tue Jan 02 05:59:20 1996 +0000 @@ -44,16 +44,19 @@ ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) ;;;###autoload (define-key global-map [f10] 'tmm-menubar) -;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar) +;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) ;;;###autoload -(defun tmm-menubar () +(defun tmm-menubar (&optional x-position) "Text-mode emulation of looking and choosing from a menubar. -See the documentation for `tmm-prompt'." +See the documentation for `tmm-prompt'. +X-POSITION, if non-nil, specifies a horizontal position within the menu bar; +we make that menu bar item (the one at that position) the default choice." (interactive) (run-hooks 'menu-bar-update-hook) ;; Obey menu-bar-final-items; put those items last. - (let ((menu-bar (tmm-get-keybind [menu-bar]))) + (let ((menu-bar (tmm-get-keybind [menu-bar])) + menu-bar-item) (let ((list menu-bar-final-items)) (while list (let ((item (car list))) @@ -63,7 +66,29 @@ (setq menu-bar (append (delq this-one menu-bar) (list this-one))))) (setq list (cdr list)))) - (tmm-prompt menu-bar))) + (if x-position + (let ((tail menu-bar) + this-one + (column 0)) + (while (and tail (< column x-position)) + (setq this-one (car tail)) + (if (and (consp (car tail)) + (consp (cdr (car tail))) + (stringp (nth 1 (car tail)))) + (setq column (+ column + (length (nth 1 (car tail))) + 1))) + (setq tail (cdr tail))) + (setq menu-bar-item (car this-one)))) + (tmm-prompt menu-bar nil menu-bar-item))) + +(defun tmm-menubar-mouse (event) + "Text-mode emulation of looking and choosing from a menubar. +This command is used when you click the mouse in the menubar +on a console which has no window system but does have a mouse. +See the documentation for `tmm-prompt'." + (interactive "e") + (tmm-menubar (car (posn-x-y (event-start event))))) (defvar tmm-mid-prompt "==>" "String to insert between shortcut and menu item or nil.") @@ -80,15 +105,15 @@ "What insert on top of completion buffer.") ;;;###autoload -(defun tmm-prompt (bind &optional in-popup) +(defun tmm-prompt (bind &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: - *) Either via history mechanism from minibuffer; +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 set, is argument-compatible with -`x-popup-menu', otherwise the argument BIND should be a cdr of sparse keymap." +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) @@ -98,22 +123,36 @@ (setq gl-str elt) (and (listp elt) (tmm-get-keymap elt in-popup))))) bind) + (setq foo default-item foo1 bind) (and tmm-km-list - (progn + (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 (1- history-len) 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)))) + (cons 'history (- (* 2 history-len) index-of-default)))) (save-excursion (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) (if (get-buffer "*Completions*") @@ -265,8 +304,8 @@ The values are deduced from the argument ELT, that should be an element of keymap, an `x-popup-menu' argument, or an element of `x-popup-menu' argument (when IN-X-MENU is not-nil). -Does it only if it is not already there. Uses free variable -`tmm-table-undef' to keep undefined keys." +This function adds the element only if it is not already present. +It uses the free variable `tmm-table-undef' to keep undefined keys." (let (km str cache (event (car elt))) (setq elt (cdr elt)) (if (eq elt 'undefined)