[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master bf1ec49: Merge branch 'feature/context-menu'
|
From: |
Juri Linkov |
|
Subject: |
master bf1ec49: Merge branch 'feature/context-menu' |
|
Date: |
Tue, 17 Aug 2021 04:12:22 -0400 (EDT) |
branch: master
commit bf1ec4952e67b474bff813cd26e4d612a359baf1
Merge: 9e2cc40 d9eac0b
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>
Merge branch 'feature/context-menu'
---
doc/emacs/frames.texi | 25 +++---
etc/NEWS | 11 ++-
lisp/dired.el | 16 ++++
lisp/help-mode.el | 30 +++++++
lisp/info.el | 24 +++++-
lisp/mouse.el | 188 ++++++++++++++++++++++++++++++++++++++++++++
lisp/net/eww.el | 30 +++++++
lisp/net/goto-addr.el | 23 +++++-
lisp/progmodes/prog-mode.el | 19 +++++
9 files changed, 346 insertions(+), 20 deletions(-)
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 951e090..5b15e62 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -366,20 +366,15 @@ This menu is for changing the default face within the
window's buffer.
@xref{Text Scale}.
@end table
+@cindex context menu
+@findex context-menu-mode
+@vindex context-menu-functions
+@kindex Down-mouse-3
Some graphical applications use @kbd{mouse-3} for a mode-specific
-menu. If you prefer @kbd{mouse-3} in Emacs to bring up such a menu
-instead of running the @code{mouse-save-then-kill} command, rebind
-@kbd{mouse-3} by adding the following line to your init file
-(@pxref{Init Rebinding}):
-
-@smallexample
-(global-set-key [mouse-3]
- '(menu-item "Menu Bar" ignore
- :filter (lambda (_)
- (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
- (mouse-menu-bar-map)
- (mouse-menu-major-mode-map)))))
-@end smallexample
+menu. If you prefer @kbd{mouse-3} in Emacs to bring up such a context
+menu instead of running the @code{mouse-save-then-kill} command,
+enable @code{context-menu-mode} and customize the variable
+@code{context-menu-functions}.
@node Mode Line Mouse
@section Mode Line Mouse Commands
@@ -1218,7 +1213,9 @@ the use of menu bars at startup, customize the variable
terminals, where this makes one additional line available for text.
If the menu bar is off, you can still pop up a menu of its contents
with @kbd{C-mouse-3} on a display which supports pop-up menus.
-@xref{Menu Mouse Clicks}.
+Or you can enable @code{context-menu-mode} and customize the variable
+@code{context-menu-functions} to pop up a context menu with
+@kbd{mouse-3}. @xref{Menu Mouse Clicks}.
@xref{Menu Bar}, for information on how to invoke commands with the
menu bar. @xref{X Resources}, for how to customize the menu bar
diff --git a/etc/NEWS b/etc/NEWS
index aaff30b..3f95d17 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -381,8 +381,17 @@ onto 'file-name-history'.
+++
** A prefix arg now causes 'delete-other-frames' to only iconify frames.
+** Menus
+
++++
+*** New mode 'context-menu-mode' for a context menu bound to 'mouse-3'.
+When this mode is enabled, clicking 'down-mouse-3' anywhere in the buffer
+pops up a context menu whose contents depends on surrounding context
+near the mouse click. You can customize the order of the default submenus
+in the context menu by customizing the user option 'context-menu-functions'.
+
+++
-** The "Edit => Clear" menu item now obeys a rectangular region.
+*** The "Edit => Clear" menu item now obeys a rectangular region.
+++
** New command 'execute-extended-command-for-buffer'.
diff --git a/lisp/dired.el b/lisp/dired.el
index ff82250..0add0ab 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2194,6 +2194,21 @@ 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] 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))))))
+ menu)
+
;;; Dired mode
@@ -2293,6 +2308,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/help-mode.el b/lisp/help-mode.el
index 2f82d83..e2d8ee0 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -70,6 +70,35 @@
["Customize" help-customize
:help "Customize variable or face"]))
+(defun help-mode-context-menu (menu)
+ (define-key menu [help-mode-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Help-Mode")))
+ (easy-menu-define nil easy-menu nil
+ '("Help-Mode"
+ ["Previous Topic" help-go-back
+ :help "Go back to previous topic in this help buffer"
+ :active help-xref-stack]
+ ["Next Topic" help-go-forward
+ :help "Go back to next topic in this help buffer"
+ :active help-xref-forward-stack]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar help-mode])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (and
+ ;; First check if `help-fns--list-local-commands'
+ ;; used `where-is-internal' to call this function
+ ;; with wrong `last-input-event'.
+ (eq (current-buffer) (window-buffer (posn-window (event-start
last-input-event))))
+ (mouse-posn-property (event-start last-input-event) 'mouse-face))
+ (define-key menu [help-mode-push-button]
+ '(menu-item "Follow Link" (lambda (event)
+ (interactive "e")
+ (push-button event))
+ :help "Follow the link at click")))
+
+ menu)
+
(defvar help-mode-tool-bar-map
(let ((map (make-sparse-keymap)))
(tool-bar-local-item "close" 'quit-window 'quit map
@@ -340,6 +369,7 @@ Commands:
\\{help-mode-map}"
(setq-local revert-buffer-function
#'help-mode-revert-buffer)
+ (add-hook 'context-menu-functions 'help-mode-context-menu 5 t)
(setq-local tool-bar-map
help-mode-tool-bar-map)
(setq-local help-mode--current-data nil)
diff --git a/lisp/info.el b/lisp/info.el
index 3718a1e..e6b5f3e 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"])
@@ -4146,6 +4146,25 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
"---"
["Exit" quit-window :help "Stop reading Info"]))
+(defun Info-context-menu (menu)
+ (define-key menu [Info-separator] 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 (reverse (lookup-key easy-menu [menu-bar info])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (mouse-posn-property (event-start last-input-event) 'mouse-face)
+ (define-key menu [Info-mouse-follow-nearest-node]
+ '(menu-item "Follow Link" Info-mouse-follow-nearest-node
+ :help "Follow a link where you click")))
+
+ menu)
(defvar info-tool-bar-map
(let ((map (make-sparse-keymap)))
@@ -4446,6 +4465,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 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 cf7c17b..4c4a7d3 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)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 2a81d2e..90301e9 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1021,6 +1021,35 @@ the like."
["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
map))
+(defun eww-context-menu (menu)
+ (define-key menu [eww-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Eww")))
+ (easy-menu-define nil easy-menu nil
+ '("Eww"
+ ["Back to previous page" eww-back-url
+ :visible (not (zerop (length eww-history)))]
+ ["Forward to next page" eww-forward-url
+ :visible (not (zerop eww-history-position))]
+ ["Reload" eww-reload t]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (or (mouse-posn-property (event-start last-input-event) 'shr-url)
+ (mouse-posn-property (event-start last-input-event) 'image-url))
+ (define-key menu [shr-mouse-browse-url-new-window]
+ `(menu-item "Follow URL in new window" ,(if browse-url-new-window-flag
+ 'shr-mouse-browse-url
+
'shr-mouse-browse-url-new-window)
+ :help "Browse the URL under the mouse cursor in a new
window"))
+ (define-key menu [shr-mouse-browse-url]
+ `(menu-item "Follow URL" ,(if browse-url-new-window-flag
+ 'shr-mouse-browse-url-new-window
+ 'shr-mouse-browse-url)
+ :help "Browse the URL under the mouse cursor")))
+
+ menu)
+
(defvar eww-tool-bar-map
(let ((map (make-sparse-keymap)))
(dolist (tool-bar-item
@@ -1044,6 +1073,7 @@ the like."
(setq-local eww-data (list :title ""))
(setq-local browse-url-browser-function #'eww-browse-url)
(add-hook 'after-change-functions #'eww-process-text-input nil t)
+ (add-hook 'context-menu-functions 'eww-context-menu 5 t)
(setq-local eww-history nil)
(setq-local eww-history-position 0)
(when (boundp 'tool-bar-map)
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 8992ef7..2c43d0f 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)
+ (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
"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-mouse (click)
+ "Send to the e-mail address or load the URL at mouse 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)
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 19de754..a8b608b 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -43,6 +43,24 @@
display-line-numbers-mode
prettify-symbols-mode))
+(defun prog-context-menu (menu)
+ (when (featurep 'xref)
+ (define-key-after menu [prog-separator] menu-bar-separator
+ 'mark-whole-buffer)
+ (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")
+ 'prog-separator)
+ (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")
+ 'xref-find-def))
+ menu)
+
(defvar prog-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?\C-\M-q] 'prog-indent-sexp)
@@ -249,6 +267,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))