Merge branch 'feature/context-menu'

This commit is contained in:
Juri Linkov 2021-08-17 11:11:35 +03:00
commit bf1ec4952e
9 changed files with 346 additions and 20 deletions

View file

@ -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

View file

@ -381,8 +381,17 @@ onto 'file-name-history'.
+++
** A prefix arg now causes 'delete-other-frames' to only iconify frames.
** Menus
+++
** The "Edit => Clear" menu item now obeys a rectangular region.
*** 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.
+++
** New command 'execute-extended-command-for-buffer'.

View file

@ -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))

View file

@ -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)

View file

@ -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)

View file

@ -276,6 +276,194 @@ not it is actually displayed."
local-menu
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.

View file

@ -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)

View file

@ -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)

View file

@ -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))