master 4c4936fab2 4/8: Support local ERC modules in erc-mode buffers

[Amin Bandali]

branch: master
commit 4c4936fab2ecd97ff6e03e5cfe12def4626c718b
Author: F. Jason Park <jp@neverwas.me>
Commit: Amin Bandali <bandali@gnu.org>

    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          |  39 +++++++++++-
 etc/ERC-NEWS               |   9 +++
 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, 338 insertions(+), 53 deletions(-)

diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 0d807e323e..b9c6e33d36 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -390,8 +390,11 @@ modules are loaded.
 
 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 Custom 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}}.  Note 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,38 @@ Translate morse code in messages
 
 @end table
 
+@subheading Local Modules
+@cindex local modules
+
+All modules operate as minor modes under the hood, and some newer ones
+may be defined as buffer-local.  These so-called ``local modules'' are
+a work in progress and their behavior and interface are subject to
+change.  As of ERC 5.5, 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
+``Mode toggles,'' like @code{erc-sasl-mode} and
+@code{erc-sasl-enable}, behave differently relative to each other and
+to their global counterparts.  (More on this just below.)
+@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..15f7fe84dd 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -125,6 +125,15 @@ 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.
+
+Some groundwork has been laid for what may become a new breed of ERC
+module, namely, "connection-local" (or simply "local") modules.
+
 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 @@
   (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 @@ This will define a minor mode called erc-NAME-mode, 
possibly
 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 @@ if ARG is omitted or nil.
          (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 @@ buffer rather than a server buffer.")
   "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 @@ removed from the list will be disabled."
            (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 @@ removed from the list will be disabled."
   :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 @@ removed from the list will be disabled."
          (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 @@ Returns the buffer for the given server or channel."
   (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 @@ Returns the buffer for the given server or channel."
     (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 @@ Returns the buffer for the given server or channel."
       (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 @@
     (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