[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master b5da8ba8070 02/19: Define ERC message-formatting templates with d
|
From: |
F. Jason Park |
|
Subject: |
master b5da8ba8070 02/19: Define ERC message-formatting templates with defvar |
|
Date: |
Sun, 17 Dec 2023 23:21:36 -0500 (EST) |
branch: master
commit b5da8ba80709286284a4ba7a0c7806e3169e76a6
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>
Define ERC message-formatting templates with defvar
* etc/ERC-NEWS: Mention convenience macro being preferred means of
defining message templates. Mention renaming of `notify' formatting
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'. The 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, and rename all format templates with hyphens instead of
underscores.
(erc-notify-timer, erc-notify-JOIN, erc-notify-NICK, erc-notify-QUIT):
Use hyphenated template names.
(erc-cmd-NOTIFY): Use hyphenated template names. Load the module when
necessary and emit a warning. Otherwise, people who discover this
autoloaded command without being aware of the module's existence may
think it's "broken".
(pcomplete/erc-mode/NOTIFY): Replace top-level autoload with `require'
in function body. Include `erc-notify-list' in list of completions,
which makes removal easier if you don't share any channels with a
person, and they're not in `erc-server-users'. A better long-term
solution might be to WHOIS folks we're unsure about when they're
listed in a 303.
(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'. Replace nonstandard underscores with
hyphens. Alias obsolete names.
* 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
previously checked whether the returned variable was bound. This
helper now does that conditionally, when asked.
(erc-make-message-variable-name): Defer to internal variant,
`erc--make-message-variable-name'.
(erc-define-catalog-entry, 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-tests--string-to-propertized-parts,
erc-tests-pp-propertized-parts, erc--make-message-variable-name,
erc-retrieve-catalog-entry): New tests along with utility functions
and a convenience command for manipulating catalogs. (Bug#67677)
---
etc/ERC-NEWS | 12 +++++
lisp/erc/erc-common.el | 35 +++++++++++++++
lisp/erc/erc-dcc.el | 5 +--
lisp/erc/erc-netsplit.el | 13 +++++-
lisp/erc/erc-notify.el | 81 ++++++++++++++++++++-------------
lisp/erc/erc-page.el | 3 +-
lisp/erc/erc-sasl.el | 5 +--
lisp/erc/erc-sound.el | 3 +-
lisp/erc/erc.el | 55 ++++++++++++++---------
test/lisp/erc/erc-tests.el | 109 +++++++++++++++++++++++++++++++++++++++++++++
10 files changed, 260 insertions(+), 61 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 4642c742b0f..93437431289 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -425,6 +425,13 @@ Built-in modules can now provide more detailed help for a
particular
subcommand by telling ERC to defer to a specialized handler. This
facility can be opened up to third parties should any one request it.
+*** Message-formatting templates in 'notify' renamed.
+All templates beginning with the prefix "erc-message-english-notify_"
+have been renamed to begin with "erc-message-english-notify-". For
+example, the variable 'erc-message-english-notify_current' is now
+'erc-message-english-notify_current'. The old names have been
+preserved as obsolete aliases.
+
*** Longtime quasi modules made proper.
The 'fill' module is now defined by 'define-erc-module'. The same
goes for ERC's imenu integration, which has 'imenu' now appearing in
@@ -510,6 +517,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..3b138b394bd 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -506,6 +506,41 @@ Use the CASEMAPPING ISUPPORT parameter to determine the
style."
(,(widget-get (widget-convert type) :match) w v))
',(cdr type)))
+;; This internal variant exists as a transition aid to avoid
+;; immediately having to reflow lengthy definition lists, like the one
+;; in erc.el. 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
+ENTRIES, an alist. Also see `erc-tests-pp-propertized-parts' in
+tests/lisp/erc/erc-tests.el for a convenience command to convert
+a literal string into a sequence of `propertize' forms, which
+are much easier to review and edit."
+ (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)
+ ,(let* ((first (format "Message template for key `%s'" (car e)))
+ (last (format "catalog `%s'." name))
+ (combined (concat first " in " last)))
+ (if (< (length combined) 80)
+ combined
+ (concat first ".\nFor use with " last))))
+ 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 @@ Looks like:
(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 @@ netsplits, so that it can filter the JOIN messages on a
netjoin too."
;;;###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 @@ where FIRST-JOIN is t or nil, depending on whether or not
the first
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..1aa5bc34f33 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -30,7 +30,6 @@
;;; Code:
(require 'erc)
-(require 'erc-networks)
(eval-when-compile (require 'pcomplete))
;;;; Customizable variables
@@ -78,12 +77,14 @@ strings."
;;;; Setup
(defun erc-notify-install-message-catalogs ()
- (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"))))
+ (declare (obsolete "defined at top level in erc-notify.el" "30.1"))
+ (with-suppressed-warnings ((obsolete erc-define-catalog))
+ (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")))))
;;;###autoload(autoload 'erc-notify-mode "erc-notify" nil t)
(define-erc-module notify nil
@@ -119,14 +120,14 @@ changes."
(run-hook-with-args 'erc-notify-signon-hook server (car new-list))
(erc-display-message
parsed 'notice proc
- 'notify_on ?n (car new-list) ?m (erc-network-name)))
+ 'notify-on ?n (car new-list) ?m (erc-network-name)))
(setq new-list (cdr new-list)))
(while old-list
(when (not (erc-member-ignore-case (car old-list) ison-list))
(run-hook-with-args 'erc-notify-signoff-hook server (car old-list))
(erc-display-message
parsed 'notice proc
- 'notify_off ?n (car old-list) ?m (erc-network-name)))
+ 'notify-off ?n (car old-list) ?m (erc-network-name)))
(setq old-list (cdr old-list)))
(setq erc-last-ison ison-list)
t)))
@@ -136,8 +137,8 @@ changes."
(defun erc-notify-JOIN (proc parsed)
"Check if channel joiner is on `erc-notify-list' and not on `erc-last-ison'.
-If this condition is satisfied, produce a notify_on message and add the nick
-to `erc-last-ison' to prevent any further notifications."
+When that's the case, produce a `notify-on' message and add the
+nick to `erc-last-ison' to prevent any further notifications."
(let ((nick (erc-extract-nick (erc-response.sender parsed))))
(when (and (erc-member-ignore-case nick erc-notify-list)
(not (erc-member-ignore-case nick erc-last-ison)))
@@ -147,13 +148,13 @@ to `erc-last-ison' to prevent any further notifications."
nick)
(erc-display-message
parsed 'notice proc
- 'notify_on ?n nick ?m (erc-network-name)))
+ 'notify-on ?n nick ?m (erc-network-name)))
nil))
(defun erc-notify-NICK (proc parsed)
"Check if new nick is on `erc-notify-list' and not on `erc-last-ison'.
-If this condition is satisfied, produce a notify_on message and add the nick
-to `erc-last-ison' to prevent any further notifications."
+When that's the case, produce a `notify-on' message and add the
+nick to `erc-last-ison' to prevent any further notifications."
(let ((nick (erc-response.contents parsed)))
(when (and (erc-member-ignore-case nick erc-notify-list)
(not (erc-member-ignore-case nick erc-last-ison)))
@@ -163,13 +164,13 @@ to `erc-last-ison' to prevent any further notifications."
nick)
(erc-display-message
parsed 'notice proc
- 'notify_on ?n nick ?m (erc-network-name)))
+ 'notify-on ?n nick ?m (erc-network-name)))
nil))
(defun erc-notify-QUIT (proc parsed)
"Check if quitter is on `erc-notify-list' and on `erc-last-ison'.
-If this condition is satisfied, produce a notify_off message and remove the
-nick from `erc-last-ison' to prevent any further notifications."
+When that's the case, insert a `notify-off' message and remove
+the nick from `erc-last-ison' to prevent further notifications."
(let ((nick (erc-extract-nick (erc-response.sender parsed))))
(when (and (erc-member-ignore-case nick erc-notify-list)
(erc-member-ignore-case nick erc-last-ison))
@@ -183,7 +184,7 @@ nick from `erc-last-ison' to prevent any further
notifications."
nick)
(erc-display-message
parsed 'notice proc
- 'notify_off ?n nick ?m (erc-network-name)))
+ 'notify-off ?n nick ?m (erc-network-name)))
nil))
;;;; User level command
@@ -193,6 +194,12 @@ nick from `erc-last-ison' to prevent any further
notifications."
"Change `erc-notify-list' or list current notify-list members online.
Without args, list the current list of notified people online,
with args, toggle notify status of people."
+ (unless erc-notify-mode
+ (erc-notify-mode +1)
+ (erc-button--display-error-notice-with-keys
+ (current-buffer)
+ "Command /NOTIFY requires the `notify' module. Enabling now. Add `notify'"
+ " to `erc-modules' before next starting ERC to silence this message."))
(cond
((null args)
;; Print current notified people (online)
@@ -202,11 +209,12 @@ with args, toggle notify status of people."
nil 'notice 'active "No ison-list yet!")
(erc-display-message
nil 'notice 'active
- 'notify_current ?l ison))))
+ 'notify-current ?l ison))))
((string= (car args) "-l")
- (erc-display-message nil 'notice 'active
- 'notify_list ?l (mapconcat #'identity erc-notify-list
- " ")))
+ (let ((list (if erc-notify-list
+ (mapconcat #'identity erc-notify-list " ")
+ "(empty)")))
+ (erc-display-message nil 'notice 'active 'notify-list ?l list)))
(t
(while args
(if (erc-member-ignore-case (car args) erc-notify-list)
@@ -225,23 +233,34 @@ with args, toggle notify status of people."
(setq erc-notify-list (cons (erc-string-no-properties (car args))
erc-notify-list)))
(setq args (cdr args)))
- (erc-display-message
- nil 'notice 'active
- 'notify_list ?l (mapconcat #'identity erc-notify-list " "))))
+ (erc-cmd-NOTIFY "-l")))
t)
-(autoload 'pcomplete-erc-all-nicks "erc-pcomplete")
-
;; "--" is not a typo.
(declare-function pcomplete--here "pcomplete"
(&optional form stub paring form-only))
+(declare-function pcomplete-erc-all-nicks "erc-pcomplete"
+ (&optional postfix))
;;;###autoload
(defun pcomplete/erc-mode/NOTIFY ()
- (require 'pcomplete)
- (pcomplete-here (pcomplete-erc-all-nicks)))
-
-(erc-notify-install-message-catalogs)
+ (require 'erc-pcomplete)
+ (pcomplete-here (append erc-notify-list (pcomplete-erc-all-nicks))))
+
+(define-obsolete-variable-alias 'erc-message-english-notify_on
+ 'erc-message-english-notify-on "30.1")
+(define-obsolete-variable-alias 'erc-message-english-notify_off
+ 'erc-message-english-notify-off "30.1")
+(define-obsolete-variable-alias 'erc-message-english-notify_list
+ 'erc-message-english-notify-list "30.1")
+(define-obsolete-variable-alias 'erc-message-english-notify_current
+ 'erc-message-english-notify-current "30.1")
+
+(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 @@
"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 @@ If necessary, pass PROMPT to `read-passwd'."
(| 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 @@ and play sound files as requested."
((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 62fdc0ad6e8..e39e50a7343 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -8690,24 +8690,38 @@ All windows are opened in the current frame."
;;; 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-mykey'. 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 @@ All windows are opened in the current frame."
(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")
@@ -8861,19 +8875,20 @@ functions."
(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."
+(defun erc-retrieve-catalog-entry (key &optional catalog)
+ "Retrieve `format-spec' entry for symbol KEY in CATALOG.
+Without symbol 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 key 'softp)
+ (let ((default (default-toplevel-value 'erc-current-message-catalog)))
+ (or (and (not (eq default catalog))
+ (erc--make-message-variable-name default key 'softp))
+ (and (not (memq 'english (list default catalog)))
+ (erc--make-message-variable-name 'english key '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 e9bca2a3ac3..03879b02347 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -3262,4 +3262,113 @@ connection."
(put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname))))))
+(defun erc-tests--string-to-propertized-parts (string)
+ "Return a sequence of `propertize' forms for generating STRING.
+Expect maintainers manipulating template catalogs to use this
+with `pp-eval-last-sexp' or similar to convert back and forth
+between literal strings."
+ `(concat
+ ,@(mapcar
+ (pcase-lambda (`(,beg ,end ,plist))
+ ;; At the time of writing, `propertize' produces a string
+ ;; with the order of the input plist reversed.
+ `(propertize ,(substring-no-properties string beg end)
+ ,@(let (out)
+ (while-let ((plist)
+ (k (pop plist))
+ (v (pop plist)))
+ (push (if (or (consp v) (symbolp v)) `',v v) out)
+ (push `',k out))
+ out)))
+ (object-intervals string))))
+
+(defun erc-tests-pp-propertized-parts (arg)
+ "Convert literal string before point into a `propertize'd form.
+For simplicity, assume string evaluates to itself."
+ (interactive "P")
+ (let ((sexp (erc-tests--string-to-propertized-parts (pp-last-sexp))))
+ (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp))))
+
+(ert-deftest erc-tests--string-to-propertized-parts ()
+ :tags '(:unstable) ; only run this locally
+ (unless (>= emacs-major-version 28) (ert-skip "Missing `object-intervals'"))
+
+ (should (equal (erc-tests--string-to-propertized-parts
+ #("abc"
+ 0 1 (face default foo 1)
+ 1 3 (face (default italic) bar "2")))
+ '(concat (propertize "a" 'foo 1 'face 'default)
+ (propertize "bc" 'bar "2" 'face '(default italic)))))
+ (should (equal #("abc"
+ 0 1 (face default foo 1)
+ 1 3 (face (default italic) bar "2"))
+ (concat (propertize "a" 'foo 1 'face 'default)
+ (propertize "bc" 'bar "2" 'face '(default italic))))))
+
+(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
- master updated (64a4904353f -> 8e06f224a9e), F. Jason Park, 2023/12/17
- master 61b22ae9f37 03/19: Sequester some special-variable declarations in ERC, F. Jason Park, 2023/12/17
- master 0f058244ab7 18/19: Cache shortened channel names in erc-track, F. Jason Park, 2023/12/17
- master 49bfea4386f 12/19: Use templates for formatting chat messages in ERC, F. Jason Park, 2023/12/17
- master 1e2b156f040 04/19: Double hyphenate internal ERC 5.6 text props, F. Jason Park, 2023/12/17
- master b5da8ba8070 02/19: Define ERC message-formatting templates with defvar,
F. Jason Park <=
- master 69ca2cc1138 05/19: Add utility for iterating over arrays in ERC, F. Jason Park, 2023/12/17
- master 4ee4865ce20 07/19: Add erc-server-396 response handler, F. Jason Park, 2023/12/17
- master 741bce84890 16/19: Forgo excess nick buttonizing on JOINs and QUITs, F. Jason Park, 2023/12/17
- master 7c2e02e6d79 01/19: Remove module from suggested lineup in ERC's manual, F. Jason Park, 2023/12/17
- master 11bae96d23b 08/19: Clarify warning for process-dependent input in ERC, F. Jason Park, 2023/12/17
- master 6e4417eaa7e 14/19: Consolidate status-prefix slots of erc-channel-user, F. Jason Park, 2023/12/17
- master 7db500b50be 09/19: Make erc-get-user-mode-prefix more flexible, F. Jason Park, 2023/12/17
- master 9d961b31070 13/19: Demote erc-fill-line-spacing to a normal variable, F. Jason Park, 2023/12/17
- master c1befaf0a8b 10/19: Skip erc-ignored-user-p when erc-ignore-list is empty, F. Jason Park, 2023/12/17
- master 236a416be76 11/19: Add erc--spkr text property to chat messages, F. Jason Park, 2023/12/17