feature/context-menu 1493145: Change the order of context-menu-functions and add more context menus.

[Juri Linkov]

branch: feature/context-menu
commit 1493145e3048e057d8ac9e8c9c56d1f99a97eb53
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    Change the order of context-menu-functions and add more context menus.
    
    * lisp/mouse.el (context-menu-functions): Update default list.
    (context-menu-overriding-function): Remove variable.
    (context-menu-map): Reverse the order.
    (context-menu-global, context-menu-local, context-menu-minor): New 
functions.
    (context-menu-undo, context-menu-region): Add separators.
    Use define-key-after instead of bindings--define-key.
    (context-menu-entry): New variable.
    (context-menu-mode): Use it.
    
    * lisp/dired.el (dired-context-menu): New function.
    (dired-mode): Add it to context-menu-functions.
    
    * lisp/info.el (Info-context-menu): Reorder.
    
    * lisp/net/goto-addr.el (goto-address-at-mouse):
    Rename from goto-address-at-click.
    (goto-address-context-menu): Use goto-address-at-mouse.
    
    * lisp/progmodes/prog-mode.el (prog-context-menu): New function.
    (prog-mode): Add it to context-menu-functions.
---
 lisp/dired.el               | 17 ++++++++
 lisp/info.el                | 53 +++++++++++--------------
 lisp/mouse.el               | 94 ++++++++++++++++++++++++++++++++++-----------
 lisp/net/goto-addr.el       | 14 +++----
 lisp/progmodes/prog-mode.el | 17 ++++++++
 5 files changed, 134 insertions(+), 61 deletions(-)

diff --git a/lisp/dired.el b/lisp/dired.el
index 28448be..5e44f52 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2194,6 +2194,22 @@ Do so according to the former subdir alist 
OLD-SUBDIR-ALIST."
     ["Delete Image Tag..." image-dired-delete-tag
      :help "Delete image tag from current or marked files"]))
 
+(defun dired-context-menu (menu)
+  (when (mouse-posn-property (event-start last-input-event) 'dired-filename)
+    (define-key menu [dired-separator-1] menu-bar-separator)
+    (let ((easy-menu (make-sparse-keymap "Immediate")))
+      (easy-menu-define nil easy-menu nil
+        '("Immediate"
+          ["Find This File" dired-mouse-find-file
+           :help "Edit file at mouse click"]
+          ["Find in Other Window" dired-mouse-find-file-other-window
+           :help "Edit file at mouse click in other window"]))
+      (dolist (item (reverse (lookup-key easy-menu [menu-bar immediate])))
+        (when (consp item)
+          (define-key menu (vector (car item)) (cdr item)))))
+    (define-key menu [dired-separator-2] menu-bar-separator))
+  menu)
+
 
 ;;; Dired mode
 
@@ -2293,6 +2309,7 @@ Keybindings:
                 (append dired-dnd-protocol-alist dnd-protocol-alist)))
   (add-hook 'file-name-at-point-functions #'dired-file-name-at-point nil t)
   (add-hook 'isearch-mode-hook #'dired-isearch-filenames-setup nil t)
+  (add-hook 'context-menu-functions 'dired-context-menu 5 t)
   (run-mode-hooks 'dired-mode-hook))
 
 
diff --git a/lisp/info.el b/lisp/info.el
index 226ec76..a8848a9 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -4117,9 +4117,9 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
     :help "Search for another occurrence of regular expression"]
    "---"
    ("History"
-    ["Back in history" Info-history-back :active Info-history
+    ["Back in History" Info-history-back :active Info-history
      :help "Go back in history to the last node you were at"]
-    ["Forward in history" Info-history-forward :active Info-history-forward
+    ["Forward in History" Info-history-forward :active Info-history-forward
      :help "Go forward in history"]
     ["Show History" Info-history :active Info-history-list
      :help "Go to menu of visited nodes"])
@@ -4148,34 +4148,25 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
 
 (defun Info-context-menu (menu)
   (when (mouse-posn-property (event-start last-input-event) 'mouse-face)
-    (bindings--define-key menu [Info-mouse-follow-nearest-node]
-      '(menu-item "Follow link" Info-mouse-follow-nearest-node
-                  :help "Follow a link where you click")))
-
-  (bindings--define-key menu [Info-history-back]
-    '(menu-item "Back in history" Info-history-back :visible Info-history
-                :help "Go back in history to the last node you were at"))
-  (bindings--define-key menu [Info-history-forward]
-    '(menu-item "Forward in history" Info-history-forward :visible 
Info-history-forward
-                :help "Go forward in history"))
-
-  (bindings--define-key menu [Info-up]
-    '(menu-item "Up" Info-up :visible (Info-check-pointer "up")
-                :help "Go up in the Info tree"))
-  (bindings--define-key menu [Info-next]
-    '(menu-item "Next" Info-next :visible (Info-check-pointer "next")
-                :help "Go to the next node"))
-  (bindings--define-key menu [Info-prev]
-    '(menu-item "Previous" Info-prev :visible (Info-check-pointer 
"prev[ious]*")
-                :help "Go to the previous node"))
-  (bindings--define-key menu [Info-backward-node]
-    '(menu-item "Backward" Info-backward-node
-                :help "Go backward one node, considering all as a sequence"))
-  (bindings--define-key menu [Info-forward-node]
-    '(menu-item "Forward" Info-forward-node
-                :help "Go forward one node, considering all as a sequence"))
-
-  (define-key menu [Info-separator] menu-bar-separator)
+    (define-key menu [Info-separator-link-1] menu-bar-separator)
+    (define-key menu [Info-mouse-follow-nearest-node]
+      '(menu-item "Follow Link" Info-mouse-follow-nearest-node
+                  :help "Follow a link where you click"))
+    (define-key menu [Info-separator-link-2] menu-bar-separator))
+
+  (define-key-after menu [Info-separator-1] menu-bar-separator)
+  (let ((easy-menu (make-sparse-keymap "Info")))
+    (easy-menu-define nil easy-menu nil
+      '("Info"
+        ["Back in History" Info-history-back :visible Info-history
+         :help "Go back in history to the last node you were at"]
+        ["Forward in History" Info-history-forward :visible 
Info-history-forward
+         :help "Go forward in history"]))
+    (dolist (item (lookup-key easy-menu [menu-bar info]))
+      (when (consp item)
+        (define-key-after menu (vector (car item)) (cdr item)))))
+  (define-key-after menu [Info-separator-2] menu-bar-separator)
+
   menu)
 
 (defvar info-tool-bar-map
@@ -4477,7 +4468,7 @@ Advanced commands:
   (add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
   (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
   (add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
-  (add-hook 'context-menu-functions 'Info-context-menu nil t)
+  (add-hook 'context-menu-functions 'Info-context-menu 5 t)
   (when Info-standalone
     (add-hook 'quit-window-hook 'save-buffers-kill-emacs nil t))
   (setq-local isearch-search-fun-function #'Info-isearch-search)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 580fe8e..7a564f9 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -279,34 +279,77 @@ not it is actually displayed."
 
 ;; Context menus.
 
-(defcustom context-menu-functions '(context-menu-undo context-menu-region)
+(defcustom context-menu-functions '(context-menu-undo
+                                    context-menu-region
+                                    context-menu-local
+                                    context-menu-minor)
   "List of functions that produce the contents of the context menu."
   :type 'hook
+  :options '(context-menu-undo
+             context-menu-region
+             context-menu-global
+             context-menu-local
+             context-menu-minor)
   :version "28.1")
 
-(defvar context-menu-overriding-function nil
-  "Function that can override the list produced by `context-menu-functions'.")
-
 (defcustom context-menu-filter-function nil
   "Function that can filter the list produced by `context-menu-functions'."
   :type 'function
   :version "28.1")
 
 (defun context-menu-map ()
+  "Return composite menu map."
   (let ((menu (make-sparse-keymap "Context Menu")))
-    (if (functionp context-menu-overriding-function)
-        (setq menu (funcall context-menu-overriding-function menu))
-      (run-hook-wrapped 'context-menu-functions
-                        (lambda (fun)
-                          (setq menu (funcall fun menu))
-                          nil)))
-    (setq menu (cons (car menu) (nreverse (cdr menu))))
+    (run-hook-wrapped 'context-menu-functions
+                      (lambda (fun)
+                        (setq menu (funcall fun menu))
+                        nil))
     (when (functionp context-menu-filter-function)
       (setq menu (funcall context-menu-filter-function menu)))
     menu))
 
+(defun context-menu-global (menu)
+  "Global submenus."
+  (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+  (define-key-after menu [separator-global-1] menu-bar-separator)
+  (dolist (item (lookup-key global-map [menu-bar]))
+    (when (consp item)
+      (define-key-after menu (vector (car item))
+        (if (consp (cdr item))
+            (copy-sequence (cdr item))
+          (cdr item)))))
+  (define-key-after menu [separator-global-2] menu-bar-separator)
+  menu)
+
+(defun context-menu-local (menu)
+  "Major mode submenus."
+  (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+  (define-key-after menu [separator-local-1] menu-bar-separator)
+  (dolist (item (local-key-binding [menu-bar]))
+    (when (consp item)
+      (define-key-after menu (vector (car item))
+        (if (consp (cdr item))
+            (copy-sequence (cdr item))
+          (cdr item)))))
+  (define-key-after menu [separator-local-2] menu-bar-separator)
+  menu)
+
+(defun context-menu-minor (menu)
+  "Minor mode submenus."
+  (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+  (define-key-after menu [separator-minor-1] menu-bar-separator)
+  (dolist (item (minor-mode-key-binding [menu-bar]))
+    (when (and (consp item) (symbol-value (car item)))
+      (define-key-after menu (vector (cadr item))
+        (if (consp (cddr item))
+            (copy-sequence (cddr item))
+          (cddr item)))))
+  (define-key-after menu [separator-minor-2] menu-bar-separator)
+  menu)
+
 (defun context-menu-undo (menu)
-  (bindings--define-key menu [undo]
+  (define-key-after menu [separator-undo-1] menu-bar-separator)
+  (define-key-after menu [undo]
     '(menu-item "Undo" undo
                 :visible (and (not buffer-read-only)
                               (not (eq t buffer-undo-list))
@@ -314,20 +357,22 @@ not it is actually displayed."
                                   (listp pending-undo-list)
                                 (consp buffer-undo-list)))
                 :help "Undo last edits"))
-  (bindings--define-key menu [undo-redo]
+  (define-key-after menu [undo-redo]
     '(menu-item "Redo" undo-redo
                 :visible (and (not buffer-read-only)
                               (undo--last-change-was-undo-p buffer-undo-list))
                 :help "Redo last undone edits"))
+  (define-key-after menu [separator-undo-2] menu-bar-separator)
   menu)
 
 (defun context-menu-region (menu)
-  (bindings--define-key menu [cut]
+  (define-key-after menu [separator-region-1] menu-bar-separator)
+  (define-key-after menu [cut]
     '(menu-item "Cut" kill-region
                 :visible (and mark-active (not buffer-read-only))
                 :help
                 "Cut (kill) text in region between mark and current position"))
-  (bindings--define-key menu [copy]
+  (define-key-after menu [copy]
     ;; ns-win.el said: Substitute a Copy function that works better
     ;; under X (for GNUstep).
     `(menu-item "Copy" ,(if (featurep 'ns)
@@ -338,7 +383,7 @@ not it is actually displayed."
                 :keys ,(if (featurep 'ns)
                            "\\[ns-copy-including-secondary]"
                          "\\[kill-ring-save]")))
-  (bindings--define-key menu [paste]
+  (define-key-after menu [paste]
     `(menu-item "Paste" mouse-yank-primary
                 :visible (funcall
                           ',(lambda ()
@@ -349,25 +394,30 @@ not it is actually displayed."
                                       kill-ring))
                                    (not buffer-read-only))))
                 :help "Paste (yank) text most recently cut/copied"))
-  (bindings--define-key menu (if (featurep 'ns) [select-paste]
-                               [paste-from-menu])
+  (define-key-after menu (if (featurep 'ns) [select-paste]
+                           [paste-from-menu])
     ;; ns-win.el said: Change text to be more consistent with
     ;; surrounding menu items `paste', etc."
     `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu")
                 yank-menu
                 :visible (and (cdr yank-menu) (not buffer-read-only))
                 :help "Choose a string from the kill ring and paste it"))
-  (bindings--define-key menu [clear]
+  (define-key-after menu [clear]
     '(menu-item "Clear" delete-active-region
                 :visible (and mark-active
                               (not buffer-read-only))
                 :help
                 "Delete the text in region between mark and current position"))
-  (bindings--define-key menu [mark-whole-buffer]
+  (define-key-after menu [mark-whole-buffer]
     '(menu-item "Select All" mark-whole-buffer
                 :help "Mark the whole buffer for a subsequent cut/copy"))
+  (define-key-after menu [separator-region-2] menu-bar-separator)
   menu)
 
+(defvar context-menu-entry
+  `(menu-item ,(purecopy "Context Menu") ignore
+              :filter (lambda (_) (context-menu-map))))
+
 (defvar context-menu--old-down-mouse-3 nil)
 (defvar context-menu--old-mouse-3 nil)
 
@@ -382,9 +432,7 @@ activates the menu whose contents depends on its 
surrounding context."
     (setq context-menu--old-mouse-3 (global-key-binding [mouse-3]))
     (global-unset-key [mouse-3])
     (setq context-menu--old-down-mouse-3 (global-key-binding [down-mouse-3]))
-    (global-set-key [down-mouse-3]
-                    '(menu-item "Context Menu" ignore
-                                :filter (lambda (_) (context-menu-map)))))
+    (global-set-key [down-mouse-3] context-menu-entry))
    (t
     (if (not context-menu--old-down-mouse-3)
         (global-unset-key [down-mouse-3])
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 1e8a3cd..2c43d0f 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -126,10 +126,10 @@ will have no effect.")
 
 (defun goto-address-context-menu (menu)
   (when (mouse-posn-property (event-start last-input-event) 'goto-address)
-    (bindings--define-key menu [goto-address-at-click]
-      '(menu-item "Follow link" goto-address-at-click
-                  :help "Follow a link where you click"))
-    (define-key menu [goto-address-separator] menu-bar-separator))
+    (define-key menu [goto-address-separator] menu-bar-separator)
+    (define-key menu [goto-address-at-mouse]
+      '(menu-item "Follow Link" goto-address-at-mouse
+                  :help "Follow a link where you click")))
   menu)
 
 (defcustom goto-address-url-face 'link
@@ -253,8 +253,8 @@ address.  If no e-mail address found, return nil."
               (goto-char (match-beginning 0))))
       (match-string-no-properties 0)))
 
-(defun goto-address-at-click (click)
-  "Send to the e-mail address or load the URL at click."
+(defun goto-address-at-mouse (click)
+  "Send to the e-mail address or load the URL at mouse click."
   (interactive "e")
   (goto-address-at-point click))
 
@@ -280,7 +280,7 @@ Also fontifies the buffer appropriately (see 
`goto-address-fontify-p' and
   (cond
    (goto-address-mode
     (jit-lock-register #'goto-address-fontify-region)
-    (add-hook 'context-menu-functions 'goto-address-context-menu -10 t))
+    (add-hook 'context-menu-functions 'goto-address-context-menu 10 t))
    (t
     (jit-lock-unregister #'goto-address-fontify-region)
     (save-restriction
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 19de754..ad1b13f 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -43,6 +43,22 @@
                                 display-line-numbers-mode
                                 prettify-symbols-mode))
 
+(defun prog-context-menu (menu)
+  (when (featurep 'xref)
+    (define-key-after menu [prog-separator-1] menu-bar-separator)
+    (define-key-after menu [xref-find-def]
+      '(menu-item "Find Definition" xref-find-definitions-at-mouse
+                  :visible (save-excursion
+                             (mouse-set-point last-input-event)
+                             (xref-backend-identifier-at-point 
(xref-find-backend)))
+                  :help "Find definition of function or variable"))
+    (define-key-after menu [xref-pop]
+      '(menu-item "Back Definition" xref-pop-marker-stack
+                  :visible (not (xref-marker-stack-empty-p))
+                  :help "Back to the position of the last search"))
+    (define-key-after menu [prog-separator-2] menu-bar-separator))
+  menu)
+
 (defvar prog-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map [?\C-\M-q] 'prog-indent-sexp)
@@ -249,6 +265,7 @@ support it."
   "Major mode for editing programming language source code."
   (setq-local require-final-newline mode-require-final-newline)
   (setq-local parse-sexp-ignore-comments t)
+  (add-hook 'context-menu-functions 'prog-context-menu 10 t)
   ;; Any programming language is always written left to right.
   (setq bidi-paragraph-direction 'left-to-right))