>From 764dc63582a440495ab53a9986003d5d1a794bcf Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 14 Jan 2023 19:08:11 -0800 Subject: [PATCH 2/3] [5.6] Warn when setting minor-mode vars for ERC modules (erc--inside-mode-toggle-p): Add global var to inhibit mode toggles from being run by `erc-update-modules'. It must be non-nil inside custom-set functions for mode toggles created by `define-erc-module'. (erc--assemble-toggle): Don't modify `erc-modules' when run from custom-set function. (erc--custom-set-minor-mode): Add new custom-set function for module minor modes. Update `erc-modules' before calling a minor-mode toggle via `custom-set-minor-mode'. (erc--tick-module-checkbox): Add helper to toggle the appropriate checkbox in the `erc-modules' widget when a user interactively toggles a minor-mode state variable. (erc--prepare-custom-module-type): Create spec for minor-mode custom `:type', deferring various aspects until module-definition time. (define-erc-module): Add `:set' and `:type' keywords for global modules. * lisp/erc/erc.el (erc-modules): Inhibit `erc-update-modules' when run from a minor-mode toggle's custom-set function. * test/lisp/erc/erc-tests.el (define-erc-module--global, define-erc-module--local): Update `erc-modules' mutations with `erc--inside-mode-toggle-p' guard conditions. (Bug#60935.) --- lisp/erc/erc-common.el | 88 +++++++++++++++++++++++++++++++++++--- lisp/erc/erc.el | 3 +- test/lisp/erc/erc-tests.el | 23 ++++++++-- 3 files changed, 105 insertions(+), 9 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 0eabd3a2fe9..cd0fc79e568 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -29,6 +29,7 @@ (defvar erc--casemapping-rfc1459) (defvar erc--casemapping-rfc1459-strict) (defvar erc-channel-users) +(defvar erc-modules) (defvar erc-dbuf) (defvar erc-log-p) (defvar erc-server-users) @@ -37,6 +38,11 @@ erc-session-server (declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) (declare-function erc-get-buffer "erc" (target &optional proc)) (declare-function erc-server-buffer "erc" nil) +(declare-function widget-apply-action "wid-edit" (widget &optional event)) +(declare-function widget-at "wid-edit" (&optional pos)) +(declare-function widget-get-sibling "wid-edit" (widget)) +(declare-function widget-move "wid-edit" (arg &optional suppress-echo)) +(declare-function widget-type "wid-edit" (widget)) (cl-defstruct erc-input string insertp sendp) @@ -120,6 +126,16 @@ erc--normalize-module-symbol (setq symbol (intern (downcase (symbol-name symbol)))) (or (cdr (assq symbol erc--module-name-migrations)) symbol)) +(defvar erc--inside-mode-toggle-p nil + "Non-nil when a module's mode toggle is updating module membership. +This serves as a flag to inhibit the mutual recursion that would +otherwise occur between an ERC-defined minor-mode function, such +as `erc-services-mode', and the custom-set function for +`erc-modules'. For historical reasons, the latter calls +`erc-update-modules', which, in turn, enables the minor-mode +functions for all member modules. Also non-nil when a mode's +widget runs its set function.") + (defun erc--assemble-toggle (localp name ablsym mode val body) (let ((arg (make-symbol "arg"))) `(defun ,ablsym ,(if localp `(&optional ,arg) '()) @@ -137,12 +153,23 @@ erc--assemble-toggle (,ablsym)) (setq ,mode ,val) ,@body))) - `(,(if val - `(cl-pushnew ',(erc--normalize-module-symbol name) - erc-modules) - `(setq erc-modules (delq ',(erc--normalize-module-symbol name) - erc-modules))) + ;; No need for `default-value', etc. because a buffer-local + ;; `erc-modules' only influences the next session and + ;; doesn't survive the major-mode reset that soon follows. + `((unless + (or erc--inside-mode-toggle-p + ,@(let ((v `(memq ',(erc--normalize-module-symbol name) + erc-modules))) + `(,(if val v `(not ,v))))) + (let ((erc--inside-mode-toggle-p t)) + (custom-set-variables + `(erc-modules ',(,(if val 'cons 'delq) + ',(erc--normalize-module-symbol name) + erc-modules))))) (setq ,mode ,val) + ;; Avoid "changed" state from `erc-update-modules' + (unless (called-interactively-p 'any) + (put ',mode 'standard-value (list ,val))) ,@body))))) ;; This is a migration helper that determines a module's `:group' @@ -176,6 +203,55 @@ erc--find-group (throw 'found found))) 'erc)) +(defun erc--custom-set-minor-mode (variable value) + (let ((name (get variable 'erc-module)) + (erc--inside-mode-toggle-p t)) + (custom-set-variables + `(erc-modules + ',(if value (cl-pushnew name erc-modules) (delq name erc-modules)))) + (custom-set-minor-mode variable value))) + +;; This exists as a separate, top-level function to prevent the byte +;; compiler from warning about widget-related dependencies not being +;; loaded at runtime. + +(defun erc--tick-module-checkbox (name &rest _) ; `name' must be normalized + (customize-variable-other-window 'erc-modules) + ;; Move to `erc-modules' section. + (while (not (eq (widget-type (widget-at)) 'checkbox)) + (widget-move 1 t)) + ;; This search for a checkbox can fail when `name' refers to a + ;; third-party module that modifies `erc-modules' (improperly) on + ;; load. + (let (w) + (while (and (eq (widget-type (widget-at)) 'checkbox) + (not (and (setq w (widget-get-sibling (widget-at))) + (eq (widget-value w) name)))) + (setq w nil) + (widget-move 1 t)) ; the `suppress-echo' arg exists in 27.2 + (if w + (progn (widget-apply-action (widget-at)) + (message "Hit %s to apply or %s to apply and save." + (substitute-command-keys "\\[Custom-set]") + (substitute-command-keys "\\[Custom-save]"))) + (error "Failed to find %s in `erc-modules' checklist" name)))) + +(defun erc--prepare-custom-module-type (name) + `(let* ((name (erc--normalize-module-symbol ',name)) + (fmtd (format " `%s' " name))) + `(boolean + :button-face '(error custom-button) + :format "%{%t%}: %[Deprecated Toggle%] \n%d\n" + :doc ,(concat "Setting a module's minor-mode variable is " + (propertize "ineffective" 'face 'error) ".\nPlease add" + fmtd "directly to `erc-modules' instead.\nYou can do so" + " now by clicking the scary button above.") + :help-echo ,(lambda (_) + (let ((hasp (memq name erc-modules))) + (concat (if hasp "Remove" "Add") fmtd + (if hasp "from" "to") " `erc-modules'."))) + :action ,(apply-partially #'erc--tick-module-checkbox name)))) + (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) "Define a new minor mode using ERC conventions. @@ -222,6 +298,8 @@ define-erc-module %s" name name doc) :global ,(not local-p) :group (erc--find-group ',name ,(and alias (list 'quote alias))) + ,@(unless local-p '(:set #'erc--custom-set-minor-mode)) + ,@(unless local-p `(:type ,(erc--prepare-custom-module-type name))) (if ,mode (,enable) (,disable))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 69bdb5d71b1..59ab1f1eab3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1846,7 +1846,8 @@ erc-modules (set sym val) ;; this test is for the case where erc hasn't been loaded yet (when (fboundp 'erc-update-modules) - (erc-update-modules))) + (unless erc--inside-mode-toggle-p + (erc-update-modules)))) :type '(set :greedy t diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 13ef99be167..a31c2c530a3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1313,7 +1313,10 @@ define-erc-module--global ((ignore a) (ignore b)) ((ignore c) (ignore d))))) - (should (equal (macroexpand global-module) + (should (equal (cl-letf (((symbol-function + 'erc--prepare-custom-module-type) + #'symbol-name)) + (macroexpand global-module)) `(progn (define-minor-mode erc-mname-mode @@ -1324,6 +1327,8 @@ define-erc-module--global Some docstring" :global t :group (erc--find-group 'mname 'malias) + :set #'erc--custom-set-minor-mode + :type "mname" (if erc-mname-mode (erc-mname-enable) (erc-mname-disable))) @@ -1331,15 +1336,27 @@ define-erc-module--global (defun erc-mname-enable () "Enable ERC mname mode." (interactive) - (cl-pushnew 'mname erc-modules) + (unless (or erc--inside-mode-toggle-p + (memq 'mname erc-modules)) + (let ((erc--inside-mode-toggle-p t)) + (custom-set-variables + `(erc-modules ',(cons 'mname erc-modules))))) (setq erc-mname-mode t) + (unless (called-interactively-p 'any) + (put 'erc-mname-mode 'standard-value (list t))) (ignore a) (ignore b)) (defun erc-mname-disable () "Disable ERC mname mode." (interactive) - (setq erc-modules (delq 'mname erc-modules)) + (unless (or erc--inside-mode-toggle-p + (not (memq 'mname erc-modules))) + (let ((erc--inside-mode-toggle-p t)) + (custom-set-variables + `(erc-modules ',(delq 'mname erc-modules))))) (setq erc-mname-mode nil) + (unless (called-interactively-p 'any) + (put 'erc-mname-mode 'standard-value (list nil))) (ignore c) (ignore d)) (defalias 'erc-malias-mode #'erc-mname-mode) -- 2.39.2