Subject: bug#50552: 28.0.50; Add context-menu-occur

From: Philip Kaludercic <[email-masked]>
Date: Sun, 12 Sep 2021 16:54:30 +0000

Hi,

the below patch adds the commands occur-word-at-mouse and
occur-symbol-at-mouse, and a function for context-menu-mode to occur
words or symbols where the context menu was invoked.

Would there be any interest in adding such a functionality?

>From cad330f31eb7f7b127a970296f323524d31e7fee Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <[email-masked]>
Date: Sat, 11 Sep 2021 22:41:32 +0200
Subject: [PATCH] Add occur menu for context-mode-menu

* lisp/mouse.el (context-menu-functions): Register context-menu-occur
(context-menu-occur): Add backend function
* lisp/replace.el (occur-word-at-mouse): Add command
(occur-symbol-at-mouse): Add command
---
 lisp/mouse.el   | 17 +++++++++++++++++
 lisp/replace.el | 14 ++++++++++++++
 2 files changed, 31 insertions(+)

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 7d3ed9a0e4..3590e27e3e 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -296,6 +296,7 @@ context-menu-functions
                   (function-item context-menu-buffers)
                   (function-item context-menu-vc)
                   (function-item context-menu-ffap)
+                  (function-item context-menu-occur)
                   (function :tag "Custom function")))
   :version "28.1")
 
@@ -465,6 +466,22 @@ context-menu-ffap
                     :help "Find file or URL guessed from text around mouse click"))))
   menu)
 
