mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 22:41:06 -08:00
Make ERC's format catalogs more extensible
* lisp/erc/erc-common.el (erc--define-catalog): Accept a `:parent' keyword to allow for extending an existing catalog by overriding some subset of defined entries. (erc-define-message-format-catalog): Add edebug spec. * lisp/erc/erc.el (erc-retrieve-catalog-entry): Check parent for definition before looking to `default-toplevel-value'. * test/lisp/erc/erc-tests.el (erc-retrieve-catalog-entry): Add test case for inheritance. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-pp-propertized-parts): Fix bug in convenience command. (Bug#67677)
This commit is contained in:
parent
d6f9379d1c
commit
37e87bc3ee
4 changed files with 37 additions and 4 deletions
|
|
@ -554,9 +554,21 @@ See `erc-define-message-format-catalog' for the meaning of
|
||||||
ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in
|
ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in
|
||||||
tests/lisp/erc/erc-tests.el for a convenience command to convert
|
tests/lisp/erc/erc-tests.el for a convenience command to convert
|
||||||
a literal string into a sequence of `propertize' forms, which are
|
a literal string into a sequence of `propertize' forms, which are
|
||||||
much easier to review and edit."
|
much easier to review and edit. When ENTRIES begins with a
|
||||||
|
sequence of keyword-value pairs remove them and consider their
|
||||||
|
evaluated values before processing the alist proper.
|
||||||
|
|
||||||
|
Currently, the only recognized keyword is `:parent', which tells
|
||||||
|
ERC to search recursively for a given template key using the
|
||||||
|
keyword's associated value, another catalog symbol, if not found
|
||||||
|
in catalog NAME."
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
(let (out)
|
(let (out)
|
||||||
|
(while (keywordp (car entries))
|
||||||
|
(push (pcase-exhaustive (pop entries)
|
||||||
|
(:parent `(put ',name 'erc--base-format-catalog
|
||||||
|
,(pop entries))))
|
||||||
|
out))
|
||||||
(dolist (e entries (cons 'progn (nreverse out)))
|
(dolist (e entries (cons 'progn (nreverse out)))
|
||||||
(push `(defvar ,(intern (format "erc-message-%s-%s" name (car e)))
|
(push `(defvar ,(intern (format "erc-message-%s-%s" name (car e)))
|
||||||
,(cdr e)
|
,(cdr e)
|
||||||
|
|
@ -575,7 +587,8 @@ symbol, and FORMAT evaluates to a format string compatible with
|
||||||
`format-spec'. Expect modules that only define a handful of
|
`format-spec'. Expect modules that only define a handful of
|
||||||
entries to do so manually, instead of using this macro, so that
|
entries to do so manually, instead of using this macro, so that
|
||||||
the resulting variables will end up with more useful doc strings."
|
the resulting variables will end up with more useful doc strings."
|
||||||
(declare (indent 1))
|
(declare (indent 1)
|
||||||
|
(debug (symbolp [&rest [keywordp form]] &rest (symbolp . form))))
|
||||||
`(erc--define-catalog ,language ,entries))
|
`(erc--define-catalog ,language ,entries))
|
||||||
|
|
||||||
(defmacro erc--doarray (spec &rest body)
|
(defmacro erc--doarray (spec &rest body)
|
||||||
|
|
|
||||||
|
|
@ -9320,6 +9320,12 @@ if yet untried."
|
||||||
(unless catalog (setq catalog erc-current-message-catalog))
|
(unless catalog (setq catalog erc-current-message-catalog))
|
||||||
(symbol-value
|
(symbol-value
|
||||||
(or (erc--make-message-variable-name catalog key 'softp)
|
(or (erc--make-message-variable-name catalog key 'softp)
|
||||||
|
(let ((parent catalog)
|
||||||
|
last)
|
||||||
|
(while (and (setq parent (get parent 'erc--base-format-catalog))
|
||||||
|
(not (setq last (erc--make-message-variable-name
|
||||||
|
parent key 'softp)))))
|
||||||
|
last)
|
||||||
(let ((default (default-toplevel-value 'erc-current-message-catalog)))
|
(let ((default (default-toplevel-value 'erc-current-message-catalog)))
|
||||||
(or (and (not (eq default catalog))
|
(or (and (not (eq default catalog))
|
||||||
(erc--make-message-variable-name default key 'softp))
|
(erc--make-message-variable-name default key 'softp))
|
||||||
|
|
|
||||||
|
|
@ -3533,6 +3533,20 @@ connection."
|
||||||
(should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val"))
|
(should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val"))
|
||||||
|
|
||||||
(makunbound (intern "erc-message-test-top-s221"))
|
(makunbound (intern "erc-message-test-top-s221"))
|
||||||
(unintern "erc-message-test-top-s221" obarray))
|
(unintern "erc-message-test-top-s221" obarray)
|
||||||
|
|
||||||
|
;; Inheritance.
|
||||||
|
(let ((obarray (obarray-make)))
|
||||||
|
(set (intern "erc-message-test1-abc") "val test1 abc")
|
||||||
|
(set (intern "erc-message-test2-abc") "val test2 abc")
|
||||||
|
(set (intern "erc-message-test2-def") "val test2 def")
|
||||||
|
(put (intern "test0") 'erc--base-format-catalog (intern "test1"))
|
||||||
|
(put (intern "test1") 'erc--base-format-catalog (intern "test2"))
|
||||||
|
(should (equal (erc-retrieve-catalog-entry 'abc (intern "test0"))
|
||||||
|
"val test1 abc"))
|
||||||
|
(should (equal (erc-retrieve-catalog-entry 'def (intern "test0"))
|
||||||
|
"val test2 def"))
|
||||||
|
;; Terminates.
|
||||||
|
(should-not (erc-retrieve-catalog-entry 'ghi (intern "test0")))))
|
||||||
|
|
||||||
;;; erc-tests.el ends here
|
;;; erc-tests.el ends here
|
||||||
|
|
|
||||||
|
|
@ -150,7 +150,7 @@ between literal strings."
|
||||||
For simplicity, assume string evaluates to itself."
|
For simplicity, assume string evaluates to itself."
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp))))
|
(let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp))))
|
||||||
(if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp))))
|
(if arg (insert (pp-to-string sexp)) (pp-macroexpand-expression sexp))))
|
||||||
|
|
||||||
;; The following utilities are meant to help prepare tests for
|
;; The following utilities are meant to help prepare tests for
|
||||||
;; `erc--get-inserted-msg-bounds' and friends.
|
;; `erc--get-inserted-msg-bounds' and friends.
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue