From 0f9c4ac21a92a368162cd134252045b6c3362433 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Sat, 19 Sep 2020 00:43:29 -0700 Subject: [PATCH 1/3] Adding mouse controls to menu-bar.el. --- lisp/isearch.el | 3 +- lisp/menu-bar.el | 80 ++++++++++++++++++++++++++++++++++++++++++++++++ lisp/tmm.el | 63 ++++---------------------------------- 3 files changed, 87 insertions(+), 59 deletions(-) diff --git a/lisp/isearch.el b/lisp/isearch.el index 781a8c5a93..01d1509a36 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -54,7 +54,6 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(declare-function tmm-menubar-keymap "tmm.el") ;; Some additional options and constants. @@ -501,7 +500,7 @@ isearch-tmm-menubar (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 diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 1b3e102cfa..8fad8f36bb 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2660,6 +2660,86 @@ menu-bar-open (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]." diff --git a/lisp/tmm.el b/lisp/tmm.el index 0e83f427f5..fc02fd5790 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -42,28 +42,6 @@ tmm-km-list (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 @@ tmm-menubar `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 @@ tmm-get-keymap (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 -- 2.20.1