procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add new mode context-menu-mode and use it in info.el and goto-addr.el

Browse source 
* 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.
This commit is contained in:
Juri Linkov 2021-07-20 23:48:43 +03:00
parent 1b251ed4e8
commit 292e6261be
3 changed files with 170 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lisp/info.el
View file

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

118
lisp/mouse.el
View file

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

23
lisp/net/goto-addr.el
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)
(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)