mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
Sort and dedupe when loading modules in erc-open
* doc/misc/erc.texi: Add new subheading "Module Loading" under the "Modules" chapter. * lisp/erc/erc.el (erc--sort-modules): New utility function to sort and dedupe modules. (erc-modules): In `custom-set' function, factor out collation into separate utility `erc--sort-modules'. (erc-update-modules): Call `erc--update-modules' with an argument, the current value of `erc-modules'. (erc--aberrant-modules): New variable, a list of symbols whose modules ERC suspects of being incorrectly defined. (erc--warn-about-aberrant-modules): New function to print an error message and emit a warning prior to connecting when `erc--aberrant-modules' is non-nil. (erc--find-mode): Make heuristic more robust by always checking for a mode activation command rather than just a state variable. This fixes a compatibility bug, new in 5.6, affecting third-party modules that autoload module definitions instead of their corresponding mode-activation commands. (erc--update-modules): Add new positional argument `modules'. (erc--setup-buffer-hook): Add new default member, `erc--warn-about-aberrant-modules'. (erc-open): Pass sorted `erc-modules' to `erc--update-modules'. * test/lisp/erc/erc-tests.el (erc--sort-modules): New test. (erc-tests--update-modules): New fixture. (erc--update-modules): Remove and rework as three separate tests dedicated to specific contexts. The existing one had poor coverage and was difficult, if not impossible, to follow. (erc--update-modules/unknown, erc--update-modules/local, erc--update-modules/realistic): New tests. (Bug#57955)
This commit is contained in:
F. Jason Park
parent
9120d7a32e
commit
d46c016fbd
@ -653,6 +653,41 @@ And unlike global toggles, none of these ever mutates
|
||||
@code{erc-modules}.
|
||||
|
||||
|
||||
@anchor{Module Loading}
|
||||
@subheading Module Loading
|
||||
@cindex module loading
|
||||
|
||||
ERC loads internal modules in alphabetical order and third-party
|
||||
modules as they appear in @code{erc-modules}. When defining your own
|
||||
module, take care to ensure ERC can find it. An easy way to do that
|
||||
is by mimicking the example in the doc string for
|
||||
@code{define-erc-module}. For historical reasons, ERC also falls back
|
||||
to @code{require}ing features. For example, if some module
|
||||
@code{<mymod>} in @code{erc-modules} lacks a corresponding
|
||||
@code{erc-<mymod>-mode} command, ERC will attempt to load the library
|
||||
@code{erc-<mymod>} prior to connecting. If this fails, ERC signals an
|
||||
error. Users wanting to define modules in an init files should
|
||||
@code{(provide 'erc-<my-mod>)} somewhere to placate ERC. Dynamically
|
||||
generating modules on the fly is not supported.
|
||||
|
||||
Sometimes, packages attempt to autoload a module's definition instead
|
||||
of its minor-mode command, which breaks the link between the library
|
||||
and the module. This means that enabling the mode by invoking its
|
||||
command toggle isn't enough to load its defining library. Such
|
||||
packages should instead only supply autoload cookies featuring an
|
||||
explicit @code{autoload} form for their module's minor-mode command.
|
||||
As mentioned above, packages can also usually avoid autoload cookies
|
||||
entirely so long as their module's prefixed name matches that of its
|
||||
defining library and the latter's provided feature.
|
||||
|
||||
Packages have also been seen to specify unnecessary top-level
|
||||
@code{eval-after-load} forms, which end up being ineffective in most
|
||||
cases. Another unfortunate practice is mutating @code{erc-modules}
|
||||
itself in an autoloaded form. Doing this tricks Customize into
|
||||
displaying the widget for @code{erc-modules} incorrectly, with
|
||||
built-in modules moved from the predefined checklist to the
|
||||
user-provided free-form area.
|
||||
|
||||
@c PRE5_4: Document every option of every module in its own subnode
|
||||
|
||||
|
||||
|
||||
@ -2004,6 +2004,14 @@ buffer rather than a server buffer.")
|
||||
;; each item is in the format '(old . new)
|
||||
(delete-dups (mapcar #'erc--normalize-module-symbol mods)))
|
||||
|
||||
(defun erc--sort-modules (modules)
|
||||
"Return a copy of MODULES, deduped and led by sorted built-ins."
|
||||
(let (built-in third-party)
|
||||
(dolist (mod modules)
|
||||
(setq mod (erc--normalize-module-symbol mod))
|
||||
(cl-pushnew mod (if (get mod 'erc--module) built-in third-party)))
|
||||
`(,@(sort built-in #'string-lessp) ,@(nreverse third-party))))
|
||||
|
||||
(defcustom erc-modules '( autojoin button completion fill imenu irccontrols
|
||||
list match menu move-to-prompt netsplit
|
||||
networks noncommands readonly ring stamp track)
|
||||
@ -2039,16 +2047,10 @@ removed from the list will be disabled."
|
||||
(when (symbol-value f)
|
||||
(funcall f 0))
|
||||
(kill-local-variable f)))))))))
|
||||
(let (built-in third-party)
|
||||
(dolist (v val)
|
||||
(setq v (erc--normalize-module-symbol v))
|
||||
(if (get v 'erc--module)
|
||||
(push v built-in)
|
||||
(push v third-party)))
|
||||
;; Calling `set-default-toplevel-value' complicates testing
|
||||
(set sym (append (sort built-in #'string-lessp)
|
||||
(nreverse third-party))))
|
||||
;; Calling `set-default-toplevel-value' complicates testing.
|
||||
(set sym (erc--sort-modules val))
|
||||
;; this test is for the case where erc hasn't been loaded yet
|
||||
;; FIXME explain how this ^ can occur or remove comment.
|
||||
(when (fboundp 'erc-update-modules)
|
||||
(unless erc--inside-mode-toggle-p
|
||||
(erc-update-modules))))
|
||||
@ -2112,15 +2114,29 @@ removed from the list will be disabled."
|
||||
(defun erc-update-modules ()
|
||||
"Enable minor mode for every module in `erc-modules'.
|
||||
Except ignore all local modules, which were introduced in ERC 5.5."
|
||||
(erc--update-modules)
|
||||
(erc--update-modules erc-modules)
|
||||
nil)
|
||||
|
||||
(defvar erc--aberrant-modules nil
|
||||
"Modules suspected of being improperly loaded.")
|
||||
|
||||
(defun erc--warn-about-aberrant-modules ()
|
||||
(when (and erc--aberrant-modules (not erc--target))
|
||||
(erc-button--display-error-notice-with-keys-and-warn
|
||||
"The following modules exhibited strange loading behavior: "
|
||||
(mapconcat (lambda (s) (format "`%s'" s)) erc--aberrant-modules ", ")
|
||||
". Please contact ERC with \\[erc-bug] if you believe this to be untrue."
|
||||
" See Info:\"(erc) Module Loading\" for more.")
|
||||
(setq erc--aberrant-modules nil)))
|
||||
|
||||
(defun erc--find-mode (sym)
|
||||
(setq sym (erc--normalize-module-symbol sym))
|
||||
(if-let* ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode")))
|
||||
((or (boundp mode)
|
||||
(and (fboundp mode)
|
||||
(autoload-do-load (symbol-function mode) mode)))))
|
||||
(if-let ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode")))
|
||||
((and (fboundp mode)
|
||||
(autoload-do-load (symbol-function mode) mode)))
|
||||
((or (get sym 'erc--module)
|
||||
(symbol-file mode)
|
||||
(ignore (cl-pushnew sym erc--aberrant-modules)))))
|
||||
mode
|
||||
(and (require (or (get sym 'erc--feature)
|
||||
(intern (concat "erc-" (symbol-name sym))))
|
||||
@ -2129,9 +2145,9 @@ Except ignore all local modules, which were introduced in ERC 5.5."
|
||||
(fboundp mode)
|
||||
mode)))
|
||||
|
||||
(defun erc--update-modules ()
|
||||
(defun erc--update-modules (modules)
|
||||
(let (local-modes)
|
||||
(dolist (module erc-modules local-modes)
|
||||
(dolist (module modules local-modes)
|
||||
(if-let ((mode (erc--find-mode module)))
|
||||
(if (custom-variable-p mode)
|
||||
(funcall mode 1)
|
||||
@ -2158,7 +2174,7 @@ realizes it's missing some required module \"foo\", it can
|
||||
confidently call (erc-foo-mode 1) without having to learn
|
||||
anything about the dependency's implementation.")
|
||||
|
||||
(defvar erc--setup-buffer-hook nil
|
||||
(defvar erc--setup-buffer-hook '(erc--warn-about-aberrant-modules)
|
||||
"Internal hook for module setup involving windows and frames.")
|
||||
|
||||
(defvar erc--display-context nil
|
||||
@ -2315,7 +2331,8 @@ Returns the buffer for the given server or channel."
|
||||
(setq old-point (point))
|
||||
(setq delayed-modules
|
||||
(erc--merge-local-modes (let ((erc--updating-modules-p t))
|
||||
(erc--update-modules))
|
||||
(erc--update-modules
|
||||
(erc--sort-modules erc-modules)))
|
||||
(or erc--server-reconnecting
|
||||
erc--target-priors)))
|
||||
|
||||
|
||||
@ -2293,65 +2293,130 @@
|
||||
(should (eq (erc--find-group 'smiley nil) 'erc))
|
||||
(should (eq (erc--find-group 'unmorse nil) 'erc)))
|
||||
|
||||
(ert-deftest erc--update-modules ()
|
||||
(let (calls
|
||||
erc-modules
|
||||
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
|
||||
(ert-deftest erc--sort-modules ()
|
||||
(should (equal (erc--sort-modules '(networks foo fill bar fill stamp bar))
|
||||
;; Third-party mods appear in original order.
|
||||
'(fill networks stamp foo bar))))
|
||||
|
||||
;; This `lbaz' module is unknown, so ERC looks for it via the
|
||||
;; symbol proerty `erc--feature' and, failing that, by
|
||||
;; `require'ing its "erc-" prefixed symbol.
|
||||
(should-not (intern-soft "erc-lbaz-mode"))
|
||||
(defun erc-tests--update-modules (fn)
|
||||
(let* ((calls nil)
|
||||
(custom-modes nil)
|
||||
(on-load nil)
|
||||
|
||||
(get-calls (lambda () (prog1 (nreverse calls) (setq calls nil))))
|
||||
|
||||
(add-onload (lambda (m k v)
|
||||
(put (intern m) 'erc--feature k)
|
||||
(push (cons k (lambda () (funcall v m))) on-load)))
|
||||
|
||||
(mk-cmd (lambda (module)
|
||||
(let ((mode (intern (format "erc-%s-mode" module))))
|
||||
(fset mode (lambda (n) (push (cons mode n) calls))))))
|
||||
|
||||
(mk-builtin (lambda (module-string)
|
||||
(let ((s (intern module-string)))
|
||||
(put s 'erc--module s))))
|
||||
|
||||
(mk-global (lambda (module)
|
||||
(push (intern (format "erc-%s-mode" module))
|
||||
custom-modes))))
|
||||
|
||||
(cl-letf (((symbol-function 'require)
|
||||
(lambda (s &rest _)
|
||||
(when (eq s 'erc--lbaz-feature)
|
||||
(fset (intern "erc-lbaz-mode") ; local module
|
||||
(lambda (n) (push (cons 'lbaz n) calls))))
|
||||
(push s calls)))
|
||||
;; Simulate library being loaded, things defined.
|
||||
(when-let ((h (alist-get s on-load))) (funcall h))
|
||||
(push (cons 'req s) calls)))
|
||||
|
||||
;; Local modules
|
||||
((symbol-function 'erc-lbar-mode)
|
||||
(lambda (n) (push (cons 'lbar n) calls)))
|
||||
((get 'lbaz 'erc--feature) 'erc--lbaz-feature)
|
||||
;; Spoof global module detection.
|
||||
((symbol-function 'custom-variable-p)
|
||||
(lambda (v) (memq v custom-modes))))
|
||||
|
||||
;; Global modules
|
||||
((symbol-function 'erc-gfoo-mode)
|
||||
(lambda (n) (push (cons 'gfoo n) calls)))
|
||||
((get 'erc-gfoo-mode 'standard-value) 'ignore)
|
||||
(funcall fn get-calls add-onload mk-cmd mk-builtin mk-global))
|
||||
(should-not erc--aberrant-modules)))
|
||||
|
||||
(ert-deftest erc--update-modules/unknown ()
|
||||
(erc-tests--update-modules
|
||||
|
||||
(lambda (get-calls _ mk-cmd _ mk-global)
|
||||
|
||||
(ert-info ("Baseline")
|
||||
(let* ((erc-modules '(foo))
|
||||
(obarray (obarray-make))
|
||||
(err (should-error (erc--update-modules erc-modules))))
|
||||
(should (equal (cadr err) "`foo' is not a known ERC module"))
|
||||
(should (equal (funcall get-calls)
|
||||
`((req . ,(intern-soft "erc-foo")))))))
|
||||
|
||||
;; Module's mode command exists but lacks an associated file.
|
||||
(ert-info ("Bad autoload flagged as suspect")
|
||||
(should-not erc--aberrant-modules)
|
||||
(let* ((erc--aberrant-modules nil)
|
||||
(obarray (obarray-make))
|
||||
(erc-modules (list (intern "foo"))))
|
||||
|
||||
;; Create a mode activation command.
|
||||
(funcall mk-cmd "foo")
|
||||
|
||||
;; Make the mode var global.
|
||||
(funcall mk-global "foo")
|
||||
|
||||
;; No local modules to return.
|
||||
(should-not (erc--update-modules erc-modules))
|
||||
(should (equal (mapcar #'prin1-to-string erc--aberrant-modules)
|
||||
'("foo")))
|
||||
;; ERC requires the library via prefixed module name.
|
||||
(should (equal (mapcar #'prin1-to-string (funcall get-calls))
|
||||
`("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
|
||||
|
||||
;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to
|
||||
;; load its defining library, first via the symbol property
|
||||
;; `erc--feature', and then via an "erc-" prefixed symbol.
|
||||
(ert-deftest erc--update-modules/local ()
|
||||
(erc-tests--update-modules
|
||||
|
||||
(lambda (get-calls add-onload mk-cmd mk-builtin mk-global)
|
||||
|
||||
(let* ((obarray (obarray-make 20))
|
||||
(erc-modules (mapcar #'intern '("glo" "lo1" "lo2"))))
|
||||
|
||||
;; Create a global and a local module.
|
||||
(mapc mk-cmd '("glo" "lo1"))
|
||||
(mapc mk-builtin '("glo" "lo1"))
|
||||
(funcall mk-global "glo")
|
||||
(funcall add-onload "lo2" 'explicit-feature-lib mk-cmd)
|
||||
|
||||
;; Returns local modules.
|
||||
(should (equal (mapcar #'symbol-name (erc--update-modules erc-modules))
|
||||
'("erc-lo2-mode" "erc-lo1-mode")))
|
||||
|
||||
;; Requiring `erc-lo2' defines `erc-lo2-mode'.
|
||||
(should (equal (mapcar #'prin1-to-string (funcall get-calls))
|
||||
`("(erc-glo-mode . 1)"
|
||||
"(req . explicit-feature-lib)")))))))
|
||||
|
||||
(ert-deftest erc--update-modules/realistic ()
|
||||
(let ((calls nil)
|
||||
;; Module `pcomplete' "resolves" to `completion'.
|
||||
(erc-modules '(pcomplete autojoin networks)))
|
||||
(cl-letf (((symbol-function 'require)
|
||||
(lambda (s &rest _) (push (cons 'req s) calls)))
|
||||
|
||||
;; Spoof global module detection.
|
||||
((symbol-function 'custom-variable-p)
|
||||
(lambda (v)
|
||||
(memq v '(erc-autojoin-mode erc-networks-mode
|
||||
erc-completion-mode))))
|
||||
;; Mock and spy real builtins.
|
||||
((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))
|
||||
(lambda (n) (push (cons 'completion n) calls))))
|
||||
|
||||
(ert-info ("Unknown module")
|
||||
(setq erc-modules '(lfoo))
|
||||
(should-error (erc--update-modules))
|
||||
(should (equal (pop calls) 'erc-lfoo))
|
||||
(should-not calls))
|
||||
|
||||
(ert-info ("Local modules")
|
||||
(setq erc-modules '(gfoo lbar lbaz))
|
||||
;; Don't expose the mode here
|
||||
(should (equal (mapcar #'symbol-name (erc--update-modules))
|
||||
'("erc-lbaz-mode" "erc-lbar-mode")))
|
||||
;; Lbaz required because unknown.
|
||||
(should (equal (nreverse calls) '((gfoo . 1) erc--lbaz-feature)))
|
||||
(fmakunbound (intern "erc-lbaz-mode"))
|
||||
(unintern (intern "erc-lbaz-mode") obarray)
|
||||
(setq calls nil))
|
||||
|
||||
(ert-info ("Global modules") ; `pcomplete' resolved to `completion'
|
||||
(setq erc-modules '(pcomplete autojoin networks))
|
||||
(should-not (erc--update-modules)) ; no locals
|
||||
(should (equal (nreverse calls)
|
||||
'((completion . 1) (autojoin . 1) (networks . 1))))
|
||||
(setq calls nil)))))
|
||||
(should-not (erc--update-modules erc-modules)) ; no locals
|
||||
(should (equal (nreverse calls)
|
||||
'((completion . 1) (autojoin . 1) (networks . 1)))))))
|
||||
|
||||
(ert-deftest erc--merge-local-modes ()
|
||||
(cl-letf (((get 'erc-b-mode 'erc-module) 'b)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user