mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Leverage loaddefs for migrating ERC modules

Browse source 
* lisp/erc/erc-common.el (erc--features-to-modules,
erc--modules-to-features, erc--module-name-migrations): Remove unused
internal functions.
(erc--normalize-module-symbol): Make aware of new migration scheme
based on symbol properties.
* lisp/erc/erc-page.el: Add autoload cookie for module migration.
* lisp/erc/erc-pcomplete.el: Add autoload cookies for module
migration.
* lisp/erc/erc-services.el: Add autoload cookie for module migration.
* lisp/erc/erc-sound.el: Add autoload cookie for module migration.
* lisp/erc/erc-stamp.el: Add autoload cookie for module migration.
* lisp/erc/erc.el (erc-modules): Reorder default value, sorted by
`string<' so that Customize does not consider the value to have been
edited.  Remove non-existent module `hecomplete' from lineup and swap
a couple more to maintain sorted order.  Change `:initialize' function
to tag all symbols for built-in modules with an `erc--module'
property.  In the `:set' function, ensure third-party modules appear
after the sorted and normalized built-ins, but in user-defined order.
Do this to prevent all modules, built-ins included, from ending up as
populated form fields for the "other" checkbox in the Customize
interface.
(erc--find-mode): Add helper function for `erc--update-modules'.
(erc--update-modules): Always resolve module names and only
conditionally attempt to require corresponding features.
* test/lisp/erc/erc-tests.el (erc-tests--modules): Add manifest for
asserting built-in modules and features.  This is easier to verify
visually than looking at the custom-type set for `erc-modules'.
(erc-modules--initialize): New test.
(erc-modules--internal-property): Add test.
(erc--normalize-module-symbol): New test.
(erc--find-mode): New test.
(erc--update-modules) Adapt to new paradigm and make more
comprehensive.  (Bug#60954.)
This commit is contained in:
F. Jason Park 2023-02-04 06:24:59 -08:00
parent 89815631f2
commit 3d81ecf0a9
8 changed files with 173 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

39
lisp/erc/erc-common.el
View file

@ -85,40 +85,13 @@
(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.")
;; After dropping 28, we can use prefixed "erc-autoload" cookies.
(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))
"Return preferred SYMBOL for `erc--modules'."
(while-let ((canonical (get symbol 'erc--module))
((not (eq canonical symbol))))
(setq symbol canonical))
symbol)
(defun erc--assemble-toggle (localp name ablsym mode val body)
(let ((arg (make-symbol "arg")))

1
lisp/erc/erc-page.el
View file

@ -34,6 +34,7 @@
"React to CTCP PAGE messages."
:group 'erc)
;;;###autoload(put 'ctcp-page 'erc--module 'page)
;;;###autoload(autoload 'erc-page-mode "erc-page")
(define-erc-module page ctcp-page
"Process CTCP PAGE requests from IRC."

2
lisp/erc/erc-pcomplete.el
View file

@ -56,6 +56,8 @@ add this string to nicks completed."
"If t, order nickname completions with the most recent speakers first."
:type 'boolean)
;;;###autoload(put 'Completion 'erc--module 'completion)
;;;###autoload(put 'pcomplete 'erc--module 'completion)
;;;###autoload(autoload 'erc-completion-mode "erc-pcomplete" nil t)
(define-erc-module pcomplete Completion
"In ERC Completion mode, the TAB key does completion whenever possible."

1
lisp/erc/erc-services.el
View file

@ -102,6 +102,7 @@ You can also use \\[erc-nickserv-identify-mode] to change modes."
(when (featurep 'erc-services)
(erc-nickserv-identify-mode val))))
;;;###autoload(put 'nickserv 'erc--module 'services)
;;;###autoload(autoload 'erc-services-mode "erc-services" nil t)
(define-erc-module services nickserv
"This mode automates communication with services."

1
lisp/erc/erc-sound.el
View file

@ -47,6 +47,7 @@
(require 'erc)
;;;###autoload(put 'ctcp-sound 'erc--module 'sound)
;;;###autoload(autoload 'erc-sound-mode "erc-sound")
(define-erc-module sound ctcp-sound
"In ERC sound mode, the client will respond to CTCP SOUND requests

4
lisp/erc/erc-stamp.el
View file

@ -147,6 +147,10 @@ from entering them and instead jump over them."
"ERC timestamp face."
:group 'erc-faces)
;; New libraries should only autoload the minor mode for a module's
;; preferred name (rather than its alias).
;;;###autoload(put 'timestamp 'erc--module 'stamp)
;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t)
(define-erc-module stamp timestamp
"This mode timestamps messages in the channel buffers."

59
lisp/erc/erc.el
View file

@ -1839,9 +1839,9 @@ buffer rather than a server buffer.")
;; each item is in the format '(old . new)
(delete-dups (mapcar #'erc--normalize-module-symbol mods)))
(defcustom erc-modules '(netsplit fill button match track completion readonly
networks ring autojoin noncommands irccontrols
move-to-prompt stamp menu list)
(defcustom erc-modules '( autojoin button completion fill irccontrols
list match menu move-to-prompt netsplit
networks noncommands readonly ring stamp track)
"A list of modules which ERC should enable.
If you set the value of this without using `customize' remember to call
\(erc-update-modules) after you change it. When using `customize', modules
@ -1849,12 +1849,20 @@ removed from the list will be disabled."
:get (lambda (sym)
;; replace outdated names with their newer equivalents
(erc-migrate-modules (symbol-value sym)))
:initialize #'custom-initialize-default
;; Expect every built-in module to have the symbol property
;; `erc--module' set to its canonical symbol (often itself).
:initialize (lambda (symbol exp)
;; Use `cdddr' because (set :greedy t . ,entries)
(dolist (entry (cdddr (get 'erc-modules 'custom-type)))
(when-let* (((eq (car entry) 'const))
(s (cadddr entry))) ; (const :tag "..." ,s)
(put s 'erc--module s)))
(custom-initialize-reset symbol exp))
:set (lambda (sym val)
;; disable modules which have just been removed
(when (and (boundp 'erc-modules) erc-modules val)
(dolist (module erc-modules)
(unless (member module val)
(unless (memq module val)
(let ((f (intern-soft (format "erc-%s-mode" module))))
(when (and (fboundp f) (boundp f))
(when (symbol-value f)
@ -1866,7 +1874,15 @@ removed from the list will be disabled."
(when (symbol-value f)
(funcall f 0))
(kill-local-variable f)))))))))
(set sym val)
(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))))
;; this test is for the case where erc hasn't been loaded yet
(when (fboundp 'erc-update-modules)
(erc-update-modules)))
@ -1880,7 +1896,6 @@ removed from the list will be disabled."
capab-identify)
(const :tag "completion: Complete nicknames and commands (programmable)"
completion)
(const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete)
(const :tag "dcc: Provide Direct Client-to-Client support" dcc)
(const :tag "fill: Wrap long lines" fill)
(const :tag "identd: Launch an identd server on port 8113" identd)
@ -1897,11 +1912,11 @@ removed from the list will be disabled."
(const :tag "networks: Provide data about IRC networks" networks)
(const :tag "noncommands: Don't display non-IRC commands after evaluation"
noncommands)
(const :tag "notifications: Desktop alerts on PRIVMSG or mentions"
notifications)
(const :tag
"notify: Notify when the online status of certain users changes"
notify)
(const :tag "notifications: Send notifications on PRIVMSG or nickname mentions"
notifications)
(const :tag "page: Process CTCP PAGE requests from IRC" page)
(const :tag "readonly: Make displayed lines read-only" readonly)
(const :tag "replace: Replace text in messages" replace)
@ -1914,8 +1929,8 @@ removed from the list will be disabled."
(const :tag "smiley: Convert smileys to pretty icons" smiley)
(const :tag "sound: Play sounds when you receive CTCP SOUND requests"
sound)
(const :tag "stamp: Add timestamps to messages" stamp)
(const :tag "spelling: Check spelling" spelling)
(const :tag "stamp: Add timestamps to messages" stamp)
(const :tag "track: Track channel activity in the mode-line" track)
(const :tag "truncate: Truncate buffers to a certain size" truncate)
(const :tag "unmorse: Translate morse code in messages" unmorse)
@ -1929,18 +1944,28 @@ Except ignore all local modules, which were introduced in ERC 5.5."
(erc--update-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)))))
mode
(and (require (or (get sym 'erc--feature)
(intern (concat "erc-" (symbol-name sym))))
nil 'noerror)
(setq mode (intern-soft (concat "erc-" (symbol-name sym) "-mode")))
(fboundp mode)
mode)))
(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-let ((mode (erc--find-mode module)))
(if (custom-variable-p mode)
(funcall mode 1)
(push mode local-modes))))))
(push mode local-modes))
(error "`%s' is not a known ERC module" module)))))
(defun erc-setup-buffer (buffer)
"Consults `erc-join-buffer' to find out how to display `BUFFER'."

130
test/lisp/erc/erc-tests.el
View file

@ -1224,6 +1224,85 @@
(kill-buffer "baznet")
(kill-buffer "#chan")))
(defconst erc-tests--modules
'( autoaway autojoin button capab-identify completion dcc fill identd
irccontrols keep-place list log match menu move-to-prompt netsplit
networks noncommands notifications notify page readonly
replace ring sasl scrolltobottom services smiley sound
spelling stamp track truncate unmorse xdcc))
;; Ensure that `:initialize' doesn't change the ordering of the
;; members because otherwise the widget's state is "edited".
(ert-deftest erc-modules--initialize ()
;; This is `custom--standard-value' from Emacs 28.
(should (equal (eval (car (get 'erc-modules 'standard-value)) t)
erc-modules)))
;; Ensure the `:initialize' function for `erc-modules' successfully
;; tags all built-in modules with the internal property `erc--module'.
(ert-deftest erc-modules--internal-property ()
(let (ours)
(mapatoms (lambda (s)
(when-let ((v (get s 'erc--module))
((eq v s)))
(push s ours))))
(should (equal (sort ours #'string-lessp) erc-tests--modules))))
(ert-deftest erc--normalize-module-symbol ()
(dolist (mod erc-tests--modules)
(should (eq (erc--normalize-module-symbol mod) mod)))
(should (eq (erc--normalize-module-symbol 'pcomplete) 'completion))
(should (eq (erc--normalize-module-symbol 'Completion) 'completion))
(should (eq (erc--normalize-module-symbol 'ctcp-page) 'page))
(should (eq (erc--normalize-module-symbol 'ctcp-sound) 'sound))
(should (eq (erc--normalize-module-symbol 'timestamp) 'stamp))
(should (eq (erc--normalize-module-symbol 'nickserv) 'services)))
;; Worrying about which library a module comes from is mostly not
;; worth the hassle so long as ERC can find its minor mode. However,
;; bugs involving multiple modules living in the same library may slip
;; by because a module's loading problems may remain hidden on account
;; of its place in the default ordering.
(ert-deftest erc--find-mode ()
(let* ((package (if-let* ((found (getenv "ERC_PACKAGE_NAME"))
((string-prefix-p "erc-" found)))
(intern found)
'erc))
(prog
`(,@(and (featurep 'compat)
`((progn
(require 'package)
(let ((package-load-list '((compat t) (,package t))))
(package-initialize)))))
(require 'erc)
(let ((mods (mapcar #'cadddr
(cdddr (get 'erc-modules 'custom-type))))
moded)
(setq mods
(sort mods (lambda (a b) (if (zerop (random 2)) a b))))
(dolist (mod mods)
(unless (keywordp mod)
(push (if-let ((mode (erc--find-mode mod)))
mod
(list :missing mod))
moded)))
(message "%S"
(sort moded
(lambda (a b)
(string< (symbol-name a) (symbol-name b))))))))
(proc (start-process "erc--module-mode-autoloads"
(current-buffer)
(concat invocation-directory invocation-name)
"-batch" "-Q"
"-eval" (format "%S" (cons 'progn prog)))))
(set-process-query-on-exit-flag proc t)
(while (accept-process-output proc 10))
(goto-char (point-min))
(should (equal (read (current-buffer)) erc-tests--modules))))
(ert-deftest erc-migrate-modules ()
(should (equal (erc-migrate-modules '(autojoin timestamp button))
'(autojoin stamp button)))
@ -1234,17 +1313,28 @@
(let (calls
erc-modules
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
;; 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"))
(cl-letf (((symbol-function 'require)
(lambda (s &rest _) (push s calls)))
(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)))
;; Local modules
((symbol-function 'erc-fake-bar-mode)
(lambda (n) (push (cons 'fake-bar n) calls)))
((symbol-function 'erc-lbar-mode)
(lambda (n) (push (cons 'lbar n) calls)))
((get 'lbaz 'erc--feature) 'erc--lbaz-feature)
;; 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-gfoo-mode)
(lambda (n) (push (cons 'gfoo n) calls)))
((get 'erc-gfoo-mode 'standard-value) 'ignore)
((symbol-function 'erc-autojoin-mode)
(lambda (n) (push (cons 'autojoin n) calls)))
((get 'erc-autojoin-mode 'standard-value) 'ignore)
@ -1255,20 +1345,28 @@
(lambda (n) (push (cons 'completion n) calls)))
((get 'erc-completion-mode 'standard-value) 'ignore))
(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 '(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 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 ("Module name overrides")
(setq erc-modules '(completion autojoin networks))
(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) '( erc-pcomplete (completion . 1)
erc-join (autojoin . 1)
erc-networks (networks . 1))))
(should (equal (nreverse calls)
'((completion . 1) (autojoin . 1) (networks . 1))))
(setq calls nil)))))
(ert-deftest erc--merge-local-modes ()