mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-02-01 20:06:00 +00:00
Adding mouse controls to menu-bar.el.
* lisp/isearch.el (tmm-menubar-keymap): Remove declare-function. * lisp/menu-bar.el (menu-bar-open-mouse, menu-bar-keymap) (menu-bar-current-active-maps, menu-bar-item-at-x): New functions. *lisp.tmm.el (tmm-menubar-keymap, tmm-get-keybind): Functions deleted. (tmm-menubar): Call 'menu-bar-item-at-x'.
This commit is contained in:
Jared Finder
Eli Zaretskii
parent
5b3e4db53f
commit
9d230684ff
@ -54,7 +54,6 @@
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(declare-function tmm-menubar-keymap "tmm.el")
|
||||
|
||||
;; Some additional options and constants.
|
||||
|
||||
@ -505,7 +504,7 @@ This is like `describe-bindings', but displays only Isearch keys."
|
||||
(require 'tmm)
|
||||
(run-hooks 'menu-bar-update-hook)
|
||||
(let ((command nil))
|
||||
(let ((menu-bar (tmm-menubar-keymap)))
|
||||
(let ((menu-bar (menu-bar-keymap)))
|
||||
(with-isearch-suspended
|
||||
(setq command (let ((isearch-mode t)) ; Show bindings from
|
||||
; `isearch-mode-map' in
|
||||
|
||||
@ -2663,6 +2663,86 @@ If FRAME is nil or not given, use the selected frame."
|
||||
|
||||
(global-set-key [f10] 'menu-bar-open)
|
||||
|
||||
(defun menu-bar-open-mouse (event)
|
||||
"Open the menu bar for the menu item clicked on by the mouse.
|
||||
EVENT should be a mouse down or click event.
|
||||
|
||||
Also see `menu-bar-open', which this calls.
|
||||
This command is to be used when you click the mouse in the menubar."
|
||||
(interactive "e")
|
||||
(let* ((x-position (car (posn-x-y (event-start event))))
|
||||
(menu-bar-item-cons (menu-bar-item-at-x x-position)))
|
||||
(menu-bar-open nil
|
||||
(if menu-bar-item-cons
|
||||
(cdr menu-bar-item-cons)
|
||||
0))))
|
||||
|
||||
(defun menu-bar-keymap ()
|
||||
"Return the current menu-bar keymap.
|
||||
|
||||
The ordering of the return value respects `menu-bar-final-items'."
|
||||
(let ((menu-bar '())
|
||||
(menu-end '()))
|
||||
(map-keymap
|
||||
(lambda (key binding)
|
||||
(let ((pos (seq-position menu-bar-final-items key))
|
||||
(menu-item (cons key binding)))
|
||||
(if pos
|
||||
;; If KEY is the name of an item that we want to put
|
||||
;; last, store it separately with explicit ordering for
|
||||
;; sorting.
|
||||
(push (cons pos menu-item) menu-end)
|
||||
(push menu-item menu-bar))))
|
||||
(lookup-key (menu-bar-current-active-maps) [menu-bar]))
|
||||
`(keymap ,@(nreverse menu-bar)
|
||||
,@(mapcar #'cdr (sort menu-end
|
||||
(lambda (a b)
|
||||
(< (car a) (car b))))))))
|
||||
|
||||
(defun menu-bar-current-active-maps ()
|
||||
"Return the current active maps in the order the menu bar displays them.
|
||||
This value does not take into account `menu-bar-final-items' as that applies
|
||||
per-item."
|
||||
;; current-active-maps returns maps in the order local then
|
||||
;; global. The menu bar displays items in the opposite order.
|
||||
(cons 'keymap (nreverse (current-active-maps))))
|
||||
|
||||
(defun menu-bar-item-at-x (x-position)
|
||||
"Return a cons of the form (KEY . X) for a menu item.
|
||||
The returned X is the left X coordinate for that menu item.
|
||||
|
||||
X-POSITION is the X coordinate being queried. If nothing is clicked on,
|
||||
returns nil."
|
||||
(let ((column 0)
|
||||
(menu-bar (menu-bar-keymap))
|
||||
prev-key
|
||||
prev-column
|
||||
found)
|
||||
(catch 'done
|
||||
(map-keymap
|
||||
(lambda (key binding)
|
||||
(when (> column x-position)
|
||||
(setq found t)
|
||||
(throw 'done nil))
|
||||
(setq prev-key key)
|
||||
(pcase binding
|
||||
((or `(,(and (pred stringp) name) . ,_) ;Simple menu item.
|
||||
`(menu-item ,name ,_cmd ;Extended menu item.
|
||||
. ,(and props
|
||||
(guard (let ((visible
|
||||
(plist-get props :visible)))
|
||||
(or (null visible)
|
||||
(eval visible)))))))
|
||||
(setq prev-column column
|
||||
column (+ column (length name) 1)))))
|
||||
menu-bar)
|
||||
;; Check the last menu item.
|
||||
(when (> column x-position)
|
||||
(setq found t)))
|
||||
(if found
|
||||
(cons prev-key prev-column)
|
||||
nil)))
|
||||
|
||||
(defun buffer-menu-open ()
|
||||
"Start key navigation of the buffer menu.
|
||||
This is the keyboard interface to \\[mouse-buffer-menu]."
|
||||
|
||||
63
lisp/tmm.el
63
lisp/tmm.el
@ -42,28 +42,6 @@
|
||||
(defvar tmm-next-shortcut-digit)
|
||||
(defvar tmm-table-undef)
|
||||
|
||||
(defun tmm-menubar-keymap ()
|
||||
"Return the current menu-bar keymap.
|
||||
|
||||
The ordering of the return value respects `menu-bar-final-items'."
|
||||
(let ((menu-bar '())
|
||||
(menu-end '()))
|
||||
(map-keymap
|
||||
(lambda (key binding)
|
||||
(let ((pos (seq-position menu-bar-final-items key))
|
||||
(menu-item (cons key binding)))
|
||||
(if pos
|
||||
;; If KEY is the name of an item that we want to put
|
||||
;; last, store it separately with explicit ordering for
|
||||
;; sorting.
|
||||
(push (cons pos menu-item) menu-end)
|
||||
(push menu-item menu-bar))))
|
||||
(tmm-get-keybind [menu-bar]))
|
||||
`(keymap ,@(nreverse menu-bar)
|
||||
,@(mapcar #'cdr (sort menu-end
|
||||
(lambda (a b)
|
||||
(< (car a) (car b))))))))
|
||||
|
||||
;;;###autoload (define-key global-map "\M-`" 'tmm-menubar)
|
||||
;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
|
||||
|
||||
@ -79,33 +57,12 @@ to invoke `tmm-menubar' instead, customize the variable
|
||||
`tty-menu-open-use-tmm' to a non-nil value."
|
||||
(interactive)
|
||||
(run-hooks 'menu-bar-update-hook)
|
||||
;; Obey menu-bar-final-items; put those items last.
|
||||
(let ((menu-bar (tmm-menubar-keymap))
|
||||
menu-bar-item)
|
||||
(if x-position
|
||||
(let ((column 0)
|
||||
prev-key)
|
||||
(catch 'done
|
||||
(map-keymap
|
||||
(lambda (key binding)
|
||||
(when (> column x-position)
|
||||
(setq menu-bar-item prev-key)
|
||||
(throw 'done nil))
|
||||
(setq prev-key key)
|
||||
(pcase binding
|
||||
((or `(,(and (pred stringp) name) . ,_) ;Simple menu item.
|
||||
`(menu-item ,name ,_cmd ;Extended menu item.
|
||||
. ,(and props
|
||||
(guard (let ((visible
|
||||
(plist-get props :visible)))
|
||||
(or (null visible)
|
||||
(eval visible)))))))
|
||||
(setq column (+ column (length name) 1)))))
|
||||
menu-bar)
|
||||
;; Check the last menu item.
|
||||
(when (> column x-position)
|
||||
(setq menu-bar-item prev-key)))))
|
||||
(tmm-prompt menu-bar nil menu-bar-item)))
|
||||
(let ((menu-bar (menu-bar-keymap))
|
||||
(menu-bar-item-cons (and x-position
|
||||
(menu-bar-item-at-x x-position))))
|
||||
(tmm-prompt menu-bar
|
||||
nil
|
||||
(and menu-bar-item-cons (car menu-bar-item-cons)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun tmm-menubar-mouse (event)
|
||||
@ -525,14 +482,6 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
|
||||
(or (assoc str tmm-km-list)
|
||||
(push (cons str (cons event km)) tmm-km-list))))))
|
||||
|
||||
(defun tmm-get-keybind (keyseq)
|
||||
"Return the current binding of KEYSEQ, merging prefix definitions.
|
||||
If KEYSEQ is a prefix key that has local and global bindings,
|
||||
we merge them into a single keymap which shows the proper order of the menu.
|
||||
However, for the menu bar itself, the value does not take account
|
||||
of `menu-bar-final-items'."
|
||||
(lookup-key (cons 'keymap (nreverse (current-active-maps))) keyseq))
|
||||
|
||||
(provide 'tmm)
|
||||
|
||||
;;; tmm.el ends here
|
||||
|
||||
Loading…
Reference in New Issue
Block a user