master 9d23068 1/3: Adding mouse controls to menu-bar.el.

[Eli Zaretskii]

branch: master
commit 9d230684ff16e105db168ebaafdbea2de2e7d6ca
Author: Jared Finder <jared@finder.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    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'.
---
 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 0879f94..c3d5ff2 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.
 
@@ -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
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index da4ad97..8690569 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -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]."
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 0e83f42..fc02fd5 100644
--- a/lisp/tmm.el
+++ b/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