Merge branch 'feature/context-menu'

1 files changed, 188 insertions, 0 deletions

diff --git a/lisp/mouse.el b/lisp/mouse.el
index cf7c17be28f..4c4a7d35a89 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -277,6 +277,194 @@ not it is actually displayed."
            minor-mode-menus)))
 
 
+;; Context menus.
+
+(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.
+Each function receives the menu as its argument and should return
+the same menu with changes such as added new menu items."
+  :type '(repeat
+          (choice (function-item context-menu-undo)
+                  (function-item context-menu-region)
+                  (function-item context-menu-global)
+                  (function-item context-menu-local)
+                  (function-item context-menu-minor)
+                  (function-item context-menu-vc)
+                  (function-item context-menu-ffap)
+                  (function :tag "Custom function")))
+  :version "28.1")
+
+(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")))
+    (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] menu-bar-separator)
+  (map-keymap (lambda (key binding)
+                (when (consp binding)
+                  (define-key-after menu (vector key)
+                    (copy-sequence binding))))
+              (lookup-key global-map [menu-bar]))
+  menu)
+
+(defun context-menu-local (menu)
+  "Major mode submenus."
+  (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+  (define-key-after menu [separator-local] menu-bar-separator)
+  (let ((keymap (local-key-binding [menu-bar])))
+    (when keymap
+      (map-keymap (lambda (key binding)
+                    (when (consp binding)
+                      (define-key-after menu (vector key)
+                        (copy-sequence binding))))
+                  keymap)))
+  menu)
+
+(defun context-menu-minor (menu)
+  "Minor modes submenus."
+  (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+  (define-key-after menu [separator-minor] menu-bar-separator)
+  (dolist (mode (minor-mode-key-binding [menu-bar]))
+    (when (and (consp mode) (symbol-value (car mode)))
+      (map-keymap (lambda (key binding)
+                    (when (consp binding)
+                      (define-key-after menu (vector key)
+                        (copy-sequence binding))))
+                  (cdr mode))))
+  menu)
+
+(defun context-menu-vc (menu)
+  "Version Control menu."
+  (define-key-after menu [separator-vc] menu-bar-separator)
+  (define-key-after menu [vc-menu] vc-menu-entry)
+  menu)
+
+(defun context-menu-undo (menu)
+  "Undo menu."
+  (when (cddr menu)
+    (define-key-after menu [separator-undo] menu-bar-separator))
+  (define-key-after 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"))
+  (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"))
+  menu)
+
+(defun context-menu-region (menu)
+  "Region commands menu."
+  (when (cddr menu)
+    (define-key-after menu [separator-region] 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"))
+  (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)
+                            '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]")))
+  (define-key-after 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"))
+  (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"))
+  (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"))
+  (define-key-after menu [mark-whole-buffer]
+    '(menu-item "Select All" mark-whole-buffer
+                :help "Mark the whole buffer for a subsequent cut/copy"))
+  menu)
+
+(defun context-menu-ffap (menu)
+  "File at point menu."
+  (save-excursion
+    (mouse-set-point last-input-event)
+    (when (ffap-guess-file-name-at-point)
+      (define-key menu [ffap-separator] menu-bar-separator)
+      (define-key menu [ffap-at-mouse]
+        '(menu-item "Find File or URL" ffap-at-mouse
+                    :help "Find file or URL guessed from text around mouse click"))))
+  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)
+
+(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] context-menu-entry))
+   (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)