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
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'.
(,(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
(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")
;;;###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)
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."
;;; Code:
(require 'erc)
-(require 'erc-networks)
(eval-when-compile (require 'pcomplete))
;;;; Customizable variables
;;;; 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
(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)))
(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)))
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)))
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))
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
"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)
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)
(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)
"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.
(| 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")
((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."
;;; 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")
(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")
(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.
(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
projects / emacs.git / commitdiff