From 2a2e8d942a55b0fdd9f19008b60359546cfc1a44 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 12 Jul 2021 03:44:28 -0700 Subject: [PATCH 4/8] Support local ERC modules in erc-mode buffers * doc/misc/erc.texi: Mention local modules in Modules chapter. * etc/ERC-NEWS: Mention changes to `erc-update-modules'. * lisp/erc/erc.el (erc-migrate-modules): Add some missing mappings. (erc-modules): When a user removes a module, disable it and kill its local variable in all ERC buffers. (erc-update-modules): Move body of `erc-update-modules' to new internal function. (erc--update-modules): Add new function, a renamed and slightly modified version of `erc-update-modules'. Specifically, change return value from nil to a list of minor-mode commands for local modules. Use `custom-variable-p' to detect flavor. (erc--merge-local-modes): Add helper for finding local modules already active as minor modes in an ERC buffer. (erc-open): Replace `erc-update-modules' with `erc--update-modules'. Defer enabling of local modules via `erc--update-modules' until after buffer is initialized with other local vars. Also defer major-mode hooks so they can detect things like whether the buffer is a server or target buffer. Also ensure local module setup code can detect when `erc-open' was called with a non-nil `erc--server-reconnecting'. * lisp/erc/erc-common.el (erc--module-name-migrations, erc--features-to-modules, erc--modules-to-features): Add alists of old-to-new module names to support module-name migrations. (erc--assemble-toggle): Add new helper for constructing mode toggles, like `erc-sasl-enable'. (define-erc-modules): Defer to `erc--assemble-toggle' to create toggle commands. (erc--normalize-module-symbol): Add helper for `erc-migrate-modules'. * lisp/erc/erc-goodies.el: Require cl-lib. * test/lisp/erc/erc-tests.el (erc-migrate-modules, erc--update-modules): Add rudimentary unit tests asserting correct module-name mappings. (erc--merge-local-modes): Add test for helper. (define-erc-module--global, define-erc-module--local): Add tests asserting module-creation macro. (Bug#57955.) --- doc/misc/erc.texi | 37 ++++++++- etc/ERC-NEWS | 6 ++ lisp/erc/erc-common.el | 82 +++++++++++++++---- lisp/erc/erc-goodies.el | 1 + lisp/erc/erc.el | 104 ++++++++++++++++--------- test/lisp/erc/erc-tests.el | 156 +++++++++++++++++++++++++++++++++++++ 6 files changed, 333 insertions(+), 53 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 0d807e323e..0e016c6d8f 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -390,8 +390,11 @@ Modules There is a spiffy customize interface, which may be reached by typing @kbd{M-x customize-option @key{RET} erc-modules @key{RET}}. -Alternatively, set @code{erc-modules} manually and then call -@code{erc-update-modules}. +When removing a module outside of the Customize ecosystem, you may +wish to ensure it's disabled by invoking its associated minor-mode +toggle, such as @kbd{M-x erc-spelling-mode @key{RET}}. It may also be +worth noting that, these days, calling @code{erc-update-modules} in an +init file is typically unnecessary. The following is a list of available modules. @@ -517,6 +520,36 @@ Modules @end table +@subheading Local Modules + +All modules operate as minor modes under the hood, and some newer ones +may be defined as buffer-local. For everyday use, the only practical +differences are + +@enumerate +@item +``control variables,'' like @code{erc-sasl-mode}, are stateful across +IRC sessions and override @code{erc-module} membership when influencing +module activation in new sessions +@item +removing a local module from @code{erc-modules} via Customize not only +disables its mode but also kills its control variable in all ERC +buffers +@item +``toggle commands,'' like @code{erc-sasl-mode} and +@code{erc-sasl-enable}, behave differently, both from each other and +from their global counterparts +@end enumerate + +By default, all local-mode toggles, like @code{erc-sasl-mode}, only +affect the current buffer, but their ``non-mode'' variants, such as +@code{erc-sasl-enable}, operate on all buffers belonging to a +connection when called interactively. Keep in mind that whether +enabled or not, a module may effectively be ``inert'' in certain types +of buffers, such as queries and channels. Whatever the case, a local +toggle never mutates @code{erc-modules}. + + @c PRE5_4: Document every option of every module in its own subnode diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f638d4717a..832a9566d7 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -125,6 +125,12 @@ The function 'erc-auto-query' was deemed too difficult to reason through and has thus been deprecated with no public replacement; it has also been removed from the client code path. +The function 'erc-open' now delays running 'erc-mode-hook' members +until most local session variables have been initialized (minus those +connection-related ones in erc-backend). 'erc-open' also no longer +calls 'erc-update-modules', although modules are still activated +in an identical fashion. + A few internal variables have been introduced that could just as well have been made public, possibly as user options. Likewise for some internal functions. As always, users needing such functionality diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 23a1933798..a4046ba9b3 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -88,6 +88,65 @@ erc--target (contents "" :type string) (tags '() :type list)) +;; TODO move goodies modules here after 29 is released. +(defconst erc--features-to-modules + '((erc-pcomplete completion pcomplete) + (erc-capab capab-identify) + (erc-join autojoin) + (erc-page page ctcp-page) + (erc-sound sound ctcp-sound) + (erc-stamp stamp timestamp) + (erc-services services nickserv)) + "Migration alist mapping a library feature to module names. +Keys need not be unique: a library may define more than one +module. Sometimes a module's downcased alias will be its +canonical name.") + +(defconst erc--modules-to-features + (let (pairs) + (pcase-dolist (`(,feature . ,names) erc--features-to-modules) + (dolist (name names) + (push (cons name feature) pairs))) + (nreverse pairs)) + "Migration alist mapping a module's name to its home library feature.") + +(defconst erc--module-name-migrations + (let (pairs) + (pcase-dolist (`(,_ ,canonical . ,rest) erc--features-to-modules) + (dolist (obsolete rest) + (push (cons obsolete canonical) pairs))) + pairs) + "Association list of obsolete module names to canonical names.") + +(defun erc--normalize-module-symbol (symbol) + "Return preferred SYMBOL for `erc-modules'." + (setq symbol (intern (downcase (symbol-name symbol)))) + (or (cdr (assq symbol erc--module-name-migrations)) symbol)) + +(defun erc--assemble-toggle (localp name ablsym mode val body) + (let ((arg (make-symbol "arg"))) + `(defun ,ablsym ,(if localp `(&optional ,arg) '()) + ,(concat + (if val "Enable" "Disable") + " ERC " (symbol-name name) " mode." + (when localp + "\nWith ARG, do so in all buffers for the current connection.")) + (interactive ,@(when localp '("p"))) + ,@(if localp + `((when (derived-mode-p 'erc-mode) + (if ,arg + (erc-with-all-buffers-of-server erc-server-process nil + (,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))) + (setq ,mode ,val) + ,@body))))) + (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) "Define a new minor mode using ERC conventions. @@ -103,6 +162,13 @@ define-erc-module an alias erc-ALIAS-mode, as well as the helper functions erc-NAME-enable, and erc-NAME-disable. +With LOCAL-P, these helpers take on an optional argument that, +when non-nil, causes them to act on all buffers of a connection. +This feature is mainly intended for interactive use and does not +carry over to their respective minor-mode toggles. Beware that +for global modules, these helpers and toggles all mutate +`erc-modules'. + Example: ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\") @@ -133,20 +199,8 @@ define-erc-module (if ,mode (,enable) (,disable))) - (defun ,enable () - ,(format "Enable ERC %S mode." - name) - (interactive) - (add-to-list 'erc-modules (quote ,name)) - (setq ,mode t) - ,@enable-body) - (defun ,disable () - ,(format "Disable ERC %S mode." - name) - (interactive) - (setq erc-modules (delq (quote ,name) erc-modules)) - (setq ,mode nil) - ,@disable-body) + ,(erc--assemble-toggle local-p name enable mode t enable-body) + ,(erc--assemble-toggle local-p name disable mode nil disable-body) ,(when (and alias (not (eq name alias))) `(defalias ',(intern diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 59b5f01f23..1af83b58ba 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -31,6 +31,7 @@ ;;; Imenu support +(eval-when-compile (require 'cl-lib)) (require 'erc-common) (defvar erc-controls-highlight-regexp) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 352f72e617..384d92e624 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1791,10 +1791,7 @@ erc-migrate-modules "Migrate old names of ERC modules to new ones." ;; modify `transforms' to specify what needs to be changed ;; each item is in the format '(old . new) - (let ((transforms '((pcomplete . completion)))) - (delete-dups - (mapcar (lambda (m) (or (cdr (assoc m transforms)) m)) - mods)))) + (delete-dups (mapcar #'erc--normalize-module-symbol mods))) (defcustom erc-modules '(netsplit fill button match track completion readonly networks ring autojoin noncommands irccontrols @@ -1813,9 +1810,16 @@ erc-modules (dolist (module erc-modules) (unless (member module val) (let ((f (intern-soft (format "erc-%s-mode" module)))) - (when (and (fboundp f) (boundp f) (symbol-value f)) - (message "Disabling `erc-%s'" module) - (funcall f 0)))))) + (when (and (fboundp f) (boundp f)) + (when (symbol-value f) + (message "Disabling `erc-%s'" module) + (funcall f 0)) + (unless (or (custom-variable-p f) + (not (fboundp 'erc-buffer-filter))) + (erc-buffer-filter (lambda () + (when (symbol-value f) + (funcall f 0)) + (kill-local-variable f))))))))) (set sym val) ;; this test is for the case where erc hasn't been loaded yet (when (fboundp 'erc-update-modules) @@ -1873,27 +1877,23 @@ erc-modules :group 'erc) (defun erc-update-modules () - "Run this to enable erc-foo-mode for all modules in `erc-modules'." - (let (req) - (dolist (mod erc-modules) - (setq req (concat "erc-" (symbol-name mod))) - (cond - ;; yuck. perhaps we should bring the filenames into sync? - ((string= req "erc-capab-identify") - (setq req "erc-capab")) - ((string= req "erc-completion") - (setq req "erc-pcomplete")) - ((string= req "erc-pcomplete") - (setq mod 'completion)) - ((string= req "erc-autojoin") - (setq req "erc-join"))) - (condition-case nil - (require (intern req)) - (error nil)) - (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode")))) - (if (fboundp sym) - (funcall sym 1) - (error "`%s' is not a known ERC module" mod)))))) + "Enable minor mode for every module in `erc-modules'. +Except ignore all local modules, which were introduced in ERC 5.5." + (erc--update-modules) + nil) + +(defun erc--update-modules () + (let (local-modes) + (dolist (module erc-modules local-modes) + (require (or (alist-get module erc--modules-to-features) + (intern (concat "erc-" (symbol-name module)))) + nil 'noerror) ; some modules don't have a corresponding feature + (let ((mode (intern-soft (concat "erc-" (symbol-name module) "-mode")))) + (unless (and mode (fboundp mode)) + (error "`%s' is not a known ERC module" module)) + (if (custom-variable-p mode) + (funcall mode 1) + (push mode local-modes)))))) (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." @@ -1924,6 +1924,24 @@ erc-setup-buffer (display-buffer buffer) (switch-to-buffer buffer))))) +(defun erc--merge-local-modes (new-modes old-vars) + "Return a cons of two lists, each containing local-module modes. +In the first, put modes to be enabled in a new ERC buffer by +calling their associated functions. In the second, put modes to +be marked as disabled by setting their associated variables to +nil." + (if old-vars + (let ((out (list (reverse new-modes)))) + (pcase-dolist (`(,k . ,v) old-vars) + (when (and (string-prefix-p "erc-" (symbol-name k)) + (string-suffix-p "-mode" (symbol-name k))) + (if v + (cl-pushnew k (car out)) + (setf (car out) (delq k (car out))) + (cl-pushnew k (cdr out))))) + (cons (nreverse (car out)) (nreverse (cdr out)))) + (list new-modes))) + (defun erc-open (&optional server port nick full-name connect passwd tgt-list channel process client-certificate user id) @@ -1951,18 +1969,25 @@ erc-open (let* ((target (and channel (erc--target-from-string channel))) (buffer (erc-get-buffer-create server port nil target id)) (old-buffer (current-buffer)) - old-point + (old-vars (and (not connect) (buffer-local-variables))) + (old-recon-count erc-server-reconnect-count) + (old-point nil) + (delayed-modules nil) (continued-session (and erc--server-reconnecting (with-suppressed-warnings ((obsolete erc-reuse-buffers)) erc-reuse-buffers)))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) - (erc-update-modules) (set-buffer buffer) (setq old-point (point)) - (let ((old-recon-count erc-server-reconnect-count)) - (erc-mode) - (setq erc-server-reconnect-count old-recon-count)) + (setq delayed-modules + (erc--merge-local-modes (erc--update-modules) + (or erc--server-reconnecting old-vars))) + + (delay-mode-hooks (erc-mode)) + + (setq erc-server-reconnect-count old-recon-count) + (when (setq erc-server-connected (not connect)) (setq erc-server-announced-name (buffer-local-value 'erc-server-announced-name old-buffer))) @@ -2019,14 +2044,21 @@ erc-open (setq erc-session-client-certificate client-certificate) (setq erc-networks--id (if connect - (or (and continued-session - (buffer-local-value 'erc-networks--id old-buffer)) + (or (and erc--server-reconnecting + (alist-get 'erc-networks--id erc--server-reconnecting)) (and id (erc-networks--id-create id))) (buffer-local-value 'erc-networks--id old-buffer))) ;; debug output buffer (setq erc-dbuf (when erc-log-p (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) + + (erc-determine-parameters server port nick full-name user passwd) + + (save-excursion (run-mode-hooks)) + (dolist (mod (car delayed-modules)) (funcall mod +1)) + (dolist (var (cdr delayed-modules)) (set var nil)) + ;; set up prompt (unless continued-session (goto-char (point-max)) @@ -2038,8 +2070,6 @@ erc-open (erc-display-prompt) (goto-char (point-max))) - (erc-determine-parameters server port nick full-name user passwd) - ;; Saving log file on exit (run-hook-with-args 'erc-connect-pre-hook buffer) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index ff5d802697..b185d850a6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1178,4 +1178,160 @@ erc-handle-irc-url (kill-buffer "baznet") (kill-buffer "#chan"))) +(ert-deftest erc-migrate-modules () + (should (equal (erc-migrate-modules '(autojoin timestamp button)) + '(autojoin stamp button))) + ;; Default unchanged + (should (equal (erc-migrate-modules erc-modules) erc-modules))) + +(ert-deftest erc--update-modules () + (let (calls + erc-modules + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (cl-letf (((symbol-function 'require) + (lambda (s &rest _) (push s calls))) + + ;; Local modules + ((symbol-function 'erc-fake-bar-mode) + (lambda (n) (push (cons 'fake-bar n) calls))) + + ;; Global modules + ((symbol-function 'erc-fake-foo-mode) + (lambda (n) (push (cons 'fake-foo n) calls))) + ((get 'erc-fake-foo-mode 'standard-value) 'ignore) + ((symbol-function 'erc-autojoin-mode) + (lambda (n) (push (cons 'autojoin n) calls))) + ((get 'erc-autojoin-mode 'standard-value) 'ignore) + ((symbol-function 'erc-networks-mode) + (lambda (n) (push (cons 'networks n) calls))) + ((get 'erc-networks-mode 'standard-value) 'ignore) + ((symbol-function 'erc-completion-mode) + (lambda (n) (push (cons 'completion n) calls))) + ((get 'erc-completion-mode 'standard-value) 'ignore)) + + (ert-info ("Local modules") + (setq erc-modules '(fake-foo fake-bar)) + (should (equal (erc--update-modules) '(erc-fake-bar-mode))) + ;; Bar the feature is still required but the mode is not activated + (should (equal (nreverse calls) + '(erc-fake-foo (fake-foo . 1) erc-fake-bar))) + (setq calls nil)) + + (ert-info ("Module name overrides") + (setq erc-modules '(completion autojoin networks)) + (should-not (erc--update-modules)) ; no locals + (should (equal (nreverse calls) '( erc-pcomplete (completion . 1) + erc-join (autojoin . 1) + erc-networks (networks . 1)))) + (setq calls nil))))) + +(ert-deftest erc--merge-local-modes () + + (ert-info ("No existing modes") + (let ((old '((a) (b . t))) + (new '(erc-c-mode erc-d-mode))) + (should (equal (erc--merge-local-modes new old) + '((erc-c-mode erc-d-mode)))))) + + (ert-info ("Active existing added, inactive existing removed, deduped") + (let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t))) + (new '(erc-b-mode erc-d-mode))) + (should (equal (erc--merge-local-modes new old) + '((erc-d-mode erc-e-mode) . (erc-b-mode))))))) + +(ert-deftest define-erc-module--global () + (let ((global-module '(define-erc-module mname malias + "Some docstring" + ((ignore a) (ignore b)) + ((ignore c) (ignore d))))) + + (should (equal (macroexpand global-module) + `(progn + + (define-minor-mode erc-mname-mode + "Toggle ERC mname mode. +With a prefix argument ARG, enable mname if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. +Some docstring" + :global t + :group 'erc-mname + (if erc-mname-mode + (erc-mname-enable) + (erc-mname-disable))) + + (defun erc-mname-enable () + "Enable ERC mname mode." + (interactive) + (cl-pushnew 'mname erc-modules) + (setq erc-mname-mode t) + (ignore a) (ignore b)) + + (defun erc-mname-disable () + "Disable ERC mname mode." + (interactive) + (setq erc-modules (delq 'mname erc-modules)) + (setq erc-mname-mode nil) + (ignore c) (ignore d)) + + (defalias 'erc-malias-mode #'erc-mname-mode) + + (put 'erc-mname-mode 'definition-name 'mname) + (put 'erc-mname-enable 'definition-name 'mname) + (put 'erc-mname-disable 'definition-name 'mname)))))) + +(ert-deftest define-erc-module--local () + (let* ((global-module '(define-erc-module mname malias + "Some docstring" + ((ignore a) (ignore b)) + ((ignore c) (ignore d)) + 'local)) + (got (macroexpand global-module)) + (arg-en (cadr (nth 2 (nth 2 got)))) + (arg-dis (cadr (nth 2 (nth 3 got))))) + + (should (equal got + `(progn + (define-minor-mode erc-mname-mode + "Toggle ERC mname mode. +With a prefix argument ARG, enable mname if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. +Some docstring" + :global nil + :group 'erc-mname + (if erc-mname-mode + (erc-mname-enable) + (erc-mname-disable))) + + (defun erc-mname-enable (&optional ,arg-en) + "Enable ERC mname mode. +With ARG, do so in all buffers for the current connection." + (interactive "p") + (when (derived-mode-p 'erc-mode) + (if ,arg-en + (erc-with-all-buffers-of-server + erc-server-process nil + (erc-mname-enable)) + (setq erc-mname-mode t) + (ignore a) (ignore b)))) + + (defun erc-mname-disable (&optional ,arg-dis) + "Disable ERC mname mode. +With ARG, do so in all buffers for the current connection." + (interactive "p") + (when (derived-mode-p 'erc-mode) + (if ,arg-dis + (erc-with-all-buffers-of-server + erc-server-process nil + (erc-mname-disable)) + (setq erc-mname-mode nil) + (ignore c) (ignore d)))) + + (defalias 'erc-malias-mode #'erc-mname-mode) + + (put 'erc-mname-mode 'definition-name 'mname) + (put 'erc-mname-enable 'definition-name 'mname) + (put 'erc-mname-disable 'definition-name 'mname)))))) + ;;; erc-tests.el ends here -- 2.38.1