>From 41f475e993aa2a3f1ca1faea4ed0ef375518f476 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 28 Nov 2023 16:51:36 -0800 Subject: [PATCH 01/11] [5.6] Define ERC message-formatting templates with defvar * etc/ERC-NEWS: Mention convenience macro being preferred means of defining message templates. * lisp/erc/erc-common.el (erc--define-catalog, erc-define-message-format-catalog): New macro and internal variant to replace `erc-define-catalog-entry'. Internal variant allows us to defer reindenting existing definitions until meaningfully edited. * lisp/erc/erc-dcc.el (erc-message-english-dcc-chat-discarded, erc-message-english-dcc-chat-ended, erc-message-english-dcc-chat-no-request, erc-message-english-dcc-chat-offered, erc-message-english-dcc-chat-offer, erc-message-english-dcc-chat-accept, erc-message-english-dcc-chat-privmsg, erc-message-english-dcc-closed, erc-message-english-dcc-command-undefined, erc-message-english-dcc-ctcp-errmsg, erc-message-english-dcc-ctcp-unknown, erc-message-english-dcc-get-bytes-received, erc-message-english-dcc-get-complete, erc-message-english-dcc-get-failed, erc-message-english-dcc-get-cmd-aborted, erc-message-english-dcc-get-file-too-long, erc-message-english-dcc-get-notfound, erc-message-english-dcc-list-head, erc-message-english-dcc-list-line, erc-message-english-dcc-list-item, erc-message-english-dcc-list-end, erc-message-english-dcc-malformed, erc-message-english-dcc-privileged-port, erc-message-english-dcc-request-bogus, erc-message-english-dcc-send-finished, erc-message-english-dcc-send-offered, erc-message-english-dcc-send-offer): Define at top level using `defvar'. * lisp/erc/erc-netsplit.el (erc-netsplit-mode, erc-netsplit-enable): Don't call `erc-netsplit-install-message-catalogs'. (erc-netsplit-install-message-catalogs): Deprecate function. (erc-message-english-netsplit, erc-message-english-netjoin, erc-message-english-netjoin-done, erc-message-english-netsplit-none, erc-message-english-netsplit-wholeft): Define at top level using `defvar'. * lisp/erc/erc-notify.el (erc-notify-install-message-catalogs): Deprecate. (erc-message-english-notify_current, erc-message-english-notify_list, erc-message-english-notify_on, erc-message-english-notify_off): Define at top level using `defvar'. * lisp/erc/erc-page.el (erc-message-english-CTCP-PAGE): Define at top level using `defvar'. * lisp/erc/erc-sasl.el (erc-message-english-s902, erc-message-english-s904, erc-message-english-s905, erc-message-english-s906, erc-message-english-s907, erc-message-english-s908): Define at top level using `defvar'. * lisp/erc/erc-sound.el (erc-message-english-CTCP-SOUND): Define using `defvar'. * lisp/erc/erc.el (erc--make-message-variable-name): New function to replace `erc-make-message-variable-name' internally, where most uses formerly checked whether the returned variable was bound. This helper now conditionally performs that common task. (erc-make-message-variable-name): Defer to internal variant `erc--make-message-variable-name'. (erc-define-catalog-entry): Deprecate. (erc-define-catalog): Deprecate. (erc-retrieve-catalog-entry): Refactor to favor `default-toplevel-value' of `erc-current-message-catalog' before falling back to `english'. Not doing this was arguably a bug. (erc-message-english-bad-ping-response, erc-message-english-bad-syntax, erc-message-english-incorrect-args, erc-message-english-cannot-find-file, erc-message-english-cannot-read-file, erc-message-english-connect, erc-message-english-country, erc-message-english-country-unknown, erc-message-english-ctcp-empty, erc-message-english-ctcp-request, erc-message-english-ctcp-request-to, erc-message-english-ctcp-too-many, erc-message-english-flood-ctcp-off, erc-message-english-flood-strict-mode, erc-message-english-disconnected, erc-message-english-disconnected-noreconnect, erc-message-english-reconnecting, erc-message-english-reconnect-canceled, erc-message-english-finished, erc-message-english-terminated, erc-message-english-login, erc-message-english-nick-in-use, erc-message-english-nick-too-long, erc-message-english-no-default-channel, erc-message-english-no-invitation, erc-message-english-no-target, erc-message-english-ops, erc-message-english-ops-none, erc-message-english-undefined-ctcp, erc-message-english-user-mode-redundant-add, erc-message-english-user-mode-redundant-drop, erc-message-english-variable-not-bound, erc-message-english-ACTION, erc-message-english-CTCP-CLIENTINFO, erc-message-english-CTCP-ECHO, erc-message-english-CTCP-FINGER, erc-message-english-CTCP-PING, erc-message-english-CTCP-TIME, erc-message-english-CTCP-UNKNOWN, erc-message-english-CTCP-VERSION, erc-message-english-ERROR, erc-message-english-INVITE, erc-message-english-JOIN, erc-message-english-JOIN-you, erc-message-english-KICK, erc-message-english-KICK-you, erc-message-english-KICK-by-you, erc-message-english-MODE, erc-message-english-MODE-nick, erc-message-english-NICK, erc-message-english-NICK-you, erc-message-english-PART, erc-message-english-PING, erc-message-english-PONG, erc-message-english-QUIT, erc-message-english-TOPIC, erc-message-english-WALLOPS, erc-message-english-s004, erc-message-english-s221, erc-message-english-s252, erc-message-english-s253, erc-message-english-s254, erc-message-english-s275, erc-message-english-s301, erc-message-english-s303, erc-message-english-s305, erc-message-english-s306, erc-message-english-s307, erc-message-english-s311, erc-message-english-s312, erc-message-english-s313, erc-message-english-s314, erc-message-english-s317, erc-message-english-s317-on-since, erc-message-english-s319, erc-message-english-s320, erc-message-english-s321, erc-message-english-s322, erc-message-english-s324, erc-message-english-s328, erc-message-english-s329, erc-message-english-s330, erc-message-english-s331, erc-message-english-s332, erc-message-english-s333, erc-message-english-s341, erc-message-english-s352, erc-message-english-s353, erc-message-english-s367, erc-message-english-s367-set-by, erc-message-english-s368, erc-message-english-s379, erc-message-english-s391, erc-message-english-s396, erc-message-english-s401, erc-message-english-s402, erc-message-english-s403, erc-message-english-s404, erc-message-english-s405, erc-message-english-s406, erc-message-english-s412, erc-message-english-s421, erc-message-english-s431, erc-message-english-s432, erc-message-english-s442, erc-message-english-s445, erc-message-english-s446, erc-message-english-s451, erc-message-english-s461, erc-message-english-s462, erc-message-english-s463, erc-message-english-s464, erc-message-english-s465, erc-message-english-s471, erc-message-english-s473, erc-message-english-s474, erc-message-english-s475, erc-message-english-s481, erc-message-english-s482, erc-message-english-s483, erc-message-english-s484, erc-message-english-s485, erc-message-english-s491, erc-message-english-s501, erc-message-english-s502, erc-message-english-s671): Define at top level using `defvar'. * test/lisp/erc/erc-tests.el (erc--make-message-variable-name, erc-retrieve-catalog-entry): New tests. --- etc/ERC-NEWS | 5 +++ lisp/erc/erc-common.el | 27 ++++++++++++++++ lisp/erc/erc-dcc.el | 5 ++- lisp/erc/erc-netsplit.el | 13 ++++++-- lisp/erc/erc-notify.el | 10 ++++-- lisp/erc/erc-page.el | 3 +- lisp/erc/erc-sasl.el | 5 ++- lisp/erc/erc-sound.el | 3 +- lisp/erc/erc.el | 53 +++++++++++++++++++----------- test/lisp/erc/erc-tests.el | 66 ++++++++++++++++++++++++++++++++++++++ 10 files changed, 159 insertions(+), 31 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 7b39af03a88..238c40feefb 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -510,6 +510,11 @@ handling specific "MODE" types and letters in coming releases. If you'd like a say in shaping how this transpires, please share your ideas and use cases on the tracker. +*** A better way to define message-formatting templates. +The functions 'erc-define-catalog-entry' and 'erc-define-catalog' have +been deprecated in favor of 'erc-define-message-format-catalog', a new +macro for defining template "catalogs" at the top level of libraries. + *** Miscellaneous changes Two helper macros from GNU ELPA's Compat library are now available to third-party modules as 'erc-compat-call' and 'erc-compat-function'. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 8daedf9b019..ea4374da7b6 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -506,6 +506,33 @@ erc--with-dependent-type-match (,(widget-get (widget-convert type) :match) w v)) ',(cdr type))) +;; This internal variant only exists as a transition aid to avoid +;; immediately having to reflow lengthy definition lists, like the one +;; below. These sites should switch to using the public macro when +;; undergoing their next major edit. +(defmacro erc--define-catalog (name entries) + "Define `erc-display-message' formatting templates for NAME, a symbol. +See `erc-define-message-format-catalog' for the meaning of the +alist ENTRIES." + (declare (indent 1)) + (let (out) + (dolist (e entries (cons 'progn (nreverse out))) + (push `(defvar ,(intern (format "erc-message-%s-%s" name (car e))) + ,(cdr e) + ,(format "Message template for key `%s' in catalog `%s'." + (car e) name)) + out)))) + +(defmacro erc-define-message-format-catalog (language &rest entries) + "Define message-formatting templates for LANGUAGE, a symbol. +Expect ENTRIES to be pairs of (KEY . FORMAT), where KEY is a +symbol, and FORMAT evaluates to a format string compatible with +`format-spec'. Expect modules that only define a handful of +entries to do so manually, instead of using this macro, so that +the resulting variables will end up with more useful doc strings." + (declare (indent 1)) + `(erc--define-catalog ,language ,entries)) + (provide 'erc-common) ;;; erc-common.el ends here diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index f05ae41fc51..3bcdfb96eb8 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -131,9 +131,8 @@ erc-dcc-open-network-stream (open-network-stream procname buffer addr port :type (and (plist-get entry :secure) 'tls)))) -(erc-define-catalog - 'english - '((dcc-chat-discarded +(erc--define-catalog english + ((dcc-chat-discarded . "DCC: previous chat request from %n (%u@%h) discarded") (dcc-chat-ended . "DCC: chat with %n ended %t: %e") (dcc-chat-no-request . "DCC: chat request from %n not found") diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index 5dd11ab1869..076e1f0254b 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el @@ -41,7 +41,7 @@ erc-netsplit ;;;###autoload(autoload 'erc-netsplit-mode "erc-netsplit") (define-erc-module netsplit nil "This mode hides quit/join messages if a netsplit occurs." - ((erc-netsplit-install-message-catalogs) + ( ; FIXME delete newline on next edit (add-hook 'erc-server-JOIN-functions #'erc-netsplit-JOIN) (add-hook 'erc-server-MODE-functions #'erc-netsplit-MODE) (add-hook 'erc-server-QUIT-functions #'erc-netsplit-QUIT) @@ -85,13 +85,22 @@ erc-netsplit-list join from that split has been detected or not.") (defun erc-netsplit-install-message-catalogs () + (declare (obsolete "defined at top level in erc-netsplit.el" "30.1")) + (with-suppressed-warnings ((obsolete erc-define-catalog)) ; indentation (erc-define-catalog 'english '((netsplit . "netsplit: %s") (netjoin . "netjoin: %s, %N were split") (netjoin-done . "netjoin: All lost souls are back!") (netsplit-none . "No netsplits in progress") - (netsplit-wholeft . "split: %s missing: %n %t")))) + (netsplit-wholeft . "split: %s missing: %n %t"))))) ; indentation + +(erc-define-message-format-catalog english + (netsplit . "netsplit: %s") + (netjoin . "netjoin: %s, %N were split") + (netjoin-done . "netjoin: All lost souls are back!") + (netsplit-none . "No netsplits in progress") + (netsplit-wholeft . "split: %s missing: %n %t")) (defun erc-netsplit-JOIN (proc parsed) "Show/don't show rejoins." diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index cf7ffbb40d7..2c207d99bb0 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -78,12 +78,14 @@ erc-last-ison-time ;;;; Setup (defun erc-notify-install-message-catalogs () + (declare (obsolete "defined at top level in erc-notify.el" "30.1")) + (with-suppressed-warnings ((obsolete erc-define-catalog)) ; indentation (erc-define-catalog 'english '((notify_current . "Notified people online: %l") (notify_list . "Current notify list: %l") (notify_on . "Detected %n on IRC network %m") - (notify_off . "%n has left IRC network %m")))) + (notify_off . "%n has left IRC network %m"))))) ; indentation ;;;###autoload(autoload 'erc-notify-mode "erc-notify" nil t) (define-erc-module notify nil @@ -241,7 +243,11 @@ pcomplete/erc-mode/NOTIFY (require 'pcomplete) (pcomplete-here (pcomplete-erc-all-nicks))) -(erc-notify-install-message-catalogs) +(erc-define-message-format-catalog english + (notify_current . "Notified people online: %l") + (notify_list . "Current notify list: %l") + (notify_on . "Detected %n on IRC network %m") + (notify_off . "%n has left IRC network %m")) (provide 'erc-notify) diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el index a94678e5132..2e5974bd22e 100644 --- a/lisp/erc/erc-page.el +++ b/lisp/erc/erc-page.el @@ -42,7 +42,8 @@ page "Process CTCP PAGE requests from IRC." nil nil) -(erc-define-catalog-entry 'english 'CTCP-PAGE "Page from %n (%u@%h): %m") +(defvar erc-message-english-CTCP-PAGE "Page from %n (%u@%h): %m" + "English template for a CTCP PAGE message.") (defcustom erc-page-function nil "A function to process a \"page\" request. diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index c6922b1b26b..8ecce7aef31 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -305,9 +305,8 @@ erc-sasl--mechanism-offered-p (| eot ","))) (downcase offered))) -(erc-define-catalog - 'english - '((s902 . "ERR_NICKLOCKED nick %n unavailable: %s") +(erc--define-catalog english + ((s902 . "ERR_NICKLOCKED nick %n unavailable: %s") (s904 . "ERR_SASLFAIL (authentication failed) %s") (s905 . "ERR SASLTOOLONG (credentials too long) %s") (s906 . "ERR_SASLABORTED (authentication aborted) %s") diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el index 083d72805df..aaa2e059070 100644 --- a/lisp/erc/erc-sound.el +++ b/lisp/erc/erc-sound.el @@ -63,7 +63,8 @@ sound ((remove-hook 'erc-ctcp-query-SOUND-hook #'erc-ctcp-query-SOUND) (define-key erc-mode-map "\C-c\C-s" #'undefined))) -(erc-define-catalog-entry 'english 'CTCP-SOUND "%n (%u@%h) plays %s:%m") +(defvar erc-message-english-CTCP-SOUND "%n (%u@%h) plays %s:%m" + "English template for a CTCP SOUND message.") (defcustom erc-play-sound t "Play sounds when you receive CTCP SOUND requests." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 616129bf780..030d7787d8a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -8690,24 +8690,38 @@ erc-popup-input-buffer ;;; Message catalog +(define-inline erc--make-message-variable-name (catalog key softp) + "Return variable name conforming to ERC's message-catalog interface. +Given a CATALOG symbol `mycat' and format-string KEY `mykey', +also a symbol, return the symbol `erc-message-mycat-key'. With +SOFTP, only do so when defined as a variable." + (inline-quote + (let* ((catname (symbol-name ,catalog)) + (prefix (if (eq ?- (aref catname 0)) "erc--message" "erc-message-")) + (name (concat prefix catname "-" (symbol-name ,key)))) + (if ,softp + (and-let* ((s (intern-soft name)) ((boundp s))) s) + (intern name))))) + (defun erc-make-message-variable-name (catalog entry) "Create a variable name corresponding to CATALOG's ENTRY." - (intern (concat "erc-message-" - (symbol-name catalog) "-" (symbol-name entry)))) + (erc--make-message-variable-name catalog entry nil)) (defun erc-define-catalog-entry (catalog entry format-spec) "Set CATALOG's ENTRY to FORMAT-SPEC." + (declare (obsolete "define manually using `defvar' instead" "30.1")) (set (erc-make-message-variable-name catalog entry) format-spec)) (defun erc-define-catalog (catalog entries) "Define a CATALOG according to ENTRIES." - (dolist (entry entries) - (erc-define-catalog-entry catalog (car entry) (cdr entry)))) + (declare (obsolete erc-define-message-format-catalog "30.1")) + (with-suppressed-warnings ((obsolete erc-define-catalog-entry)) + (dolist (entry entries) + (erc-define-catalog-entry catalog (car entry) (cdr entry))))) -(erc-define-catalog - 'english - '((bad-ping-response . "Unexpected PING response from %n (time %t)") +(erc--define-catalog english + ((bad-ping-response . "Unexpected PING response from %n (time %t)") (bad-syntax . "Error occurred - incorrect usage?\n%c %u\n%d") (incorrect-args . "Incorrect arguments. Usage:\n%c %u\n%d") (cannot-find-file . "Cannot find file %f") @@ -8764,7 +8778,7 @@ erc-define-catalog (MODE-nick . "%n has changed mode for %t to %m") (NICK . "%n (%u@%h) is now known as %N") (NICK-you . "Your new nickname is %N") - (PART . erc-message-english-PART) + (PART . #'erc-message-english-PART) (PING . "PING from server (last: %s sec. ago)") (PONG . "PONG from %h (%i second%s)") (QUIT . "%n (%u@%h) has quit: %r") @@ -8862,18 +8876,19 @@ erc-message-english-PART (defvar-local erc-current-message-catalog 'english) (defun erc-retrieve-catalog-entry (entry &optional catalog) - "Retrieve ENTRY from CATALOG. - -If CATALOG is nil, `erc-current-message-catalog' is used. - -If ENTRY is nil in CATALOG, it is retrieved from the fallback, -english, catalog." + "Retrieve `format-spec' for symbol key ENTRY in CATALOG. +Without CATALOG, use `erc-current-message-catalog'. If lookup +fails, try the latter's `default-toplevel-value' if it's not the +same as CATALOG. Failing that, try the `english' catalog if yet +untried." (unless catalog (setq catalog erc-current-message-catalog)) - (let ((var (erc-make-message-variable-name catalog entry))) - (if (boundp var) - (symbol-value var) - (when (boundp (erc-make-message-variable-name 'english entry)) - (symbol-value (erc-make-message-variable-name 'english entry)))))) + (symbol-value + (or (erc--make-message-variable-name catalog entry 'softp) + (let ((default (default-toplevel-value 'erc-current-message-catalog))) + (or (and (not (eq default catalog)) + (erc--make-message-variable-name default entry 'softp)) + (and (not (memq 'english (list default catalog))) + (erc--make-message-variable-name 'english entry 'softp))))))) (defun erc-format-message (msg &rest args) "Format MSG according to ARGS. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 912a85ad5e0..49d500fadea 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3262,4 +3262,70 @@ define-erc-module--local (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) +(ert-deftest erc--make-message-variable-name () + (should (erc--make-message-variable-name 'english 'QUIT 'softp)) + (should (erc--make-message-variable-name 'english 'QUIT nil)) + + (let ((obarray (obarray-make))) + (should-not (erc--make-message-variable-name 'testcat 'testkey 'softp)) + (should (erc--make-message-variable-name 'testcat 'testkey nil)) + (should (intern-soft "erc-message-testcat-testkey" obarray)) + (should-not (erc--make-message-variable-name 'testcat 'testkey 'softp)) + (set (intern "erc-message-testcat-testkey" obarray) "hello world") + (should (equal (symbol-value + (erc--make-message-variable-name 'testcat 'testkey nil)) + "hello world"))) + + ;; Hyphenated (internal catalog). + (let ((obarray (obarray-make))) + (should-not (erc--make-message-variable-name '-testcat 'testkey 'softp)) + (should (erc--make-message-variable-name '-testcat 'testkey nil)) + (should (intern-soft "erc--message-testcat-testkey" obarray)) + (should-not (erc--make-message-variable-name '-testcat 'testkey 'softp)) + (set (intern "erc--message-testcat-testkey" obarray) "hello world") + (should (equal (symbol-value + (erc--make-message-variable-name '-testcat 'testkey nil)) + "hello world")))) + +(ert-deftest erc-retrieve-catalog-entry () + (should (eq 'english erc-current-message-catalog)) + (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m")) + + ;; Local binding. + (with-temp-buffer + (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m")) + (setq erc-current-message-catalog 'test) + ;; No catalog named `test'. + (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m")) + + (let ((obarray (obarray-make))) + (set (intern "erc-message-test-s221") "test 221 val") + (should (equal (erc-retrieve-catalog-entry 's221) "test 221 val")) + (set (intern "erc-message-english-s221") "eng 221 val") + + (let ((erc-current-message-catalog 'english)) + (should (equal (erc-retrieve-catalog-entry 's221) "eng 221 val"))) + + (with-temp-buffer + (should (equal (erc-retrieve-catalog-entry 's221) "eng 221 val")) + (let ((erc-current-message-catalog 'test)) + (should (equal (erc-retrieve-catalog-entry 's221) "test 221 val")))) + + (should (equal (erc-retrieve-catalog-entry 's221) "test 221 val"))) + + (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m")) + (should (equal erc-current-message-catalog 'test))) + + ;; Default top-level value. + (set-default-toplevel-value 'erc-current-message-catalog 'test-top) + (should (equal (erc-retrieve-catalog-entry 's221) "User modes for %n: %m")) + (set (intern "erc-message-test-top-s221") "test-top 221 val") + (should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val")) + + (setq erc-current-message-catalog 'test-local) + (should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val")) + + (makunbound (intern "erc-message-test-top-s221")) + (unintern "erc-message-test-top-s221" obarray)) + ;;; erc-tests.el ends here -- 2.42.0