feature/context-menu 292e626: Add new mode context-menu-mode and use it in info.el and goto-addr.el

[Juri Linkov]

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

    Add new mode context-menu-mode and use it in info.el and goto-addr.el
    
    * lisp/mouse.el (context-menu-functions): New defcustom.
    (context-menu-overriding-function): New function.
    (context-menu-filter-function): New defcustom.
    (context-menu-map): New function.
    (context-menu-undo, context-menu-region): New menu functions.
    (context-menu-mode): New mode.
    
    * lisp/info.el (Info-context-menu): New function.
    (Info-mode): Add Info-context-menu to context-menu-functions.
    
    * lisp/net/goto-addr.el (goto-address-context-menu): New function.
    (goto-address-at-click): New command.
    (goto-address-mode): Add goto-address-context-menu to 
context-menu-functions.
---
 lisp/info.el          |  32 ++++++++++++++
 lisp/mouse.el         | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++
 lisp/net/goto-addr.el |  23 ++++++++--
 3 files changed, 170 insertions(+), 3 deletions(-)

diff --git a/lisp/info.el b/lisp/info.el
index b65728b..226ec76 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -4146,6 +4146,37 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
    "---"
    ["Exit" quit-window :help "Stop reading Info"]))
 
+(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)
+  menu)
 
 (defvar info-tool-bar-map
   (let ((map (make-sparse-keymap)))
@@ -4446,6 +4477,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)
   (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 89e5d7c..580fe8e 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -277,6 +277,124 @@ not it is actually displayed."
            minor-mode-menus)))
 
 
+;; Context menus.
+
+(defcustom context-menu-functions '(context-menu-undo context-menu-region)
+  "List of functions that produce the contents of the context menu."
+  :type 'hook
+  :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 ()
+  (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))))
+    (when (functionp context-menu-filter-function)
+      (setq menu (funcall context-menu-filter-function menu)))
+    menu))
+
+(defun context-menu-undo (menu)
+  (bindings--define-key menu [undo]
+    '(menu-item "Undo" undo
+                :visible (and (not buffer-read-only)
+                              (not (eq t buffer-undo-list))
+                              (if (eq last-command 'undo)
+                                  (listp pending-undo-list)
+                                (consp buffer-undo-list)))
+                :help "Undo last edits"))
+  (bindings--define-key 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"))
+  menu)
+
+(defun context-menu-region (menu)
+  (bindings--define-key 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]
+    ;; ns-win.el said: Substitute a Copy function that works better
+    ;; under X (for GNUstep).
+    `(menu-item "Copy" ,(if (featurep 'ns)
+                            'ns-copy-including-secondary
+                          'kill-ring-save)
+                :visible mark-active
+                :help "Copy text in region between mark and current position"
+                :keys ,(if (featurep 'ns)
+                           "\\[ns-copy-including-secondary]"
+                         "\\[kill-ring-save]")))
+  (bindings--define-key menu [paste]
+    `(menu-item "Paste" mouse-yank-primary
+                :visible (funcall
+                          ',(lambda ()
+                              (and (or
+                                    (gui-backend-selection-exists-p 'CLIPBOARD)
+                                    (if (featurep 'ns) ; like paste-from-menu
+                                        (cdr yank-menu)
+                                      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])
+    ;; 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]
+    '(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]
+    '(menu-item "Select All" mark-whole-buffer
+                :help "Mark the whole buffer for a subsequent cut/copy"))
+  menu)
+
+(defvar context-menu--old-down-mouse-3 nil)
+(defvar context-menu--old-mouse-3 nil)
+
+(define-minor-mode context-menu-mode
+  "Toggle Context Menu mode.
+
+When Context Menu mode is enabled, clicking the mouse button down-mouse-3
+activates the menu whose contents depends on its surrounding context."
+  :global t :group 'mouse
+  (cond
+   (context-menu-mode
+    (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)))))
+   (t
+    (if (not context-menu--old-down-mouse-3)
+        (global-unset-key [down-mouse-3])
+      (global-set-key [down-mouse-3] context-menu--old-down-mouse-3)
+      (setq context-menu--old-down-mouse-3 nil))
+    (when context-menu--old-mouse-3
+      (global-set-key [mouse-3] context-menu--old-mouse-3)
+      (setq context-menu--old-mouse-3 nil)))))
+
+
 ;; Commands that operate on windows.
 
 (defun mouse-minibuffer-check (event)
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 8992ef7..1e8a3cd 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -124,6 +124,14 @@ will have no effect.")
     m)
   "Keymap to hold goto-addr's mouse key defs under highlighted URLs.")
 
+(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))
+  menu)
+
 (defcustom goto-address-url-face 'link
   "Face to use for URLs."
   :type 'face)
@@ -245,6 +253,11 @@ 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."
+  (interactive "e")
+  (goto-address-at-point click))
+
 ;;;###autoload
 (defun goto-address ()
   "Sets up goto-address functionality in the current buffer.
@@ -264,12 +277,16 @@ Also fontifies the buffer appropriately (see 
`goto-address-fontify-p' and
 (define-minor-mode goto-address-mode
   "Minor mode to buttonize URLs and e-mail addresses in the current buffer."
   :lighter ""
-  (if goto-address-mode
-      (jit-lock-register #'goto-address-fontify-region)
+  (cond
+   (goto-address-mode
+    (jit-lock-register #'goto-address-fontify-region)
+    (add-hook 'context-menu-functions 'goto-address-context-menu -10 t))
+   (t
     (jit-lock-unregister #'goto-address-fontify-region)
     (save-restriction
       (widen)
-      (goto-address-unfontify (point-min) (point-max)))))
+      (goto-address-unfontify (point-min) (point-max)))
+    (remove-hook 'context-menu-functions 'goto-address-context-menu t))))
 
 (defun goto-addr-mode--turn-on ()
   (when (not goto-address-mode)