Emacs context menu handler that respects inhibition.

dotemacs-context-menu.el

;;; dotemacs-context-menu.el --- Inhibition-aware context menu setup -*- lexical-binding: t -*-

;;; Commentary:
;;
;; This library installs a small inhibition layer around Emacs context menu
;; creation.
;;
;; The context menu is normally produced by `context-menu-map'.  Some commands
;; and completion annotations can accidentally trigger context menu generation
;; while they are trying to inspect a mouse event or annotate a candidate.  This
;; library keeps the normal context menu behavior intact, but returns nil from
;; `context-menu-map' while selected commands are running.
;;
;; `dotemacs/context-menu-setup' installs the integration.  The module calls it
;; when loaded so that requiring this file is enough to activate the behavior.
;;
;; https://lists.nongnu.org/archive/html/bug-gnu-emacs/2022-02/msg00779.html

;;; Code:

(require 'mouse)

(defgroup dotemacs-context-menu nil
  "Inhibition-aware context menu setup."
  :group 'mouse
  :group 'completion
  :prefix "dotemacs-context-menu-")

(defcustom dotemacs-context-menu-inhibit-during-help t
  "Non-nil means inhibit context menu creation during help commands.

This affects commands such as `describe-key', `describe-function',
`describe-variable', and `describe-symbol'."
  :type 'boolean
  :safe #'booleanp
  :group 'dotemacs-context-menu)

(defcustom dotemacs-context-menu-inhibit-during-marginalia t
  "Non-nil means inhibit context menu creation during Marginalia annotation.

This avoids mouse-event conflicts while completion UIs such as Vertico ask
Marginalia to annotate completion candidates."
  :type 'boolean
  :safe #'booleanp
  :group 'dotemacs-context-menu)

(defconst dotemacs-context-menu--help-functions
  '(describe-key
    describe-function
    describe-variable
    describe-symbol)
  "Help functions that may need context menu inhibition.")

(defconst dotemacs-context-menu--marginalia-functions
  '(marginalia--documentation
    marginalia-annotate-command)
  "Marginalia functions that may need context menu inhibition.")

