From: "J.P." <jp@neverwas.me>
To: 73798@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#73798: 31.0.50; ERC 5.7: New extensibility focused match API
Date: Fri, 01 Nov 2024 06:39:07 -0700 [thread overview]
Message-ID: <87h68rrs3o.fsf__9524.09048784233$1730468446$gmane$org@neverwas.me> (raw)
In-Reply-To: <87ldy3v87y.fsf@neverwas.me> (J. P.'s message of "Thu, 31 Oct 2024 22:22:41 -0700")
[-- Attachment #1: Type: text/plain, Size: 129 bytes --]
v3. Replace `erc-match-types' with `erc-match-functions', an actual
(abnormal) hook. Update docs as mentioned in previous post.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 15854 bytes --]
From af5dd1ceb407c445bfa6f27ec737f989329bbdc4 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 1 Nov 2024 06:30:22 -0700
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
[5.7] Use speaker-end marker in ERC insertion hooks
[5.7] Introduce lower level erc-match API
[5.7] Use erc-match-type API for erc-desktop-notifications
doc/misc/erc.texi | 343 ++++++++++++---
etc/ERC-NEWS | 22 +
lisp/erc/erc-desktop-notifications.el | 69 ++-
lisp/erc/erc-fill.el | 20 +-
lisp/erc/erc-match.el | 416 ++++++++++++++++--
lisp/erc/erc.el | 48 +-
.../erc/erc-desktop-notifications-tests.el | 115 +++++
test/lisp/erc/erc-match-tests.el | 214 ++++++++-
8 files changed, 1137 insertions(+), 110 deletions(-)
create mode 100644 test/lisp/erc/erc-desktop-notifications-tests.el
Interdiff:
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index b0cb6b0a815..49dbfe3623a 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -2081,11 +2081,12 @@ Match API
the message being processed. That message's formatted body occupies
the narrowed buffer when ERC creates and provides access to each
@code{erc-match} instance. To use this interface, you add a
- @dfn{constructor}-like function to the list @code{erc-match-types}:
+ @dfn{constructor}-like function to the hook
+ @code{erc-match-functions}:
- @defopt erc-match-types
+ @defopt erc-match-functions
- A hook-like list of functions, where each accepts the parameters named
+ An abnormal hook for which each member accepts the parameters named
above as an @samp{&rest}-style plist and returns a new
@code{erc-match} instance. A function can also be a traditional
@code{cl-defstruct}-provided constructor belonging to a @dfn{subtype}
@@ -2141,8 +2142,8 @@ Match API
:handler (lambda (_) (cl-incf my-mentions))
plist))
-(setopt erc-match-types (add-to-list 'erc-match-types #'my-match)
- erc-prompt (lambda () (format "%d!" my-mentions)))
+(add-hook 'erc-match-functions #'my-match)
+(setopt erc-prompt (lambda () (format "%d!" my-mentions)))
@end lisp
@noindent
@@ -2153,14 +2154,16 @@ Match API
on chat content by filtering out non-@samp{PRIVMSG} messages via the
slot @samp{command}.
-For a detailed example showing how to use this API for more involved
-matching that doesn't involve highlighting, see the @samp{notifications}
-module, which lives in @file{erc-desktop-notifications.el}. Ignore the
-parts that involve adapting the global setup (and teardown) business to
-a buffer-local context. Since your module is declared @code{local}, as
-per the modern convention, you won't be needing such code, so feel free
-to use utility functions like @code{erc-match-add-local-type} directly
-in your module's definition.
+For a detailed example of matching without highlighting, see the
+@samp{jabbycat} demo module, available on ERC's dev-oriented package
+archive: @uref{https://emacs-erc.gitlab.io/bugs/archive/jabbycat.html}.
+If you're in a hurry, check out @file{erc-desktop-notifications.el},
+which ships with ERC, but please ignore the parts that involve adapting
+the global setup (and teardown) business to a buffer-local context.
+Since your module is declared @code{local}, as per the modern
+convention, you won't be needing such code, so feel free to do things
+like add local members to @code{erc-match-functions} in your module's
+definition.
@anchor{highlighting}
@subsection Highlighting
@@ -2188,7 +2191,7 @@ Match API
:face 'my-face
plist))
-(setopt erc-match-types (add-to-list 'erc-match-types #'my-match))
+(add-hook 'erc-match-functions #'my-match)
@end lisp
@noindent
@@ -2210,6 +2213,11 @@ Match API
@code{nick}, @code{message}, @code{all}, @code{keyword},
@code{nick-or-keyword}, and @code{nick-or-mention}.
+The complement to the @samp{part} slot is @samp{data}, which holds the
+value of the module's option corresponding to the specific type. For
+example, ERC initializes the @samp{data} slot for the
+@code{erc-match-opt-pal} type with the value of @code{erc-pals}.
+
The default handler, @code{erc-match-highlight}, does its work by
deferring to a purpose-built @dfn{method} meant to handle
@samp{part}-based highlighting:
@@ -2254,12 +2262,11 @@ Match API
((cdr (assoc (erc-target) chans))))))
(cl-defstruct (my-match (:include erc-match-opt-keyword
- (part 'keyword)
(data (my-get-keyword))
(face 'my-keyword))
(:constructor my-match)))
-(setopt erc-match-types (add-to-list 'erc-match-types #'my-match))
+(add-hook 'erc-match-functions #'my-match)
(cl-defmethod erc-match-highlight-by-part ((instance my-match)
(_ (eql keyword)))
@@ -2272,9 +2279,13 @@ Match API
@end lisp
@noindent
-(Note that in the method body, you @emph{could} technically skip to the
+Note that in the method body, you @emph{could} technically skip to the
beginning of the last match for the first go around because the match
-data from the @samp{predicate} is still fresh.)
+data from the @samp{predicate} is still fresh. Also, while the method
+could simply call @code{my-get-keyword} directly instead of accessing
+the @samp{data} slot and also reference the @code{my-keyword} face
+instead of using the @samp{face} slot, other methods may need to share
+@samp{data} or alter @samp{face}.
@node Options
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index adc90e1f544..2d605ced5f5 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -128,9 +128,10 @@ notifications
(defun erc-desktop-notifications--setup ()
(if erc-notifications-mode
- (erc-match-add-local-type #'erc-desktop-notifications--match-type-query)
- (erc-match-remove-local-type
- #'erc-desktop-notifications--match-type-query)))
+ (add-hook 'erc-match-functions
+ #'erc-desktop-notifications--match-type-query 0 t)
+ (remove-hook 'erc-match-functions
+ #'erc-desktop-notifications--match-type-query t)))
(defvar erc-desktop-notifications-match-query-commands '(PRIVMSG)
"IRC commands considered in query buffers for notification.
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index c59eaa0ad6c..33be982477c 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -274,21 +274,20 @@ erc-match-quote-when-adding
(const t)
(const nil)))
-(defcustom erc-match-types '(erc-match-opt-pal
- erc-match-opt-fool
- erc-match-opt-dangerous-host
- erc-match-opt-keyword
- erc-match-opt-current-nick)
+(defcustom erc-match-functions '(erc-match-opt-pal
+ erc-match-opt-fool
+ erc-match-opt-dangerous-host
+ erc-match-opt-keyword
+ erc-match-opt-current-nick)
"Type constructors for \\+`match' processing.
See the struct `erc-match' as well as Info node `(erc) Match API' for
-further details."
+details."
:package-version '(ERC . "5.7") ; FIXME sync on release
- :type '(set (function-item erc-match-opt-pal)
- (function-item erc-match-opt-fool)
- (function-item erc-match-opt-dangerous-host)
- (function-item erc-match-opt-keyword)
- (function-item erc-match-opt-current-nick)
- (repeat :tag "User-specified constructor" :inline t function)))
+ :type '(hook :options (erc-match-opt-pal
+ erc-match-opt-fool
+ erc-match-opt-dangerous-host
+ erc-match-opt-keyword
+ erc-match-opt-current-nick)))
;; Internal variables:
@@ -497,10 +496,10 @@ erc-match-directed-at-fool-p
(cl-defstruct (erc-match (:constructor erc-match))
"Base type for text and user matching performed by the \\+`match' module.
Users wishing to perform custom matching should add a constructor that
-returns an instance of this type to the list `erc-match-types'. If the
-`:predicate' slot's predicate returns non-nil after being called with
-its own instance in the narrowed single-message buffer, ERC calls the
-`:handler' slot's function with the same instance and with the match
+returns an instance of this type to the hook `erc-match-functions'. If
+the `:predicate' slot's predicate returns non-nil after being called
+with its own instance in the narrowed single-message buffer, ERC calls
+the `:handler' slot's function with the same instance and with the match
data still intact. More details in Info node `(erc) Match API'."
( predicate (error "Keyword `:predicate' missing") :type function
:documentation "Called in narrowed buffer with own instance.")
@@ -771,22 +770,28 @@ erc-match-highlight
(point-min))
(point-max))))))
-(defvar-local erc-match--types nil
- "Additional `erc-match-types' for use by other modules.")
-
-(defun erc-match-add-local-type (function)
- "Add FUNCTION to registered type in current buffer."
- (push function erc-match--types))
-
-(defun erc-match-remove-local-type (function)
- "Remove FUNCTION from registered types in current buffer."
- (unless (setq erc-match--types (delete function erc-match--types))
- (kill-local-variable 'erc-match--types)))
-
(defun erc-match-get-message-body (instance)
"Return the message body in the narrowed buffer for match INSTANCE."
(buffer-substring (erc-match-body-beg instance) (1- (point-max))))
+(defun erc-match--run-match (constructor spkr-beg spkr-end body-beg
+ nick sender command)
+ "Run :handler for for `erc-match' instance if :predicate returns non-nil.
+Call CONSTRUCTOR with SPKR-BEG, SPKR-END, BODY-BEG, NICK SENDER, and
+COMMAND to create said instance."
+ (when-let* ((instance (funcall constructor
+ :spkr-beg spkr-beg
+ :spkr-end spkr-end
+ :body-beg body-beg
+ :nick nick
+ :sender sender
+ :command command))
+ ((or nick (not (erc-match-user-p instance))))
+ ((goto-char (point-min)))
+ ((funcall (erc-match-predicate instance) instance)))
+ (funcall (erc-match-handler instance) instance)
+ nil))
+
(defun erc-match--message ()
"Highlight matches in narrowed buffer's current message."
(goto-char (point-min))
@@ -808,20 +813,9 @@ erc-match--message
((point-min)))))
(command (erc--check-msg-prop 'erc--cmd)))
(with-syntax-table erc-match-syntax-table
- (dolist (type (if erc-match--types
- (append erc-match--types erc-match-types)
- erc-match-types))
- (when-let* ((instance (funcall type
- :spkr-beg spkr-beg
- :spkr-end spkr-end
- :body-beg body-beg
- :nick nick
- :sender (erc-response.sender response)
- :command command))
- ((or user-nuh (not (erc-match-user-p instance))))
- ((goto-char (point-min)))
- ((funcall (erc-match-predicate instance) instance)))
- (funcall (erc-match-handler instance) instance))))
+ (run-hook-wrapped 'erc-match-functions #'erc-match--run-match
+ spkr-beg spkr-end body-beg nick
+ (erc-response.sender response) command))
(when (and erc--offset-marker (/= body-beg erc--offset-marker))
(setq erc--offset-marker body-beg))))
@@ -1067,9 +1061,7 @@ erc-match--setup
;; invisible properties managed by this module.
(if erc-match-mode
(erc-match-toggle-hidden-fools +1)
- (erc-match-toggle-hidden-fools -1)
- (when (null erc-match--types)
- (kill-local-variable 'erc-match--types))))
+ (erc-match-toggle-hidden-fools -1)))
(defun erc-match-toggle-hidden-fools (arg)
"Toggle fool visibility.
diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el
index e8726ca148e..0b90867b32d 100644
--- a/test/lisp/erc/erc-match-tests.el
+++ b/test/lisp/erc/erc-match-tests.el
@@ -724,17 +724,17 @@ erc-log-matches/legacy
(let ((erc-match-use-legacy-logic-p t))
(erc-match-tests--log-matches))))
-;; This demos bare bones usage of the `erc-match-types' API that opts
-;; out of the "parts-based" framework. The user does not have to
-;; provide a `:part' keyword because they've overridden the `:handler',
-;; meaning `erc-match-highlight-by-part' never runs. This is somewhat
-;; analogous but ultimately orthogonal to `erc-text-matched-hook' not
-;; running because that happens on account of the user not specifying a
-;; `:category' field.
-(ert-deftest erc-match-types/api/non-parts-based ()
+;; This demos bare-bones usage of the `erc-match' API that implicitly
+;; opts out of the traditional options and "parts"-based mechanism. The
+;; user does not have to provide a `:part' keyword because they've
+;; overridden the `:handler', meaning `erc-match-highlight-by-part'
+;; never runs. This is somewhat analogous but ultimately orthogonal to
+;; `erc-text-matched-hook' not running because that happens on account
+;; of the user not specifying a `:category' field.
+(ert-deftest erc-match-functions/api/non-parts-based ()
(let* ((results ())
(erc-text-matched-hook (lambda (&rest r) (push r results)))
- (erc-match-types
+ (erc-match-functions
(list
(lambda (&rest plist)
;; Doing everything in `:pred' would also work if
@@ -760,24 +760,26 @@ erc-match-types/api/non-parts-based
;; This one piggybacks on infrastructure supporting the traditional
;; `match' interface.
-(ert-deftest erc-match-types/api/parts-based ()
+(ert-deftest erc-match-functions/api/parts-based ()
(let* ((results ())
(erc-text-matched-hook (lambda (&rest r) (push r results)))
- (erc-match-types ()))
+ (erc-match-functions ()))
(erc-match-tests--perform
(lambda ()
;; Use local setter for no particular reason.
- (erc-match-add-local-type
- (lambda (&rest plist)
- (apply #'erc-match-traditional
- :category 'keyword
- :part 'keyword
- :data '("alice")
- :face 'error
- :predicate (lambda (_) (search-forward "alice" nil t))
- plist)))
+ (add-hook 'erc-match-functions
+ (lambda (&rest plist)
+ (apply #'erc-match-traditional
+ :category 'keyword
+ :part 'keyword
+ :data '("alice")
+ :face 'error
+ :predicate (lambda (_)
+ (search-forward "alice" nil t))
+ plist))
+ 0 t)
(erc-tests-common-add-cmem "bob")
(erc-tests-common-add-cmem "Alice")
--
2.46.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.7-Use-speaker-end-marker-in-ERC-insertion-hooks.patch --]
[-- Type: text/x-patch, Size: 9590 bytes --]
From 59393bd9be6cb30ee78dbead7f39ba5042bf917c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 6 Oct 2024 23:17:40 -0700
Subject: [PATCH 1/3] [5.7] Use speaker-end marker in ERC insertion hooks
* lisp/erc/erc-fill.el (erc-fill-wrap): Use `erc--offset-marker' instead
of heuristics for finding the beginning of the message proper.
* lisp/erc/erc.el (erc--send-action-display): Use
`erc--ensure-offset-prop'.
(erc--ensure-offset-prop): New function. Only works for
`erc--message-speaker-catalog' entries, which all (currently) end in
"%m". If any were to gain a "footer" component after their "%m", this
would need to be modified, possibly to require an extra `catalog-key'
parameter that could then be queried at runtime for a symbol property
specifying the footer length as a negative offset.
(erc--add-msg-prop): New function.
(erc--offset-marker): New variable.
(erc--with-offset-marker): New macro.
(erc-insert-line): Run insertion hooks in `erc--with-offset-marker'.
(erc--determine-speaker-message-format-args)
(erc--format-speaker-input-message)
(erc-ctcp-query-ACTION): Use `erc--ensure-offset-prop'. In the latter,
don't set statusmsg "%s" to the target name.
(erc-make-notice): Set `erc--offset' msg prop to the length of the
`erc--notice-prefix', which includes a trailing space. Don't do the
same for the fallback case of `erc-display-message-highlight' because
some format specs contain leading characters that are basically analogs
of `erc-notice-prefix'. Examining each prematurely to formulate a guess
that may never be used is wasteful, and just going with 0 would
sometimes be wrong or destructive, such as on subsequent passes for
"compound" `erc-display-message' type parameters specified by
`erc-display-error-notice', etc.
(erc-display-msg): Run send hooks in `erc--with-offset-marker'.
---
lisp/erc/erc-fill.el | 20 ++++++++++--------
lisp/erc/erc.el | 48 +++++++++++++++++++++++++++++++++++---------
2 files changed, 51 insertions(+), 17 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 13f1dbf266c..338008d442b 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -707,14 +707,18 @@ erc-fill-wrap
(funcall erc-fill--wrap-length-function))
(and-let* ((msg-prop (erc--check-msg-prop 'erc--msg))
((not (eq msg-prop 'unknown))))
- (when-let* ((e (erc--get-speaker-bounds))
- (b (pop e))
- ((or erc-fill--wrap-action-dedent-p
- (not (erc--check-msg-prop 'erc--ctcp
- 'ACTION)))))
- (goto-char e))
- (skip-syntax-forward "^-")
- (forward-char)
+ (let ((dedentp (or erc-fill--wrap-action-dedent-p
+ (not (erc--check-msg-prop 'erc--ctcp
+ 'ACTION)))))
+ (if (and dedentp erc--offset-marker)
+ (goto-char erc--offset-marker)
+ ;; No marker means `datestamp' or refilling via
+ ;; `erc-fill--wrap-unmerge-on-date-stamp', etc.
+ (when-let* ((dedentp)
+ (bounds (erc--get-speaker-bounds)))
+ (goto-char (cdr bounds)))
+ (skip-syntax-forward "^-")
+ (forward-char)))
(cond ((eq msg-prop 'datestamp)
(when erc-fill--wrap-rejigger-last-message
(set-marker erc-fill--wrap-last-msg (point-min)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 18cc4071b48..8560f067180 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3185,7 +3185,8 @@ erc--send-action-display
(let ((erc-current-message-catalog erc--message-speaker-catalog))
(erc-display-message nil nil (current-buffer) 'ctcp-action-input
?p (erc-get-channel-membership-prefix nick)
- ?n (erc--speakerize-nick nick) ?m string)))))
+ ?n (erc--speakerize-nick nick)
+ ?m (erc--ensure-offset-prop string))))))
(defun erc--send-action (target string force)
"Display STRING, then send to TARGET as a \"CTCP ACTION\" message."
@@ -3209,6 +3210,11 @@ erc--ensure-spkr-prop
`((erc--spkr . ,nick) ,@overrides ,@erc--msg-prop-overrides))))
nick)
+(defun erc--ensure-offset-prop (message)
+ "Add `erc--offset' msg prop for string MESSAGE."
+ (erc--add-msg-prop 'erc--offset (- (length message)))
+ message)
+
(defun erc-string-invisible-p (string)
"Check whether STRING is invisible or not.
I.e. any char in it has the `invisible' property set."
@@ -3323,6 +3329,13 @@ erc--memq-msg-prop
((consp haystack)))
(memq needle haystack)))
+(defun erc--add-msg-prop (prop val)
+ "Add PROP and VAL to `erc--msg-props' or `erc--msg-prop-overrides'."
+ (cond (erc--msg-props
+ (puthash prop val erc--msg-props))
+ (erc--msg-prop-overrides
+ (setf (alist-get prop erc--msg-prop-overrides) val))))
+
(defmacro erc--get-inserted-msg-beg-at (point at-start-p)
(macroexp-let2* nil ((point point)
(at-start-p at-start-p))
@@ -3447,6 +3460,20 @@ erc--insert-line-function
(defvar erc--insert-marker nil
"Internal override for `erc-insert-marker'.")
+(defvar erc--offset-marker nil
+ "Demarcates the header/body partition in a message.")
+
+(defmacro erc--with-offset-marker (&rest body)
+ "Run BODY in insertion-narrowed buffer with `erc--offset-marker' present."
+ `(let ((erc--offset-marker
+ (and-let* ((offset (erc--check-msg-prop 'erc--offset))
+ (side (if (natnump offset) (point-min) (1- (point-max)))))
+ (remhash 'erc--offset erc--msg-props)
+ (copy-marker (+ side offset)))))
+ ,@body
+ (when erc--offset-marker
+ (set-marker erc--offset-marker nil))))
+
(define-obsolete-function-alias 'erc-display-line-1 'erc-insert-line "30.1")
(defun erc-insert-line (string buffer)
"Insert STRING in an `erc-mode' BUFFER.
@@ -3504,8 +3531,9 @@ erc-insert-line
;; run insertion hook, with point at restored location
(save-restriction
(narrow-to-region insert-position (point))
- (run-hooks 'erc-insert-modify-hook)
- (run-hooks 'erc-insert-post-hook)
+ (erc--with-offset-marker
+ (run-hooks 'erc-insert-modify-hook)
+ (run-hooks 'erc-insert-post-hook))
(when erc-remove-parsed-property
(remove-text-properties (point-min) (point-max)
'(erc-parsed nil tags nil)))
@@ -6433,7 +6461,7 @@ erc--determine-speaker-message-format-args
(if inputp 'input-query-notice 'query-notice)
(if inputp 'input-chan-notice 'chan-notice))))
?p (or prefix "") ?n (erc--speakerize-nick nick disp-nick)
- ?s (or statusmsg "") ?m message))
+ ?s (or statusmsg "") ?m (erc--ensure-offset-prop message)))
(defcustom erc-show-speaker-membership-status nil
"Whether to prefix speakers with their channel status.
@@ -6567,7 +6595,7 @@ erc--format-speaker-input-message
(erc--msg-prop-overrides (push (cons 'erc--msg key)
erc--msg-prop-overrides)))
(erc-format-message key ?p pfx ?n (erc--speakerize-nick nick)
- ?m message))
+ ?m (erc--ensure-offset-prop message)))
(propertize (concat "> " message) 'font-lock-face 'erc-input-face)))
(defun erc-echo-notice-in-default-buffer (s parsed buffer _sender)
@@ -6877,12 +6905,12 @@ erc-ctcp-query-ACTION
(if selfp
(if stsmsg 'ctcp-action-statusmsg-input 'ctcp-action-input)
(if stsmsg 'ctcp-action-statusmsg 'ctcp-action))
- ?s (or stsmsg to)
+ ?s (or stsmsg "")
?p (or (and (erc-channel-user-p prefix)
(erc-get-channel-membership-prefix prefix))
"")
?n (erc--speakerize-nick nick dispnm)
- ?m s))))))
+ ?m (erc--ensure-offset-prop s)))))))
(defvar erc-ctcp-query-CLIENTINFO-hook '(erc-ctcp-query-CLIENTINFO))
@@ -7865,6 +7893,7 @@ erc-make-notice
"Notify the user of MESSAGE."
(when erc-minibuffer-notice
(message "%s" message))
+ (erc--add-msg-prop 'erc--offset (length erc-notice-prefix))
(erc-highlight-notice (concat erc-notice-prefix message)))
(defun erc-highlight-error (s)
@@ -8365,8 +8394,9 @@ erc-display-msg
(insert (erc--format-speaker-input-message line) "\n")
(save-restriction
(narrow-to-region insert-position (point))
- (run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook)
+ (erc--with-offset-marker
+ (run-hooks 'erc-send-modify-hook)
+ (run-hooks 'erc-send-post-hook))
(cl-assert (> (- (point-max) (point-min)) 1))
(add-text-properties (point-min) (1+ (point-min))
(erc--order-text-properties-from-hash
--
2.46.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.7-Introduce-lower-level-erc-match-API.patch --]
[-- Type: text/x-patch, Size: 53921 bytes --]
From 1c4d1feb3b48c04b145a03f40f8754da13030d4e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 3 Jun 2023 02:01:29 -0700
Subject: [PATCH 2/3] [5.7] Introduce lower level erc-match API
* doc/misc/erc.texi (Module Loading): move this portion of the Modules
chapter to a new node under the Advanced chapter.
(Match API): New node under the Advanced chapter.
Update menus.
* lisp/erc/erc-match.el (erc-pal-highlight-type)
(erc-fool-highlight-type)
(erc-dangerous-host-highlight-type): Add `nick-or-mention' variant.
(erc-text-matched-hook): Doc.
(erc-match-functions): New option.
(erc-add-entry-to-list)
(erc-remove-entry-from-list): Clear options cache.
(erc-match)
(erc-match-traditional)
(erc-match-opt-current-nick)
(erc-match-opt-keyword)
(erc-match-opt-user)
(erc-match-opt-fool)
(erc-match-opt-pal)
(erc-match-opt-dangerous-host): New struct types.
(erc-match--opt-pat-cache): New variable.
(erc-match--opt-pat-ttl): New variable.
(erc-match--opt-pat): New struct type.
(erc-match--opt-pat-cache-clear)
(erc-match--opt-pat-cache-clear-all)
(erc-match--opt-pat-get)
(erc-match--opt-pat-make)
(erc-match--opt-pat-kw-make)
(erc-match--opt-pat-addr-beg-make)
(erc-match--opt-pat-addr-end-make)
(erc-match--current-nick-p)
(erc-match--keyword-p)
(erc-match--user-nuh-or-mention-p): New functions.
(erc-match-highlight-by-part): New generic function and methods.
(erc-match-highlight-matched): New variable.
(erc-match-highlight): New function.
(erc-match-type-get-message-body): New function.
(erc-match--run-match): New function.
(erc-match--message): New function.
(erc-match-use-legacy-logic-p): New variable.
(erc-match-message): Move body to `erc-match--message-legacy. Rework as
thin wrapper.
(erc-match--message-legacy): New function with body of former
`erc-match-message'.
(erc-log-matches): Rework to be slightly less wasteful.
* test/lisp/erc/erc-match-tests.el (erc-match-tests--perform): Shadow
`erc-match--opt-pat-cache'.
(erc-match-message/pal/nick/legacy)
(erc-match-message/fool/nick/legacy)
(erc-match-message/dangerous-host/nick/legacy): New tests.
(erc-match-tests--hl-type-nick-or-mention): New function.
(erc-match-message/pal/nick-or-mention)
(erc-match-message/fool/nick-or-mention)
(erc-match-message/dangerous-host/nick-or-mention)
(erc-match-message/pal/message/legacy)
(erc-match-message/fool/message/legacy)
(erc-match-message/dangerous-host/message/legacy)
(erc-match-message/pal/all/legacy)
(erc-match-message/fool/all/legacy)
(erc-match-message/dangerous-host/all/legacy)
(erc-match-message/current-nick/nick-or-keyword/legacy)
(erc-match-message/keyword/keyword/legacy)
(erc-log-matches/legacy)
(erc-match-functions/api/non-parts-based)
(erc-match-functions/api/parts-based): New tests. (Bug#73798)
---
doc/misc/erc.texi | 343 ++++++++++++++++++++-----
lisp/erc/erc-match.el | 416 +++++++++++++++++++++++++++++--
test/lisp/erc/erc-match-tests.el | 214 +++++++++++++++-
3 files changed, 888 insertions(+), 85 deletions(-)
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 0f6b6b8c5be..49dbfe3623a 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -81,6 +81,8 @@ Top
* SASL:: Authenticating via SASL.
* Sample Configuration:: An example configuration file.
* Integrations:: Integrations available for ERC.
+* Module Loading:: How ERC loads modules.
+* Match API:: Custom matching and highlighting.
* Options:: Options that are available for ERC.
@end detailmenu
@@ -664,63 +666,6 @@ Modules
And unlike global toggles, none of these ever mutates
@code{erc-modules}.
-@c FIXME add section to Advanced chapter for creating modules, and
-@c move this there.
-@anchor{Module Loading}
-@subheading Loading
-@cindex module loading
-
-ERC loads internal modules in alphabetical order and third-party
-modules as they appear in @code{erc-modules}. When defining your own
-module, take care to ensure ERC can find it. An easy way to do that
-is by mimicking the example in the doc string for
-@code{define-erc-module} (also shown below). For historical reasons,
-ERC falls back to @code{require}ing features. For example, if some
-module @code{my-module} in @code{erc-modules} lacks a corresponding
-@code{erc-my-module-mode} command, ERC will attempt to load the
-library @code{erc-my-module} prior to connecting. If this fails, ERC
-signals an error. Users defining personal modules in an init file
-should @code{(provide 'erc-my-module)} somewhere to placate ERC.
-Dynamically generating modules on the fly is not supported.
-
-Some older built-in modules have a second name along with a second
-minor-mode toggle, which is just a function alias for its primary
-counterpart. For practical reasons, ERC does not define a
-corresponding variable alias because contending with indirect
-variables complicates bookkeeping tasks, such as persisting module
-state across IRC sessions. New modules should definitely avoid
-defining aliases without a good reason.
-
-Some packages have been known to autoload a module's definition
-instead of its minor-mode command, which severs the link between the
-library and the module. This means that enabling the mode by invoking
-its command toggle isn't enough to load its defining library. As
-such, packages should only supply module-related autoload cookies with
-an actual @code{autoload} form for their module's minor-mode command,
-like so:
-
-@lisp
-;;;###autoload(autoload 'erc-my-module-mode "erc-my-module" nil t)
-(define-erc-module my-module nil
- "My doc string."
- ((add-hook 'erc-insert-post-hook #'erc-my-module-on-insert-post))
- ((remove-hook 'erc-insert-post-hook #'erc-my-module-on-insert-post)))
-@end lisp
-
-@noindent
-As implied earlier, packages can usually omit such cookies entirely so
-long as their module's prefixed name matches that of its defining
-library and the library's provided feature.
-
-Finally, packages have also been observed to run
-@code{erc-update-modules} in top-level forms, forcing ERC to take
-special precautions to avoid recursive invocations. Another
-unfortunate practice is mutating @code{erc-modules} itself upon
-loading @code{erc}, possibly by way of an autoload. Doing this tricks
-Customize into displaying the widget for @code{erc-modules}
-incorrectly, with built-in modules moved from the predefined checklist
-to the user-provided free-form area.
-
@c PRE5_4: Document every option of every module in its own subnode
@@ -733,6 +678,8 @@ Advanced Usage
* SASL:: Authenticating via SASL.
* Sample Configuration:: An example configuration file.
* Integrations:: Integrations available for ERC.
+* Module Loading:: How ERC loads modules.
+* Match API:: Custom matching and highlighting.
* Options:: Options that are available for ERC.
@detailmenu
@@ -2059,6 +2006,288 @@ display-buffer
@end itemize
@end table
+@node Module Loading
+@section Module Loading
+@cindex module loading
+
+ERC loads internal modules in alphabetical order and third-party
+modules as they appear in @code{erc-modules}. When defining your own
+module, take care to ensure ERC can find it. An easy way to do that
+is by mimicking the example in the doc string for
+@code{define-erc-module} (also shown below). For historical reasons,
+ERC falls back to @code{require}ing features. For example, if some
+module @code{my-module} in @code{erc-modules} lacks a corresponding
+@code{erc-my-module-mode} command, ERC will attempt to load the
+library @code{erc-my-module} prior to connecting. If this fails, ERC
+signals an error. Users defining personal modules in an init file
+should @code{(provide 'erc-my-module)} somewhere to placate ERC.
+Dynamically generating modules on the fly is not supported.
+
+Some older built-in modules have a second name along with a second
+minor-mode toggle, which is just a function alias for its primary
+counterpart. For practical reasons, ERC does not define a
+corresponding variable alias because contending with indirect
+variables complicates bookkeeping tasks, such as persisting module
+state across IRC sessions. New modules should definitely avoid
+defining aliases without a good reason.
+
+Some packages have been known to autoload a module's definition
+instead of its minor-mode command, which severs the link between the
+library and the module. This means that enabling the mode by invoking
+its command toggle isn't enough to load its defining library. As
+such, packages should only supply module-related autoload cookies with
+an actual @code{autoload} form for their module's minor-mode command,
+like so:
+
+@lisp
+;;;###autoload(autoload 'erc-my-module-mode "erc-my-module" nil t)
+(define-erc-module my-module nil
+ "My doc string."
+ ((add-hook 'erc-insert-post-hook #'erc-my-module-on-insert-post))
+ ((remove-hook 'erc-insert-post-hook #'erc-my-module-on-insert-post)))
+@end lisp
+
+@noindent
+As implied earlier, packages can usually omit such cookies entirely so
+long as their module's prefixed name matches that of its defining
+library and the library's provided feature.
+
+Finally, packages have also been observed to run
+@code{erc-update-modules} in top-level forms, forcing ERC to take
+special precautions to avoid recursive invocations. Another
+unfortunate practice is mutating @code{erc-modules} itself upon
+loading @code{erc}, possibly by way of an autoload. Doing this tricks
+Customize into displaying the widget for @code{erc-modules}
+incorrectly, with built-in modules moved from the predefined checklist
+to the user-provided free-form area.
+
+@node Match API
+@section Match API
+@cindex low-level match
+
+This section describes the low-level @samp{match} @acronym{API}
+introduced in ERC 5.7. For basic, options-oriented usage, please see
+the doc strings for option @code{erc-pal-highlight-type} and friends in
+the @code{erc-match} group. Unfortunately, those options often prove
+insufficient for more granular filtering and highlighting needs, and
+advanced users eventually outgrow them. However, under the hood, those
+options all use the same foundational @code{erc-match} API, which
+centers around a @code{cl-defstruct} @dfn{type} of the same name:
+
+@deftp {Struct} erc-match @
+ predicate spkr-beg spkr-end body-beg sender nick command handler
+
+ This is a @code{cl-struct} type that contains some handy facts about
+ the message being processed. That message's formatted body occupies
+ the narrowed buffer when ERC creates and provides access to each
+ @code{erc-match} instance. To use this interface, you add a
+ @dfn{constructor}-like function to the hook
+ @code{erc-match-functions}:
+
+ @defopt erc-match-functions
+
+ An abnormal hook for which each member accepts the parameters named
+ above as an @samp{&rest}-style plist and returns a new
+ @code{erc-match} instance. A function can also be a traditional
+ @code{cl-defstruct}-provided constructor belonging to a @dfn{subtype}
+ you've defined.
+
+ @end defopt
+
+ The only slot you definitely need to specify is @samp{predicate}.
+ Both it and @samp{handler} are functions that take a single argument:
+ the instance itself. As its name implies, @samp{predicate} must
+ return non-@code{nil} if @samp{handler}, whose return value ERC
+ ignores, should run.
+
+ A few slots, like @samp{spkr-beg}, @samp{spkr-end}, and @samp{nick},
+ may surprise you. The first two are @code{nil} for non-chat messages,
+ like those displayed for @samp{JOIN} events. The @samp{nick} slot can
+ likewise be @code{nil} if the sender of the message is a domain-style
+ host name, such as @samp{irc.example.org}, which it often is for
+ informational messages, like @samp{*** #chan was created on 2023-12-26
+ 00:36:42}.
+
+ To locate the start of the just-inserted message, use @samp{body-beg},
+ a marker indicating the beginning of the message proper. Don't
+ forget: all inserted messages include a trailing newline. If you want
+ to extract just the message body's text, use the function
+ @code{erc-match-get-message-body}:
+
+ @defun erc-match-get-message-body match
+
+ Takes an @code{erc-match} instance and returns a string containing the
+ message body, sans trailing newline and any leading speaker or
+ decorative component, such as @code{erc-notice-prefix}.
+
+ @end defun
+
+@end deftp
+
+@noindent
+Although module authors may want to subclass this struct, everyday users
+can just instantiate it directly (it's @dfn{concrete}). This is
+especially handy for one-off tasks or simple customizations in your
+@file{init.el}. To do this, define a function that invokes its
+constructor:
+
+@lisp
+(require 'erc-match)
+
+(defvar my-mentions 0)
+
+(defun my-match (&rest plist)
+ (apply #'erc-match
+ :predicate (lambda (_) (search-forward "my-project" nil t))
+ :handler (lambda (_) (cl-incf my-mentions))
+ plist))
+
+(add-hook 'erc-match-functions #'my-match)
+(setopt erc-prompt (lambda () (format "%d!" my-mentions)))
+@end lisp
+
+@noindent
+Here, the user could just as well shove the incrementer into the
+@samp{predicate} body, since @samp{handler} is set to @code{ignore} by
+default (however, some frown at the notion of a predicate exhibiting
+side effects). Likewise, the user could also choose to concentrate only
+on chat content by filtering out non-@samp{PRIVMSG} messages via the
+slot @samp{command}.
+
+For a detailed example of matching without highlighting, see the
+@samp{jabbycat} demo module, available on ERC's dev-oriented package
+archive: @uref{https://emacs-erc.gitlab.io/bugs/archive/jabbycat.html}.
+If you're in a hurry, check out @file{erc-desktop-notifications.el},
+which ships with ERC, but please ignore the parts that involve adapting
+the global setup (and teardown) business to a buffer-local context.
+Since your module is declared @code{local}, as per the modern
+convention, you won't be needing such code, so feel free to do things
+like add local members to @code{erc-match-functions} in your module's
+definition.
+
+@anchor{highlighting}
+@subsection Highlighting
+@cindex highlighting
+
+Third-party modules likely want to manage and apply faces themselves.
+However, in a pinch you can just piggyback atop the highlighting
+functionality already provided by @samp{match} to support its many
+high-level options.
+
+@lisp
+(require 'erc-match)
+
+(defvar my-keywords
+ `((foonet ("#chan" ,(rx bow (or "foo" "bar" "baz") eow)))))
+
+(defface my-face
+ '((t (:inherit font-lock-constant-face :weight bold)))
+ "My face.")
+
+(defun my-match (&rest plist)
+ (apply #'erc-match-opt-keyword
+ :data (and-let* ((chans (alist-get (erc-network) my-keywords))
+ ((cdr (assoc (erc-target) chans)))))
+ :face 'my-face
+ plist))
+
+(add-hook 'erc-match-functions #'my-match)
+@end lisp
+
+@noindent
+Here, the user leverages a handy subtype of @code{erc-match}, called
+@code{erc-match-opt-keyword}, which actually descends directly from
+another, intermediate @code{erc-match} type:
+
+@deftp {Struct} erc-match-traditional category face data part
+
+Use this type or one of its descendants (see below) if you want
+@code{erc-text-matched-hook} to run alongside (after) the @samp{handler}
+slot's default highlighter, @code{erc-match-highlight}, on every match
+for which the @samp{category} slot's value is non-@code{nil} (it becomes
+the argument provided for the hook's @var{match-type} parameter).
+
+Much more important, however, is @samp{part}. This slot determines what
+portion of the message is being highlighted or otherwise operated on.
+It can be any symbol, but the ones with predefined methods are
+@code{nick}, @code{message}, @code{all}, @code{keyword},
+@code{nick-or-keyword}, and @code{nick-or-mention}.
+
+The complement to the @samp{part} slot is @samp{data}, which holds the
+value of the module's option corresponding to the specific type. For
+example, ERC initializes the @samp{data} slot for the
+@code{erc-match-opt-pal} type with the value of @code{erc-pals}.
+
+The default handler, @code{erc-match-highlight}, does its work by
+deferring to a purpose-built @dfn{method} meant to handle
+@samp{part}-based highlighting:
+
+@defop {Method} erc-match-traditional erc-match-highlight-by-part @
+ instance part
+
+ You can override this method by @dfn{specializing} on any subclassed
+ @code{erc-match-traditional} type and/or non-reserved @var{part}, such
+ as one known only to your @file{init.el} or (informally) associated
+ with your package by its library @dfn{namespace}.
+
+@end defop
+
+@end deftp
+
+@noindent
+You likely won't be needing these, but for the sake of completeness,
+other options-based types similar to @code{erc-match-opt-keyword}
+include @code{erc-match-opt-current-nick}, @code{erc-match-opt-fool},
+@code{erc-match-opt-pal}, and @code{erc-match-opt-dangerous-host}. (If
+you're familiar with this module's user options, you'll notice some
+parallels here.)
+
+And, finally, here's a more elaborate, module-like example demoing
+highlighting based on the @code{erc-match-traditional} type:
+
+@lisp
+;; -*- lexical-binding: t; -*-
+
+(require 'erc-match)
+(require 'erc-button)
+
+(defvar my-keywords
+ `((foonet ("#chan" ,(rx bow (or "foo" "bar" "baz") eow)))))
+
+(defface my-keyword '((t (:underline (:color "tomato" :style wave))))
+ "My face.")
+
+(defun my-get-keyword ()
+ (and-let* ((chans (alist-get (erc-network) my-keywords))
+ ((cdr (assoc (erc-target) chans))))))
+
+(cl-defstruct (my-match (:include erc-match-opt-keyword
+ (data (my-get-keyword))
+ (face 'my-keyword))
+ (:constructor my-match)))
+
+(add-hook 'erc-match-functions #'my-match)
+
+(cl-defmethod erc-match-highlight-by-part ((instance my-match)
+ (_ (eql keyword)))
+ "Highlight keywords by merging instead of clobbering."
+ (dolist (pat (my-match-data instance))
+ (goto-char (my-match-body-beg instance))
+ (while (re-search-forward pat nil t)
+ (erc-button-add-face (match-beginning 0) (match-end 0)
+ (my-match-face instance)))))
+@end lisp
+
+@noindent
+Note that in the method body, you @emph{could} technically skip to the
+beginning of the last match for the first go around because the match
+data from the @samp{predicate} is still fresh. Also, while the method
+could simply call @code{my-get-keyword} directly instead of accessing
+the @samp{data} slot and also reference the @code{my-keyword} face
+instead of using the @samp{face} slot, other methods may need to share
+@samp{data} or alter @samp{face}.
+
+
@node Options
@section Options
@cindex options
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 6dc18bf250e..33be982477c 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -122,10 +122,15 @@ erc-pal-highlight-type
`all' - highlight the entire message (including the nick)
from pal
+ `nick-or-mention' - highlight a matching speaker or all matching
+ mentions as quasi keywords
+
A value of `nick' only highlights a matching sender's nick in the
bracketed speaker portion of the message. A value of \\+`message'
basically highlights its complement: the message-body alone, after the
-speaker tag. All values for this option require a matching sender to be
+speaker tag. A value of `nick-or-mention' works like `nick' but also
+matches \"mentions,\" which `erc-fool-highlight-type' explains in its
+doc string. All values for this option require a matching sender to be
an actual user on the network \(or a bot/service) as opposed to a host
name, such as that of the server itself \(e.g. \"irc.gnu.org\"). When
patterns from other user-based categories \(namely, \\+`fool' and
@@ -135,6 +140,7 @@ erc-pal-highlight-type
\\+`fool'-related invisibility may not survive such collisions.)"
:type '(choice (const nil)
(const nick)
+ (const nick-or-mention)
(const message)
(const all)))
@@ -148,12 +154,12 @@ erc-fool-highlight-type
<speaker> USER: hi.
<speaker> USER, hi.
-However, at present, this option doesn't offer a means of highlighting
-matched mentions alone. See `erc-pal-highlight-type' for a summary of
-possible values and additional details common to categories like
-\\+`fool' that normally match against a message's sender."
+See `erc-pal-highlight-type' for a summary of possible values and
+additional details common to categories like \\+`fool' that normally
+match against a message's sender."
:type '(choice (const nil)
(const nick)
+ (const nick-or-mention)
(const message)
(const all)))
@@ -182,6 +188,7 @@ erc-dangerous-host-highlight-type
normally match against a message's sender."
:type '(choice (const nil)
(const nick)
+ (const nick-or-mention)
(const message)
(const all)))
@@ -267,6 +274,22 @@ erc-match-quote-when-adding
(const t)
(const nil)))
+(defcustom erc-match-functions '(erc-match-opt-pal
+ erc-match-opt-fool
+ erc-match-opt-dangerous-host
+ erc-match-opt-keyword
+ erc-match-opt-current-nick)
+ "Type constructors for \\+`match' processing.
+See the struct `erc-match' as well as Info node `(erc) Match API' for
+details."
+ :package-version '(ERC . "5.7") ; FIXME sync on release
+ :type '(hook :options (erc-match-opt-pal
+ erc-match-opt-fool
+ erc-match-opt-dangerous-host
+ erc-match-opt-keyword
+ erc-match-opt-current-nick)))
+
+
;; Internal variables:
;; This is exactly the same as erc-button-syntax-table. Should we
@@ -322,6 +345,7 @@ erc-add-entry-to-list
LIST must be passed as a symbol
The query happens using PROMPT.
Completion is performed on the optional alist COMPLETIONS."
+ (erc-match--opt-pat-cache-clear-all list)
(let ((entry (completing-read
prompt
completions
@@ -345,6 +369,7 @@ erc-remove-entry-from-list
LIST must be passed as a symbol.
The elements of LIST can be strings, or cons cells where the
car is the string."
+ (erc-match--opt-pat-cache-clear-all list)
(let* ((alist (mapcar (lambda (x)
(if (listp x)
x
@@ -468,7 +493,348 @@ erc-match-directed-at-fool-p
(or (erc-list-match fools-beg msg)
(erc-list-match fools-end msg))))
+(cl-defstruct (erc-match (:constructor erc-match))
+ "Base type for text and user matching performed by the \\+`match' module.
+Users wishing to perform custom matching should add a constructor that
+returns an instance of this type to the hook `erc-match-functions'. If
+the `:predicate' slot's predicate returns non-nil after being called
+with its own instance in the narrowed single-message buffer, ERC calls
+the `:handler' slot's function with the same instance and with the match
+data still intact. More details in Info node `(erc) Match API'."
+ ( predicate (error "Keyword `:predicate' missing") :type function
+ :documentation "Called in narrowed buffer with own instance.")
+ ( spkr-beg nil :type (or null natnum)
+ :documentation "Position of the beginning of speaker's nick, if known.")
+ ( spkr-end nil :type (or null natnum)
+ :documentation "Position of the end of speaker's nick, if known.")
+ ( body-beg (error "Keyword `:body-beg' missing") :type marker
+ :documentation "Marker residing at the beginning of the message body.")
+ ( sender (error "Keyword `:sender' missing") :type string
+ :documentation "The sender's n!u@h.")
+ ( nick nil :type (or null string)
+ :documentation "The sender's nick if they're a user and not the server.")
+ ( command (error "Keyword `:command' missing") :type (or symbol natnum)
+ :documentation "Protocol command or numeric, like `PRIVMSG' or 353.")
+ ( handler #'ignore :type function
+ :documentation "Called on `:predicate' match with own instance."))
+
+(cl-defstruct (erc-match-traditional
+ (:constructor erc-match-traditional)
+ (:include erc-match (handler #'erc-match-highlight)))
+ "Match type for user-option based on \"categories\" and \"parts\".
+The `:category' slot exists for the benefit of `erc-text-matched-hook',
+which receives its value as a second parameter (the hook only runs when
+the slot is non-nil)."
+ ( category (error "Keyword `:category' missing") :type symbol
+ :documentation "Traditional \\+`match' \"category\", like `pal'.")
+ ( face 'erc-default-face :type face
+ :documentation "Face to highlight the matched portion with.")
+ ( part nil :type symbol
+ :documentation "Symbol for the portion of the message to highlight.")
+ ( data nil :type list
+ :documentation "User-specified patterns or other type-specific data."))
+
+(cl-defstruct (erc-match-opt-current-nick
+ (:include erc-match-traditional
+ (category 'current-nick)
+ (predicate #'erc-match--current-nick-p)
+ (part erc-current-nick-highlight-type)
+ (face 'erc-current-nick-face)
+ (data (list (concat "\\b"
+ (regexp-quote (erc-current-nick))
+ "\\b"))))
+ (:constructor erc-match-opt-current-nick))
+ "An options-based type for the `current-nick' category.")
+
+(cl-defstruct (erc-match-opt-keyword
+ (:include erc-match-traditional
+ (category 'keyword)
+ (predicate #'erc-match--keyword-p)
+ (part erc-keyword-highlight-type)
+ (face 'erc-keyword-face)
+ (data erc-keywords))
+ (:constructor erc-match-opt-keyword))
+ "An options-based type for the `keyword' category.")
+
+(cl-defstruct (erc-match-user (:include erc-match-traditional))
+ "An `erc-match' that's only processed when `:nick' is non-nil.")
+
+(cl-defstruct (erc-match-opt-fool
+ (:include erc-match-user
+ (category 'fool)
+ (predicate #'erc-match--user-nuh-or-mention-p)
+ (part erc-fool-highlight-type)
+ (face 'erc-fool-face)
+ (data erc-fools))
+ (:constructor erc-match-opt-fool))
+ "An options-based type for the `fool' category.")
+
+(cl-defstruct (erc-match-opt-pal
+ (:include erc-match-user
+ (category 'pal)
+ (predicate #'erc-match--user-nuh-or-mention-p)
+ (part erc-pal-highlight-type)
+ (face 'erc-pal-face)
+ (data erc-pals))
+ (:constructor erc-match-opt-pal))
+ "An options-based type for the `pal' category.")
+
+(cl-defstruct (erc-match-opt-dangerous-host
+ (:include erc-match-user
+ (category 'dangerous-host)
+ (predicate #'erc-match--user-nuh-or-mention-p)
+ (part erc-dangerous-host-highlight-type)
+ (face 'erc-dangerous-host-face)
+ (data erc-dangerous-hosts))
+ (:constructor erc-match-opt-dangerous-host))
+ "An options-based type for the `dangerous-host' category.")
+
+(defvar erc-match--opt-pat-cache nil
+ "Hash table of computed `regexp-opt' patterns from match-list options.
+Keys are cons cells of (CATEGORY . COMPUTE-FN). Values are
+`erc-match--opt-pat' objects. The table also contains an auxiliary item
+whose key is CATEGORY and whose value is a list of (COMPUTE-FN-1
+COMPUTE-FN-2 ... COMPUTE-FN-N). ERC uses this when clearing the cache
+for CATEGORY.")
+
+(defvar erc-match--opt-pat-ttl 300.0
+ "Seconds to retain cached `regexp-opt' patterns between hits.")
+
+(cl-defstruct erc-match--opt-pat ts in out)
+
+(defun erc-match--opt-pat-cache-clear (base-key)
+ "Remove items for BASE-KEY from `erc-match--opt-pat-cache'."
+ (when-let* ((table erc-match--opt-pat-cache)
+ (keys (gethash base-key table)))
+ (remhash base-key table)
+ (dolist (key keys)
+ (remhash (cons base-key key) table))))
+
+;; FIXME have :set functions of user options also break cache.
+(defun erc-match--opt-pat-cache-clear-all (list-option)
+ "Remove items for LIST-OPTION from `erc-match--opt-pat-cache'."
+ (let ((base-key (pcase-exhaustive list-option
+ ('erc-fools 'fool)
+ ('erc-pals 'pal)
+ ('erc-keywords 'keyword)
+ ('erc-dangerous-hosts 'dangerous-host))))
+ (erc-match--opt-pat-cache-clear base-key)))
+
+(defun erc-match--opt-pat-get (base-key compute-fn input)
+ "Retrieve cached results for computing INPUT with COMPUTE-FN.
+Use BASE-KEY for `erc-match--opt-pat-cache' transactions."
+ (unless erc-match--opt-pat-cache
+ (setq erc-match--opt-pat-cache
+ (make-hash-table :test #'equal)))
+ (if-let* ((key (cons base-key compute-fn))
+ (entry (gethash key erc-match--opt-pat-cache))
+ (ct (erc-current-time))
+ ((> ct (+ (erc-match--opt-pat-ts entry)
+ erc-match--opt-pat-ttl)))
+ ((equal (erc-match--opt-pat-in entry) input)))
+ (progn
+ (setf (erc-match--opt-pat-ts entry) ct)
+ (erc-match--opt-pat-out entry))
+ (let ((output (funcall compute-fn input)))
+ (prog1 output
+ (cl-pushnew compute-fn (gethash base-key erc-match--opt-pat-cache))
+ (puthash key
+ (make-erc-match--opt-pat :ts (or ct (erc-current-time))
+ :in input
+ :out output)
+ erc-match--opt-pat-cache)))))
+
+(defun erc-match--opt-pat-make (patterns)
+ (string-join patterns "\\|"))
+
+(defun erc-match--opt-pat-kw-make (patterns)
+ (mapconcat (lambda (w) (or (car-safe w) w)) patterns "\\|"))
+
+(defun erc-match--opt-pat-addr-beg-make (patterns)
+ (concat "\\<\\(" (erc-match--opt-pat-make patterns) "\\)[:,] "))
+
+(defun erc-match--opt-pat-addr-end-make (patterns)
+ (concat "\\s. \\(" (erc-match--opt-pat-make patterns) "\\)\\s."))
+
+(defun erc-match--current-nick-p (instance)
+ (re-search-forward (car (erc-match-traditional-data instance)) nil t))
+
+(defun erc-match--keyword-p (instance)
+ (and-let* ((patterns (erc-match-traditional-data instance))
+ (regexp (erc-match--opt-pat-get
+ (erc-match-traditional-category instance)
+ #'erc-match--opt-pat-kw-make patterns)))
+ (goto-char (erc-match-body-beg instance))
+ (re-search-forward regexp nil t)))
+
+(defun erc-match--user-nuh-or-mention-p (instance)
+ "Return non-nil on NUH match for `erc-match' INSTANCE.
+Also do so on mentions if the category is `fool' or the corresponding
+\"part\" option is `nick-or-mention'."
+ (and-let* ((patterns (erc-match-traditional-data instance))
+ (category (erc-match-traditional-category instance)))
+ (or (string-match (erc-match--opt-pat-get
+ category #'erc-match--opt-pat-make patterns)
+ (erc-match-sender instance))
+ (and (or (eq category 'fool)
+ (eq (erc-match-traditional-part instance) 'nick-or-mention))
+ ;; Mimic `erc-match-directed-at-fool-p', but search
+ ;; the narrowed buffer instead of a string argument.
+ (goto-char (erc-match-body-beg instance))
+ (or (looking-at (erc-match--opt-pat-get
+ category #'erc-match--opt-pat-addr-beg-make
+ patterns))
+ (search-forward-regexp
+ (erc-match--opt-pat-get
+ category #'erc-match--opt-pat-addr-end-make patterns)
+ nil t))))))
+
+(cl-defgeneric erc-match-highlight-by-part (instance part)
+ "Highlight PART of narrowed buffer for `erc-match' INSTANCE.")
+
+(cl-defmethod erc-match-highlight-by-part ((instance erc-match-traditional)
+ (_ (eql nick)))
+ "Highlight nick in the bracketed speaker portion of the message."
+ (when (erc-match-spkr-beg instance)
+ (erc-put-text-property (erc-match-spkr-beg instance)
+ (erc-match-spkr-end instance)
+ 'font-lock-face
+ (erc-match-traditional-face instance))))
+
+(cl-defmethod erc-match-highlight-by-part ((instance erc-match-traditional)
+ (_ (eql message)))
+ "Highlight the message body, not including the leading speaker tag."
+ (erc-put-text-property (erc-match-body-beg instance) (point-max)
+ 'font-lock-face
+ (erc-match-traditional-face instance)))
+
+(cl-defmethod erc-match-highlight-by-part ((instance erc-match-traditional)
+ (_ (eql all)))
+ "Highlight the whole message, including the speaker tag."
+ (erc-put-text-property (point-min) (point-max)
+ 'font-lock-face
+ (erc-match-traditional-face instance)))
+
+(cl-defmethod erc-match-highlight-by-part ((instance erc-match-traditional)
+ (_ (eql keyword)))
+ "Highlight all occurrences of all keyword patterns."
+ (dolist (pat (erc-match-traditional-data instance))
+ (let ((regex (if (consp pat) (car pat) pat))
+ (face (if (consp pat)
+ (cdr pat)
+ (erc-match-traditional-face instance))))
+ (goto-char (erc-match-body-beg instance))
+ (while (re-search-forward regex nil t)
+ (erc-put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-face face)))))
+
+(cl-defmethod erc-match-highlight-by-part ((instance erc-match-traditional)
+ (_ (eql nick-or-keyword)))
+ "Highlight speaker-tag nick of matching users, otherwise all mentions."
+ (if (erc-match-spkr-end instance)
+ (erc-put-text-property (erc-match-spkr-beg instance)
+ (erc-match-spkr-end instance)
+ 'font-lock-face
+ (erc-match-traditional-face instance))
+ (erc-match-highlight-by-part instance 'keyword)))
+
+(cl-defmethod erc-match-highlight-by-part ((instance erc-match-traditional)
+ (_ (eql nick-or-mention)))
+ "Highlight speaker-tag nick of matching users or all mentions."
+ (let ((body-beg (erc-match-body-beg instance)))
+ (setf (erc-match-body-beg instance)
+ (or (erc-match-spkr-beg instance) (point-min)))
+ (erc-match-highlight-by-part instance 'keyword)
+ (setf (erc-match-body-beg instance) body-beg)))
+
+(defvar erc-match-highlight-matched nil
+ "Matched `erc-match' instance in `erc-text-matched-hook'.")
+
+(defun erc-match-highlight (instance)
+ "Dispatch `erc-match-highlight-by-part' on INSTANCE's `:part' slot.
+Run `erc-text-matched-hook' when INSTANCE's `category' slot is non-nil."
+ (unless (erc-match-traditional-p instance)
+ (signal 'wrong-type-argument (list 'erc-match-traditional instance)))
+ (erc-match-highlight-by-part instance (erc-match-traditional-part instance))
+ (when (erc-match-traditional-category instance)
+ (let ((user-nuh (and (erc-match-nick instance)
+ (erc-match-sender instance)))
+ (erc-match-highlight-matched instance))
+ (run-hook-with-args 'erc-text-matched-hook
+ (erc-match-traditional-category instance)
+ (or user-nuh (format "Server:%s"
+ (erc-match-command instance)))
+ ;; For compatibility, include a leading "*** ".
+ (buffer-substring (if user-nuh
+ (erc-match-body-beg instance)
+ (point-min))
+ (point-max))))))
+
+(defun erc-match-get-message-body (instance)
+ "Return the message body in the narrowed buffer for match INSTANCE."
+ (buffer-substring (erc-match-body-beg instance) (1- (point-max))))
+
+(defun erc-match--run-match (constructor spkr-beg spkr-end body-beg
+ nick sender command)
+ "Run :handler for for `erc-match' instance if :predicate returns non-nil.
+Call CONSTRUCTOR with SPKR-BEG, SPKR-END, BODY-BEG, NICK SENDER, and
+COMMAND to create said instance."
+ (when-let* ((instance (funcall constructor
+ :spkr-beg spkr-beg
+ :spkr-end spkr-end
+ :body-beg body-beg
+ :nick nick
+ :sender sender
+ :command command))
+ ((or nick (not (erc-match-user-p instance))))
+ ((goto-char (point-min)))
+ ((funcall (erc-match-predicate instance) instance)))
+ (funcall (erc-match-handler instance) instance)
+ nil))
+
+(defun erc-match--message ()
+ "Highlight matches in narrowed buffer's current message."
+ (goto-char (point-min))
+ (let* ((response erc--parsed-response)
+ ;; Sender has a valid (non-domain) nickname of a likely user.
+ (user-nuh (and response (erc-get-parsed-vector-nick response)))
+ (nick (and user-nuh (or (erc--check-msg-prop 'erc--spkr)
+ (erc-extract-nick user-nuh))))
+ (spkr-end (and nick (erc--get-speaker-bounds)))
+ (spkr-beg (and spkr-end (pop spkr-end)))
+ (body-beg (copy-marker
+ (cond (erc--offset-marker
+ (marker-position erc--offset-marker))
+ (spkr-end
+ (save-excursion (goto-char spkr-end)
+ (skip-syntax-forward "^-")
+ (skip-syntax-forward "-")
+ (point)))
+ ((point-min)))))
+ (command (erc--check-msg-prop 'erc--cmd)))
+ (with-syntax-table erc-match-syntax-table
+ (run-hook-wrapped 'erc-match-functions #'erc-match--run-match
+ spkr-beg spkr-end body-beg nick
+ (erc-response.sender response) command))
+ (when (and erc--offset-marker (/= body-beg erc--offset-marker))
+ (setq erc--offset-marker body-beg))))
+
+(defvar erc-match-use-legacy-logic-p nil
+ "When non-nil, use the non-`erc-match' variant of `erc-match-message'.")
+(make-obsolete 'erc-match-use-legacy-logic-p
+ "non-nil behavior is missing features and integrations" "31.1")
+
(defun erc-match-message ()
+ "Highlight matched portions of the narrowed buffer."
+ (if (or erc-match-use-legacy-logic-p (null erc--parsed-response))
+ (erc-match--message-legacy)
+ (unless (or (and erc-match-exclude-server-buffer (erc--server-buffer-p))
+ (null (erc--check-msg-prop 'erc--cmd))
+ (erc--check-msg-prop 'erc--echo)
+ (erc--memq-msg-prop 'erc--skip 'match))
+ (erc-match--message))))
+
+(defun erc-match--message-legacy ()
"Mark certain keywords in a region.
Use this defun with `erc-insert-modify-hook'."
;; This needs some refactoring.
@@ -591,27 +957,25 @@ erc-log-matches
Specify the match types which should be logged in the former,
and deactivate/activate match logging in the latter.
See `erc-log-match-format'."
- (let ((match-buffer-name (cdr (assq match-type
- erc-log-matches-types-alist)))
- (nick (nth 0 (erc-parse-user nickuserhost))))
- (when (and
- (or (eq erc-log-matches-flag t)
- (and (eq erc-log-matches-flag 'away)
- (erc-away-time)))
- match-buffer-name)
- (let ((line (format-spec
- erc-log-match-format
- `((?n . ,nick)
- (?t . ,(format-time-string
- (or (bound-and-true-p erc-timestamp-format)
- "[%Y-%m-%d %H:%M] ")))
- (?c . ,(or (erc-default-target) ""))
- (?m . ,message)
- (?u . ,nickuserhost)))))
- (with-current-buffer (erc-log-matches-make-buffer match-buffer-name)
- (let ((inhibit-read-only t))
- (goto-char (point-max))
- (insert line)))))))
+ (when-let*
+ ((erc-log-matches-flag)
+ ((or (eq erc-log-matches-flag t) (erc-away-time)))
+ (match-buffer-name (cdr (assq match-type erc-log-matches-types-alist)))
+ (line (format-spec
+ erc-log-match-format
+ (erc-compat--defer-format-spec-in-buffer
+ (?n . (or (erc--check-msg-prop 'erc--spkr)
+ (erc-extract-nick nickuserhost)))
+ (?t . (format-time-string
+ (or (bound-and-true-p erc-timestamp-format)
+ "[%Y-%m-%d %H:%M] ")))
+ (?c erc-default-target)
+ (?m . message)
+ (?u . nickuserhost)))))
+ (with-current-buffer (erc-log-matches-make-buffer match-buffer-name)
+ (with-silent-modifications
+ (goto-char (point-max))
+ (insert line)))))
(defun erc-log-matches-make-buffer (name)
"Create or get a log-matches buffer named NAME and return it."
diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el
index fb92a153c95..0b90867b32d 100644
--- a/test/lisp/erc/erc-match-tests.el
+++ b/test/lisp/erc/erc-match-tests.el
@@ -242,8 +242,9 @@ erc-match-tests--assert-speaker-only-highlighted
(defun erc-match-tests--perform (test)
(erc-tests-common-make-server-buf)
(setq erc-server-current-nick "tester")
- (with-current-buffer (erc--open-target "#chan")
- (funcall test))
+ (let (erc-match--opt-pat-cache)
+ (with-current-buffer (erc--open-target "#chan")
+ (funcall test)))
(when noninteractive
(erc-tests-common-kill-buffers)))
@@ -337,6 +338,77 @@ erc-match-message/dangerous-host/nick
(let ((erc-dangerous-hosts (list "bob")))
(erc-match-tests--hl-type-nick 'erc-dangerous-host-face)))
+(ert-deftest erc-match-message/pal/nick/legacy ()
+ (should (eq erc-pal-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-pals (list "bob")))
+ (erc-match-tests--hl-type-nick 'erc-pal-face))))
+
+(ert-deftest erc-match-message/fool/nick/legacy ()
+ (should (eq erc-fool-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-fools (list "bob")))
+ (erc-match-tests--hl-type-nick/mention 'erc-fool-face))))
+
+(ert-deftest erc-match-message/dangerous-host/nick/legacy ()
+ (should (eq erc-dangerous-host-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-dangerous-hosts (list "bob")))
+ (erc-match-tests--hl-type-nick 'erc-dangerous-host-face))))
+
+;; Mentions are treated as keywords, even in the speaker portion.
+;; Contrast this with `erc-match-tests--hl-type-nick/mention', where the
+;; speakers are highlighted despite "mention" matches occurring in the
+;; message body.
+(defun erc-match-tests--hl-type-nick-or-mention (face)
+ (erc-match-tests--hl-type-nick
+ face
+ (lambda ()
+ (erc-tests-common-simulate-privmsg "alice" "bob: one bob ONE")
+ (erc-tests-common-simulate-privmsg "alice" "bob, two")
+ (erc-tests-common-simulate-privmsg "alice" "three, bob.")
+
+ (search-forward "<alice> bob: one")
+ (goto-char (pos-bol))
+ (erc-match-tests--assert-face-absent face "bob: one")
+ (erc-match-tests--assert-face-present face ": one ")
+ (erc-match-tests--assert-face-absent face "bob ONE")
+ (erc-match-tests--assert-face-present face " ONE")
+ (erc-match-tests--assert-face-absent face (pos-eol))
+
+ (search-forward "<alice> bob, two")
+ (goto-char (pos-bol))
+ (erc-match-tests--assert-face-absent face "bob, two")
+ (erc-match-tests--assert-face-present face ", two")
+ (erc-match-tests--assert-face-absent face (pos-eol))
+
+ (search-forward "<alice> three, bob.")
+ (goto-char (pos-bol))
+ (erc-match-tests--assert-face-absent face "bob.")
+ (erc-match-tests--assert-face-present face ".")
+ (erc-match-tests--assert-face-absent face (pos-eol)))))
+
+(ert-deftest erc-match-message/pal/nick-or-mention ()
+ (should (eq erc-pal-highlight-type 'nick))
+ (let ((erc-pal-highlight-type 'nick-or-mention)
+ (erc-pals (list "bob")))
+ (erc-match-tests--hl-type-nick-or-mention 'erc-pal-face)))
+
+(ert-deftest erc-match-message/fool/nick-or-mention ()
+ (should (eq erc-fool-highlight-type 'nick))
+ (let ((erc-fool-highlight-type 'nick-or-mention)
+ (erc-fools (list "bob")))
+ (erc-match-tests--hl-type-nick-or-mention 'erc-fool-face)))
+
+(ert-deftest erc-match-message/dangerous-host/nick-or-mention ()
+ (should (eq erc-dangerous-host-highlight-type 'nick))
+ (let ((erc-dangerous-host-highlight-type 'nick-or-mention)
+ (erc-dangerous-hosts (list "bob")))
+ (erc-match-tests--hl-type-nick-or-mention 'erc-dangerous-host-face)))
+
(defun erc-match-tests--hl-type-message (face)
(should (eq erc-current-nick-highlight-type 'keyword))
(should (eq erc-keyword-highlight-type 'keyword))
@@ -402,6 +474,30 @@ erc-match-message/dangerous-host/message
(erc-dangerous-host-highlight-type 'message))
(erc-match-tests--hl-type-message 'erc-dangerous-host-face)))
+(ert-deftest erc-match-message/pal/message/legacy ()
+ (should (eq erc-pal-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-pals (list "bob"))
+ (erc-pal-highlight-type 'message))
+ (erc-match-tests--hl-type-message 'erc-pal-face))))
+
+(ert-deftest erc-match-message/fool/message/legacy ()
+ (should (eq erc-fool-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-fools (list "bob"))
+ (erc-fool-highlight-type 'message))
+ (erc-match-tests--hl-type-message 'erc-fool-face))))
+
+(ert-deftest erc-match-message/dangerous-host/message/legacy ()
+ (should (eq erc-dangerous-host-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-dangerous-hosts (list "bob"))
+ (erc-dangerous-host-highlight-type 'message))
+ (erc-match-tests--hl-type-message 'erc-dangerous-host-face))))
+
(defun erc-match-tests--hl-type-all (face)
(should (eq erc-current-nick-highlight-type 'keyword))
(should (eq erc-keyword-highlight-type 'keyword))
@@ -467,6 +563,30 @@ erc-match-message/dangerous-host/all
(erc-dangerous-host-highlight-type 'all))
(erc-match-tests--hl-type-all 'erc-dangerous-host-face)))
+(ert-deftest erc-match-message/pal/all/legacy ()
+ (should (eq erc-pal-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-pals (list "bob"))
+ (erc-pal-highlight-type 'all))
+ (erc-match-tests--hl-type-all 'erc-pal-face))))
+
+(ert-deftest erc-match-message/fool/all/legacy ()
+ (should (eq erc-fool-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-fools (list "bob"))
+ (erc-fool-highlight-type 'all))
+ (erc-match-tests--hl-type-all 'erc-fool-face))))
+
+(ert-deftest erc-match-message/dangerous-host/all/legacy ()
+ (should (eq erc-dangerous-host-highlight-type 'nick))
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t)
+ (erc-dangerous-hosts (list "bob"))
+ (erc-dangerous-host-highlight-type 'all))
+ (erc-match-tests--hl-type-all 'erc-dangerous-host-face))))
+
(defun erc-match-tests--hl-type-nick-or-keyword ()
(should (eq erc-current-nick-highlight-type 'keyword))
@@ -511,6 +631,11 @@ erc-match-tests--hl-type-nick-or-keyword
(ert-deftest erc-match-message/current-nick/nick-or-keyword ()
(erc-match-tests--hl-type-nick-or-keyword))
+(ert-deftest erc-match-message/current-nick/nick-or-keyword/legacy ()
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t))
+ (erc-match-tests--hl-type-nick-or-keyword))))
+
(defun erc-match-tests--hl-type-keyword ()
(should (eq erc-keyword-highlight-type 'keyword))
@@ -567,6 +692,11 @@ erc-match-tests--hl-type-keyword
(ert-deftest erc-match-message/keyword/keyword ()
(erc-match-tests--hl-type-keyword))
+(ert-deftest erc-match-message/keyword/keyword/legacy ()
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t))
+ (erc-match-tests--hl-type-keyword))))
+
(defun erc-match-tests--log-matches ()
(let ((erc-log-matches-flag t)
(erc-timestamp-format "[@@TS@@]")
@@ -589,5 +719,85 @@ erc-match-tests--log-matches
(ert-deftest erc-log-matches ()
(erc-match-tests--log-matches))
+(ert-deftest erc-log-matches/legacy ()
+ (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete))
+ (let ((erc-match-use-legacy-logic-p t))
+ (erc-match-tests--log-matches))))
+
+;; This demos bare-bones usage of the `erc-match' API that implicitly
+;; opts out of the traditional options and "parts"-based mechanism. The
+;; user does not have to provide a `:part' keyword because they've
+;; overridden the `:handler', meaning `erc-match-highlight-by-part'
+;; never runs. This is somewhat analogous but ultimately orthogonal to
+;; `erc-text-matched-hook' not running because that happens on account
+;; of the user not specifying a `:category' field.
+(ert-deftest erc-match-functions/api/non-parts-based ()
+ (let* ((results ())
+ (erc-text-matched-hook (lambda (&rest r) (push r results)))
+ (erc-match-functions
+ (list
+ (lambda (&rest plist)
+ ;; Doing everything in `:pred' would also work if
+ ;; specifying `ignore' for `:handler'. And you wouldn't
+ ;; even need to return non-nil on matches.
+ (apply #'erc-match
+ :predicate (lambda (_) (search-forward "alice" nil t))
+ :handler (lambda (_) (push (match-string 0) results))
+ plist)))))
+
+ (erc-match-tests--perform
+ (lambda ()
+ (erc-tests-common-add-cmem "bob")
+ (erc-tests-common-add-cmem "Alice")
+ (erc-tests-common-simulate-line
+ ":irc.foonet.org 353 tester = #chan :bob tester Alice")
+ (erc-tests-common-simulate-line
+ ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (erc-tests-common-simulate-privmsg "bob" "hi ALICE")
+ (goto-char (point-min))
+
+ (should (equal results '("ALICE" "Alice")))))))
+
+;; This one piggybacks on infrastructure supporting the traditional
+;; `match' interface.
+(ert-deftest erc-match-functions/api/parts-based ()
+ (let* ((results ())
+ (erc-text-matched-hook (lambda (&rest r) (push r results)))
+ (erc-match-functions ()))
+
+ (erc-match-tests--perform
+ (lambda ()
+
+ ;; Use local setter for no particular reason.
+ (add-hook 'erc-match-functions
+ (lambda (&rest plist)
+ (apply #'erc-match-traditional
+ :category 'keyword
+ :part 'keyword
+ :data '("alice")
+ :face 'error
+ :predicate (lambda (_)
+ (search-forward "alice" nil t))
+ plist))
+ 0 t)
+
+ (erc-tests-common-add-cmem "bob")
+ (erc-tests-common-add-cmem "Alice")
+ (erc-tests-common-simulate-line
+ ":irc.foonet.org 353 tester = #chan :Alice bob tester")
+ (erc-tests-common-simulate-line
+ ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (erc-tests-common-simulate-privmsg "bob" "hi ALICE")
+ (goto-char (point-min))
+
+ (search-forward "*** Users on #chan:")
+ (erc-match-tests--assert-face-absent 'error "Alice")
+ (erc-match-tests--assert-face-present 'error " bob")
+ (erc-match-tests--assert-face-absent 'error (pos-eol))
+
+ (should (equal results
+ '(( keyword "bob!~bob@fsf.org" "hi ALICE\n")
+ ( keyword "Server:353"
+ "*** Users on #chan: Alice bob tester\n"))))))))
;;; erc-match-tests.el ends here
--
2.46.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.7-Use-erc-match-type-API-for-erc-desktop-notificat.patch --]
[-- Type: text/x-patch, Size: 13344 bytes --]
From af5dd1ceb407c445bfa6f27ec737f989329bbdc4 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 12 Oct 2024 17:44:30 -0700
Subject: [PATCH 3/3] [5.7] Use erc-match-type API for
erc-desktop-notifications
* etc/ERC-NEWS: New section for 5.7 and new entries for the
`erc-match-type' API and `erc-notifications-focused-context' option.
* lisp/erc/erc-desktop-notifications.el
(erc-notifications-focused-contexts): New option.
(erc-notifications-notify): Address ancient comment regarding PRIVP
parameter possibly being unneeded when the current target matches the
nick.
(erc-notifications-PRIVMSG): Deprecate.
(erc-notifications-notify-on-match): Account for new option.
(erc-notifications-mode)
(erc-notifications-enable, erc-notifications-disable): Instead of the
"PRIVMSG" response-handler hook, use the `erc-match-type' API.
(erc-desktop-notifications--setup): New function
(erc-desktop-notifications-match-query-commands): New variable.
(erc-desktop-notifications--match-type-query): New struct type.
(erc-desktop-notifications--query-p): New function.
(erc-desktop-notification--query-notify): New function.
* test/lisp/erc/erc-desktop-notifications-tests.el: New file.
---
etc/ERC-NEWS | 22 ++++
lisp/erc/erc-desktop-notifications.el | 69 +++++++++--
.../erc/erc-desktop-notifications-tests.el | 115 ++++++++++++++++++
3 files changed, 198 insertions(+), 8 deletions(-)
create mode 100644 test/lisp/erc/erc-desktop-notifications-tests.el
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 3970f67d725..4b85b652cb7 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -11,6 +11,28 @@ This file is about changes in ERC, the powerful, modular, and
extensible IRC (Internet Relay Chat) client distributed with
GNU Emacs since Emacs version 22.1.
+\f
+* Changes in ERC 5.7
+
+** An extensibility focused 'match' API.
+Users have often expressed frustration over ERC's lack of a simple API
+for matching, highlighting, and filtering based on a message's content
+and metadata, like the sender or associated IRC command. While it's
+true that discussions have been ongoing for a more powerful message
+formatting and construction API that will hopefully one day offer access
+to the various parts of a message before they're assembled, users will
+be needing something practical and effective in the interim. Enter the
+'erc-match-type' API, which is based on a simple hook-like handler
+system. You subscribe by enrolling a function that takes a special
+'erc-match-type' object with useful fields to help with matching,
+filtering, and applying faces. See Info node 'Match API' to find out
+more.
+
+** Opt out of desktop notifications from the active buffer.
+Option 'erc-notifications-focused-contexts' can help spare you from
+seeing desktop alerts for messages you're reading or those inserted
+while you're typing.
+
\f
* Changes in ERC 5.6.1
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 9bb89fbfc81..2d605ced5f5 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -47,6 +47,11 @@ erc-notifications-icon
"Icon to use for notification."
:type '(choice (const :tag "No icon" nil) file))
+(defcustom erc-notifications-focused-contexts '(query mention)
+ "Where to notify even if a match appears in the selected window."
+ :package-version '(ERC . "5.7") ; FIXME sync on release
+ :type '(set (const query) (const mention)))
+
(defcustom erc-notifications-bus :session
"D-Bus bus to use for notification."
:version "25.1"
@@ -60,12 +65,15 @@ dbus-debug
(defun erc-notifications-notify (nick msg &optional privp)
"Notify that NICK send some MSG, where PRIVP should be non-nil for PRIVMSGs.
This will replace the last notification sent with this function."
- ;; TODO: can we do this without PRIVP? (by "fixing" ERC's not
- ;; setting the current buffer to the existing query buffer)
(dbus-ignore-errors
(setq erc-notifications-last-notification
- (let* ((channel (if privp (erc-get-buffer nick) (current-buffer)))
- (title (format "%s in %s" (xml-escape-string nick t) channel))
+ (let* ((channel (or (and privp (not (equal nick (erc-target)))
+ (erc-get-buffer nick))
+ (current-buffer)))
+ (title (if (or privp (equal nick (erc-target)))
+ (xml-escape-string nick t)
+ (format "%s in %s"
+ (xml-escape-string nick t) channel)))
(body (xml-escape-string (erc-controls-strip msg) t)))
(funcall (cond ((featurep 'android)
#'android-notifications-notify)
@@ -82,6 +90,7 @@ erc-notifications-notify
(pop-to-buffer channel)))))))
(defun erc-notifications-PRIVMSG (_proc parsed)
+ (declare (obsolete "switched to `erc-match-type' API" "31.1"))
(let ((nick (car (erc-parse-user (erc-response.sender parsed))))
(target (car (erc-response.command-args parsed)))
(msg (erc-response.contents parsed)))
@@ -97,20 +106,64 @@ erc-notifications-notify-on-match
(when (eq match-type 'current-nick)
(let ((nick (nth 0 (erc-parse-user nickuserhost))))
(unless (or (string-match-p "^Server:" nick)
- (when (boundp 'erc-track-exclude)
- (member nick erc-track-exclude)))
+ (and (eq (current-buffer) (window-buffer))
+ (frame-focus-state) ; t or unknown
+ (not (memq 'mention
+ erc-notifications-focused-contexts)))
+ (and (boundp 'erc-track-exclude)
+ (member nick erc-track-exclude)))
(erc-notifications-notify nick msg)))))
;;;###autoload(autoload 'erc-notifications-mode "erc-desktop-notifications" "" t)
(define-erc-module notifications nil
"Send notifications on private message reception and mentions."
;; Enable
- ((add-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG)
+ ((unless erc--updating-modules-p
+ (erc-buffer-do #'erc-desktop-notifications--setup))
+ (add-hook 'erc-mode-hook #'erc-desktop-notifications--setup)
(add-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match))
;; Disable
- ((remove-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG)
+ ((erc-buffer-do #'erc-desktop-notifications--setup)
(remove-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match)))
+(defun erc-desktop-notifications--setup ()
+ (if erc-notifications-mode
+ (add-hook 'erc-match-functions
+ #'erc-desktop-notifications--match-type-query 0 t)
+ (remove-hook 'erc-match-functions
+ #'erc-desktop-notifications--match-type-query t)))
+
+(defvar erc-desktop-notifications-match-query-commands '(PRIVMSG)
+ "IRC commands considered in query buffers for notification.
+Omits \"NOTICE\"s by default because they're typically reserved for bots
+and services that you interact with directly.")
+
+(cl-defstruct (erc-desktop-notifications--match-type-query
+ (:constructor erc-desktop-notifications--match-type-query)
+ (:include erc-match-user
+ (category nil)
+ (data erc-desktop-notifications-match-query-commands)
+ (predicate #'erc-desktop-notifications--query-p)
+ (handler #'erc-desktop-notifications--query-notify)))
+ "Notification match type for queries.")
+
+(defun erc-desktop-notifications--query-p (match)
+ "Return non-nil if MATCH object describes a \"PRIVMSG\" query."
+ (and (erc-query-buffer-p)
+ (or (memq 'query erc-notifications-focused-contexts)
+ (null (frame-focus-state))
+ (not (eq (current-buffer) (window-buffer))))
+ (memq (erc-match-command match) (erc-match-user-data match))
+ (always (cl-assert (erc-match-nick match)))
+ (not (and (boundp 'erc-track-exclude)
+ (member (erc-target) erc-track-exclude)))))
+
+(defun erc-desktop-notifications--query-notify (match)
+ ;; No need to pass argument PRIVP because current buffer is correct.
+ (erc-notifications-notify (erc-target)
+ (erc-match-get-message-body match)))
+
+
(provide 'erc-desktop-notifications)
;;; erc-desktop-notifications.el ends here
diff --git a/test/lisp/erc/erc-desktop-notifications-tests.el b/test/lisp/erc/erc-desktop-notifications-tests.el
new file mode 100644
index 00000000000..5a9ad0ff5ba
--- /dev/null
+++ b/test/lisp/erc/erc-desktop-notifications-tests.el
@@ -0,0 +1,115 @@
+;;; erc-desktop-notifications-tests.el --- Notifications tests -*- lexical-binding:t -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;; Code:
+(require 'erc-desktop-notifications)
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-tests-common)))
+
+(defun erc-desktop-notifications-tests--perform (test)
+ (erc-tests-common-make-server-buf)
+ (erc-notifications-mode +1)
+ (setq erc-server-current-nick "tester")
+
+ (cl-letf* ((calls nil)
+ ((frame-parameter nil 'last-focus-update)
+ t)
+ ((symbol-function 'erc-notifications-notify)
+ (lambda (&rest r) (push r calls))))
+ (with-current-buffer (erc--open-target "#chan")
+ (funcall test (lambda () (prog1 calls (setq calls nil))))))
+
+ (when noninteractive
+ (erc-notifications-mode -1)
+ (erc-tests-common-kill-buffers)))
+
+(defun erc-desktop-notifications-tests--populate-chan (test)
+ (erc-desktop-notifications-tests--perform
+ (lambda (check)
+ (erc-tests-common-add-cmem "bob")
+ (erc-tests-common-add-cmem "alice")
+
+ (erc-tests-common-simulate-line
+ ":irc.foonet.org 353 tester = #chan :alice bob tester")
+ (erc-tests-common-simulate-line
+ ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (erc-tests-common-simulate-privmsg "bob" "hi tester")
+
+ (should (equal (current-buffer) (get-buffer "#chan")))
+ (should (not (eq (current-buffer) (window-buffer)))) ; *ert* or *scratch*
+ (funcall test check))))
+
+(ert-deftest erc-notifications-focused-contexts/default ()
+ (should (equal erc-notifications-focused-contexts '(query mention)))
+
+ (erc-desktop-notifications-tests--populate-chan
+ (lambda (check)
+
+ ;; A private query triggers a notification.
+ (erc-tests-common-simulate-line ":bob!~bob@fsf.org PRIVMSG tester yo")
+ (should (eq (current-buffer) (get-buffer "bob")))
+
+ ;; A NOTICE command doesn't trigger a notification because it's
+ ;; absent from `erc-desktop-notifications-match-query-commands'.
+ (erc-tests-common-simulate-line ":irc.foonet.org NOTICE tester nope")
+
+ (should (equal (funcall check)
+ '(("bob" "yo")
+ ("bob" "hi tester\n"))))
+
+ ;; Setting the window to the buffer where insertions are happening
+ ;; makes no difference: notifications are still sent.
+ (erc-tests-common-simulate-line ":bob!~bob@fsf.org PRIVMSG tester ho")
+
+ (set-window-buffer nil (set-buffer "#chan"))
+ (erc-tests-common-simulate-privmsg "alice" "hi tester")
+
+ (should (equal (funcall check)
+ '(("alice" "hi tester\n")
+ ("bob" "ho")))))))
+
+(ert-deftest erc-notifications-focused-contexts/unselected ()
+ (should (equal erc-notifications-focused-contexts '(query mention)))
+
+ (let ((erc-notifications-focused-contexts))
+
+ (erc-desktop-notifications-tests--populate-chan
+ (lambda (check)
+ (should (equal (funcall check) '(("bob" "hi tester\n"))))
+
+ ;; Buffer #chan is current and displayed in the selected window,
+ ;; so no notification is sent.
+ (set-window-buffer nil "#chan") ; #chan
+ (erc-tests-common-simulate-privmsg "alice" "hi tester")
+
+ ;; A new query comes in for a buffer that doesn't exist. The
+ ;; option `erc-receive-query-display' tells ERC to switch to that
+ ;; buffer and show it before insertion. Therefore, no
+ ;; notification is sent.
+ (let ((erc-receive-query-display 'buffer))
+ (erc-tests-common-simulate-line
+ ":bob!~bob@fsf.org PRIVMSG tester yo"))
+
+ (should-not (funcall check))))))
+
+;;; erc-desktop-notifications-tests.el ends here
--
2.46.2
next prev parent reply other threads:[~2024-11-01 13:39 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <87y12rifv2.fsf@neverwas.me>
2024-10-25 23:48 ` bug#73798: 31.0.50; ERC 5.7: New extensibility focused match API J.P.
[not found] ` <87froj4ude.fsf@neverwas.me>
2024-10-25 23:50 ` J.P.
2024-11-01 5:22 ` J.P.
[not found] ` <87ldy3v87y.fsf@neverwas.me>
2024-11-01 13:39 ` J.P. [this message]
2024-10-14 2:21 J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87h68rrs3o.fsf__9524.09048784233$1730468446$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=73798@debbugs.gnu.org \
--cc=emacs-erc@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).