+(defun context-menu-occur (menu)
+  "Occur at point menu."
+  (save-excursion
+    (mouse-set-point last-input-event)
+    (let ((word (thing-at-point 'word))
+          (sym (thing-at-point 'symbol)))
+      (when (or word sym)
+        (define-key-after menu [occur-separator] menu-bar-separator)
+        (when word
+          (define-key-after menu [occur-word-at-mouse]
+            '(menu-item "Occur Word" occur-word-at-mouse)))
+        (when sym
+          (define-key-after menu [occur-symbol-at-mouse]
+            '(menu-item "Occur Symbol" occur-symbol-at-mouse))))))
+  menu)
+
 (defvar context-menu-entry
   `(menu-item ,(purecopy "Context Menu") ignore
               :filter (lambda (_) (context-menu-map))))
diff --git a/lisp/replace.el b/lisp/replace.el
index 69bdfe1331..f234a933bd 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2367,6 +2367,20 @@ occur-context-lines
      ;; And the second element is the list of context after-lines.
      (if (> nlines 0) after-lines))))
 
+(defun occur-word-at-mouse (event)
+  "Display an occur buffer for the word at EVENT."
+  (interactive "e")
+  (save-excursion
+    (mouse-set-point event)
+    (occur (regexp-quote (thing-at-point 'word)))))
+
+(defun occur-symbol-at-mouse (event)
+  "Display an occur buffer for the symbol at EVENT."
+  (interactive "e")
+  (save-excursion
+    (mouse-set-point event)
+    (occur (regexp-quote (thing-at-point 'symbol)))))
+
 
 ;; It would be nice to use \\[...], but there is no reasonable way
 ;; to make that display both SPC and Y.
-- 
2.30.2

In GNU Emacs 28.0.50 (build 3, x86_64-pc-linux-gnu, X toolkit, cairo version 1.16.0, Xaw scroll bars)
 of 2021-09-11 built on icterid
Repository revision: 6d31d5b4b4649a25c6f1c8857c2371e14b7e3805
Repository branch: feature/rcirc-update
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Debian GNU/Linux 11 (bullseye)

Configured using:
 'configure LDFLAGS=-flto 'CFLAGS=-O2 -march=native -mtune=native -pipe'
 --with-native-compilation PKG_CONFIG_PATH='

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NATIVE_COMP
NOTIFY INOTIFY PDUMPER PNG SECCOMP SOUND THREADS TIFF
TOOLKIT_SCROLL_BARS X11 XDBE XIM XPM LUCID ZLIB

Important settings:
  value of $EMACSLOADPATH: 
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  fido-mode: t
  global-git-commit-mode: t
  magit-auto-revert-mode: t
  shell-dirtrack-mode: t
  TeX-PDF-mode: t
  paredit-mode: t
  company-mode: t
  flymake-mode: t
  flyspell-mode: t
  outline-minor-mode: t
  repeat-mode: t
  rcirc-track-minor-mode: t
  display-time-mode: t
  winner-mode: t
  windmove-mode: t
  electric-pair-mode: t
  recentf-mode: t
  save-place-mode: t
  savehist-mode: t
  show-paren-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tab-bar-mode: t
  file-name-shadow-mode: t
  context-menu-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  temp-buffer-resize-mode: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t

Load-path shadows:
/home/philip/.config/emacs/elpa/transient-0.3.6/transient hides /home/philip/Code/src/emacs/lisp/transient
~/.config/emacs/site-lisp/autoload hides /home/philip/Code/src/emacs/lisp/emacs-lisp/autoload

Features:
(shadow emacsbug mhtml-mode js skeleton autoinsert ibuf-ext loadhist
pcmpl-unix tar-mode rect dictionary dictionary-connection finder
modus-vivendi-theme magit-patch vc-dir edebug delsel ffap cvs-status
pcvs pcvs-defs pcvs-parse pcvs-info icomplete slime-tests ert ewoc slime
arc-mode archive-mode hyperspec sh-script executable org-element
avl-tree ol-eww ol-rmail ol-mhe ol-irc ol-info ol-gnus ol-docview
doc-view image-mode exif ol-bibtex bibtex ol-bbdb ol-w3m org ob
ob-tangle ob-ref ob-lob ob-table ob-exp org-macro org-footnote org-src
ob-comint org-pcomplete org-list org-faces org-entities org-version
ob-emacs-lisp ob-core ob-eval org-table ol org-keys org-compat advice
org-macs org-loaddefs crdt css-mode smie sgml-mode eww xdg url-queue
mm-url url-http finder-inf ibuffer ibuffer-loaddefs enriched facemenu
mailalias bbdb-pgp nnselect gnus-search flow-fill mm-archive qp
goto-addr bbdb-message autocrypt-message smiley gnus-cite mail-extr
gnus-async gnus-bcklg sort gnus-ml tabify man make-mode thai-util
thai-word insert-kaomoji url-about url-auth url-cache url-dired url-gw
vc-annotate magit-extras face-remap magit-submodule magit-obsolete
magit-blame magit-stash magit-reflog magit-bisect magit-push magit-pull
magit-fetch magit-clone magit-remote magit-commit magit-sequence
magit-notes magit-worktree magit-tag magit-merge magit-branch
magit-reset magit-files magit-refs magit-status magit magit-repos
magit-apply magit-wip magit-log which-func magit-diff git-commit
magit-core magit-autorevert autorevert filenotify magit-margin
magit-transient magit-process with-editor term ehelp eshell esh-cmd
esh-ext esh-opt esh-proc esh-io esh-arg esh-module esh-groups esh-util
server magit-mode transient format-spec magit-git magit-section cl-print
debug backtrace flymake-cc macrostep-c cmacexp macrostep apropos
eieio-opt speedbar ezimage dframe shortdoc imenu cus-edit cus-start
disp-table whitespace magit-utils dash tex-buf latex latex-flymake
tex-ispell tex-style grep markdown-mode find-dired avy log-edit add-log
smerge-mode cc-mode cc-fonts cc-guess cc-menus cc-cmds cc-styles
cc-align cc-engine cc-vars cc-defs pp autocrypt-gnus autocrypt nndraft
nnmh epa-file gnutls network-stream nsm nnmaildir nnfolder bbdb-gnus
bbdb-mua bbdb-com nnnil gnus-agent gnus-srvr gnus-score score-mode
nnvirtual gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime smime dig
nntp gnus-cache gnus-sum shr kinsoku svg dom gnus-group gnus-undo
gnus-start gnus-dbus gnus-cloud nnimap nnmail mail-source utf7 netrc
nnoo gnus-spec gnus-int gnus-range message rmc puny rfc822 mml mml-sec
epa epg rfc6068 epg-config mm-decode mm-bodies mm-encode mailabbrev
gmm-utils mailheader gnus-win shell pcomplete shell-command+ time-stamp
help-at-pt jka-compr mule-util cal-move pulse color find-func char-fold
misearch multi-isearch bug-reference tex-info tex dbus xml crm texmathp
texinfo texinfo-loaddefs dired-aux vc-backup log-view pcvs-util diff
vc-fossil vc-mtn vc-hg vc-git diff-mode vc-bzr vc-src vc-sccs vc-svn
vc-cvs vc-rcs vc vc-dispatcher paredit company-oddmuse company-keywords
company-etags etags fileloop generator xref project company-gtags
company-dabbrev-code company-dabbrev company-files company-capf
company-cmake company-xcode company-clang company-semantic company-eclim
company-template company-bbdb company checkdoc flymake-proc flymake
thingatpt flyspell ispell noutline outline easy-mmode repeat gnus-dired
dired-x dired dired-loaddefs rcirc parse-time iso8601 time bbdb derived
bbdb-site timezone sendmail gnus nnheader gnus-util rmail rmail-loaddefs
time-date mail-utils hippie-exp winner windmove elec-pair recentf
tree-widget wid-edit saveplace savehist paren modus-operandi-theme
modus-themes pcase edmacro kmacro holidays hol-loaddefs cal-menu
calendar cal-loaddefs cus-load setup load compile text-property-search
comint ansi-color autoload lisp-mnt mail-parse rfc2231 rfc2047 rfc2045
mm-util ietf-drums mail-prsvr tex-site geiser-impl help-fns radix-tree
geiser-custom geiser-base ring slime-autoloads info package browse-url
url url-proxy url-privacy url-expand url-methods url-history url-cookie
url-domsuf url-util mailcap url-handlers url-parse auth-source eieio
eieio-core eieio-loaddefs password-cache json map url-vars comp
comp-cstr warnings subr-x rx cl-seq cl-macs cl-extra help-mode seq
byte-opt gv bytecomp byte-compile cconv cl-loaddefs cl-lib iso-transl
tooltip eldoc electric uniquify ediff-hook vc-hooks lisp-float-type
mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode elisp-mode
lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch
easymenu timer select scroll-bar mouse jit-lock font-lock syntax
font-core term/tty-colors frame minibuffer cl-generic cham georgian
utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean
japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european
ethiopic indian cyrillic chinese composite charscript charprop
case-table epa-hook jka-cmpr-hook help simple abbrev obarray
cl-preloaded nadvice button loaddefs faces cus-face macroexp files
window text-properties overlay sha1 md5 base64 format env code-pages
mule custom widget hashtable-print-readable backquote threads dbusbind
inotify dynamic-setting system-font-setting font-render-setting cairo
x-toolkit x multi-tty make-network-process native-compile emacs)

Memory information:
((conses 16 1882584 1950104)
 (symbols 48 66780 234)
 (strings 32 353422 201509)
 (string-bytes 1 10945494)
 (vectors 16 131046)
 (vector-slots 8 3232159 1772668)
 (floats 8 1207 6466)
 (intervals 56 80220 44224)
 (buffers 992 116))

-- 
	Philip K.