(defvar dotemacs-context-menu--inhibit nil
  "Non-nil means suppress context menu creation.

This variable is dynamically bound by advice around functions that inspect
mouse events or annotate completion candidates.")

(defvar dotemacs-context-menu--original-map-function nil
  "Original function definition of `context-menu-map'.")

(defun dotemacs//context-menu-advised-p (function)
  "Return non-nil when FUNCTION has context menu inhibition advice."
  (and (fboundp function)
       (advice-member-p #'dotemacs//context-menu-inhibit-call function)))

(defun dotemacs//context-menu-map-installed-p ()
  "Return non-nil when `context-menu-map' uses the local replacement."
  (eq (symbol-function 'context-menu-map)
      #'dotemacs//context-menu-map))

(defun dotemacs//context-menu-inhibit-call (function &rest arguments)
  "Call FUNCTION with ARGUMENTS while context menu creation is inhibited."
  (let ((dotemacs-context-menu--inhibit t))
    (apply function arguments)))

(defun dotemacs//context-menu-map (&rest arguments)
  "Return the normal context menu unless context menu creation is inhibited.

ARGUMENTS are passed to the original `context-menu-map' function."
  (unless dotemacs-context-menu--inhibit
    (when dotemacs-context-menu--original-map-function
      (apply dotemacs-context-menu--original-map-function arguments))))

(defun dotemacs//context-menu-add-advice (function)
  "Add context menu inhibition advice to FUNCTION when it is defined."
  (when (and (fboundp function)
             (not (dotemacs//context-menu-advised-p function)))
    (advice-add function :around #'dotemacs//context-menu-inhibit-call)))

(defun dotemacs//context-menu-remove-advice (function)
  "Remove context menu inhibition advice from FUNCTION."
  (when (fboundp function)
    (advice-remove function #'dotemacs//context-menu-inhibit-call)))

(defun dotemacs//context-menu-setup-help-advice ()
  "Install or remove context menu inhibition advice for help commands."
  (dolist (function dotemacs-context-menu--help-functions)
    (if dotemacs-context-menu-inhibit-during-help
        (dotemacs//context-menu-add-advice function)
      (dotemacs//context-menu-remove-advice function))))

(defun dotemacs//context-menu-remove-help-advice ()
  "Remove context menu inhibition advice from help commands."
  (dolist (function dotemacs-context-menu--help-functions)
    (dotemacs//context-menu-remove-advice function)))

(defun dotemacs//context-menu-setup-marginalia-advice ()
  "Install or remove context menu inhibition advice for Marginalia."
  (dolist (function dotemacs-context-menu--marginalia-functions)
    (if dotemacs-context-menu-inhibit-during-marginalia
        (dotemacs//context-menu-add-advice function)
      (dotemacs//context-menu-remove-advice function))))

(defun dotemacs//context-menu-remove-marginalia-advice ()
  "Remove context menu inhibition advice from Marginalia."
  (dolist (function dotemacs-context-menu--marginalia-functions)
    (dotemacs//context-menu-remove-advice function)))

(defun dotemacs//context-menu-save-map-function ()
  "Record the current `context-menu-map' function."
  (unless dotemacs-context-menu--original-map-function
    (let ((function (symbol-function 'context-menu-map)))
      (unless (eq function #'dotemacs//context-menu-map)
        (setq dotemacs-context-menu--original-map-function function)))))

(defun dotemacs//context-menu-install-map-function ()
  "Install the inhibition-aware `context-menu-map' replacement."
  (dotemacs//context-menu-save-map-function)
  (unless (dotemacs//context-menu-map-installed-p)
    (fset 'context-menu-map #'dotemacs//context-menu-map)))

(defun dotemacs//context-menu-restore-map-function ()
  "Restore the original `context-menu-map' function."
  (when dotemacs-context-menu--original-map-function
    (when (dotemacs//context-menu-map-installed-p)
      (fset 'context-menu-map dotemacs-context-menu--original-map-function))
    (setq dotemacs-context-menu--original-map-function nil)))

(defun dotemacs//context-menu-marginalia-state ()
  "Return a display string describing Marginalia advice state."
  (cond
   ((not (featurep 'marginalia))
    "not loaded")
   ((cl-some #'dotemacs//context-menu-advised-p
             dotemacs-context-menu--marginalia-functions)
    "installed")
   (t
    "not installed")))

;;;###autoload
(defun dotemacs/context-menu-setup ()
  "Install context menu inhibition integration.

The integration is idempotent.  Calling this command more than once keeps
one replacement for `context-menu-map' and one advice entry per configured
function."
  (interactive)
  (dotemacs//context-menu-install-map-function)
  (dotemacs//context-menu-setup-help-advice)
  (if (featurep 'marginalia)
      (dotemacs//context-menu-setup-marginalia-advice)
    (with-eval-after-load 'marginalia
      (dotemacs//context-menu-setup-marginalia-advice))))

;;;###autoload
(defun dotemacs/context-menu-teardown ()
  "Remove context menu inhibition integration.

This restores `context-menu-map' when it is still using the local
replacement and removes all advice installed by this library."
  (interactive)
  (dotemacs//context-menu-remove-help-advice)
  (dotemacs//context-menu-remove-marginalia-advice)
  (dotemacs//context-menu-restore-map-function))

;;;###autoload
(defun dotemacs/context-menu-status ()
  "Display the current context menu inhibition status."
  (interactive)
  (message
   "Context menu: map %s, help advice %s, Marginalia advice %s"
   (if (dotemacs//context-menu-map-installed-p)
       "installed"
     "not installed")
   (if (cl-some #'dotemacs//context-menu-advised-p
                dotemacs-context-menu--help-functions)
       "installed"
     "not installed")
   (dotemacs//context-menu-marginalia-state)))

(defun dotemacs-context-menu-unload-function ()
  "Unload context menu inhibition integration."
  (dotemacs/context-menu-teardown)
  nil)

(dotemacs/context-menu-setup)

(provide 'dotemacs-context-menu)

;;; dotemacs-context-menu.el ends here