[Top][All Lists]

[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
    * 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-privmsg, erc-message-english-dcc-closed,
    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-send-offer): Define at top level using
    * 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
    * lisp/erc/erc-notify.el (erc-notify-install-message-catalogs):
    Deprecate, and rename all format templates with hyphens instead of
    (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
    * 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-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-syntax, erc-message-english-incorrect-args,
    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-too-many, erc-message-english-flood-ctcp-off,
    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-invitation, erc-message-english-no-target,
    erc-message-english-ops, erc-message-english-ops-none,
    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 
 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 
                              (,(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))))
- '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
    '((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))
              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))
              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)
@@ -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."
        parsed 'notice proc
-       'notify_on ?n nick ?m (erc-network-name)))
+       'notify-on ?n nick ?m (erc-network-name)))
 (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."
        parsed 'notice proc
-       'notify_on ?n nick ?m (erc-network-name)))
+       'notify-on ?n nick ?m (erc-network-name)))
 (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 
        parsed 'notice proc
-       'notify_off ?n nick ?m (erc-network-name)))
+       'notify-off ?n nick ?m (erc-network-name)))
 ;;;; User level command
@@ -193,6 +194,12 @@ nick from `erc-last-ison' to prevent any further 
   "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."))
    ((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!")
         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)))
     (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))
       (setq args (cdr args)))
-    (erc-display-message
-     nil 'notice 'active
-     'notify_list ?l (mapconcat #'identity erc-notify-list " "))))
+    (erc-cmd-NOTIFY "-l")))
-(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))
 (defun pcomplete/erc-mode/NOTIFY ()
-  (require 'pcomplete)
-  (pcomplete-here (pcomplete-erc-all-nicks)))
+  (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)))
- '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)
+  (declare (obsolete "define manually using `defvar' instead" "30.1"))
   (set (erc-make-message-variable-name catalog entry)
 (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)))))
- '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

reply via email to

[Prev in Thread] Current Thread [Next in Thread]