From: F. Jason Park Date: Wed, 29 Nov 2023 00:51:36 +0000 (-0800) Subject: Define ERC message-formatting templates with defvar X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b5da8ba80709286284a4ba7a0c7806e3169e76a6;p=emacs.git 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) --- 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