diff --git a/lisp/info.el b/lisp/info.el index b65728ba41b..226ec76eb67 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 89e5d7c48a3..580fe8eb352 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -276,6 +276,124 @@ not it is actually displayed." local-menu 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. diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 8992ef736a6..1e8a3cda157 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)