master 5d3fadb2478 6/9: Use erc-match API for erc-desktop-notifications

branch: master
commit 5d3fadb2478af116972f65e777796d0ea96a3773
Author: F. Jason Park <[email protected]>
Commit: F. Jason Park <[email protected]>

    Use erc-match API for erc-desktop-notifications
    
    * etc/ERC-NEWS: New entries for the `erc-match' API and notification
    options.
    * lisp/erc/erc-desktop-notifications.el
    (erc-desktop-notifications-ignored-when-focused): New option.
    (erc-desktop-notifications-skip-predicates): 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-desktop-notifications-untracked-p, erc-desktop-notifications-fool-p)
    (erc-desktop-notifications-focused-p): New functions for
    `erc-desktop-notifications-skip-predicates'.
    (erc-notifications-notify-on-match): Account for new options, and use
    new `erc-match' API.
    (erc-notifications-mode, erc-notifications-enable)
    (erc-notifications-disable): Instead of the "PRIVMSG" response-handler
    hook, use the `erc-match' API.
    (erc-desktop-notifications--setup): New function.
    (erc-desktop-notifications--query-NOTICE-p): New variable.
    (erc-desktop-notifications-match-query): New struct type.
    (erc-desktop-notifications--query-p): New function.
    (erc-desktop-notifications--query-notify): New function.
    * test/lisp/erc/erc-desktop-notifications-tests.el: New
    file.  (Bug#73798)
---
 etc/ERC-NEWS                                     |  20 ++++
 lisp/erc/erc-desktop-notifications.el            | 134 +++++++++++++++++++---
 lisp/erc/erc-match.el                            |   2 +-
 test/lisp/erc/erc-desktop-notifications-tests.el | 139 +++++++++++++++++++++++
 4 files changed, 276 insertions(+), 19 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index d28c0670a73..2088345f97e 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -14,6 +14,26 @@ GNU Emacs since Emacs version 22.1.
 
 * Changes in ERC 5.7
 
+** A flexible 'match' API.
+To the frustration many, ERC has long lacked of a flexible API for
+reacting to a message's contents and envelope info, like its sender and
+associated IRC command.  While the long-term plan is to transition to an
+object-based formatting model that should offer more useful access to
+the various parts of a message before they're assembled, it's become
+obvious that users need something practical in the interim.  This
+'match' API is based on a simple hook-like handler system that offers
+more opportunities for things like filtering and styling.  See Info node
+'Match API' to find out more.
+
+** Exercise more control in skipping certain desktop notifications.
+Skip select notifications that ERC would otherwise emit with new hook
+option 'erc-desktop-notifications-skip-predicates'.  Its default members
+skip messages from "fools" and those in untracked buffers.
+
+** Opt out of desktop notifications from the active buffer.
+Option 'erc-desktop-notifications-ignored-when-focused' can spare users
+from being notified when interacting with the initiating buffer.
+
 ** Changes in the library API.
 
 *** Module setup runs in query buffers on reconnect.
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index e4a62c614a4..a3b728a5e53 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -47,6 +47,28 @@
   "Icon to use for notification."
   :type '(choice (const :tag "No icon" nil) file))
 
+(defcustom erc-desktop-notifications-ignored-when-focused ()
+  "Contexts in which to suppress notification in the selected window.
+Assumes `erc-desktop-notifications-focused-p' is a member of
+`erc-desktop-notifications-skip-predicates'.  If the option's value
+contains the symbol `query', ERC skips all notifications in focused
+query buffers.  And if it contains `mention', ERC skips notifications
+upon mention of the user's nick in a focused channel buffer."
+  :package-version '(ERC . "5.7")
+  :type '(set (const query) (const mention)))
+
+(defcustom erc-desktop-notifications-skip-predicates
+  '(erc-desktop-notifications-focused-p
+    erc-desktop-notifications-untracked-p
+    erc-desktop-notifications-fool-p)
+  "Abnormal hook whose members return non-nil to suppress notification.
+Called in match buffer with a matching `erc-match-user' object."
+  :options '(erc-desktop-notifications-focused-p
+             erc-desktop-notifications-untracked-p
+             erc-desktop-notifications-fool-p)
+  :package-version '(ERC . "5.7")
+  :type 'hook)
+
 (defcustom erc-notifications-bus :session
   "D-Bus bus to use for notification."
   :version "25.1"
@@ -60,16 +82,18 @@
 (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"
-                                (erc-compat--xml-escape-string nick t)
-                                channel))
-                 (body (erc-compat--xml-escape-string (erc-controls-strip msg)
-                                                      t)))
+          (let* ((channel (or (and privp (not (equal nick (erc-target)))
+                                   (erc-get-buffer nick))
+                              (current-buffer)))
+                 (title (if (or privp (equal nick (erc-target)))
+                            (erc-compat--xml-escape-string nick t)
+                          (format "%s in %s"
+                                  (erc-compat--xml-escape-string nick t)
+                                  channel)))
+                 (body (erc-compat--xml-escape-string
+                        (erc-controls-strip msg) t)))
             (funcall (cond ((featurep 'android)
                             #'android-notifications-notify)
                            ((featurep 'haiku)
@@ -85,6 +109,7 @@ This will replace the last notification sent with this function."
                                   (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)))
@@ -96,23 +121,96 @@ This will replace the last notification sent with this function."
   ;; Return nil to continue processing by ERC
   nil)
 
-(defun erc-notifications-notify-on-match (match-type nickuserhost msg)
+(defun erc-desktop-notifications-untracked-p (&rest _)
+  "Return non-nil if current buffer's target appears in `erc-track-exclude'."
+  (and (boundp 'erc-track-exclude) (member (erc-target) erc-track-exclude)))
+
+(defun erc-desktop-notifications-fool-p (&rest _)
+  "Return non-nil if the current message has a \"match type\" of `fool'."
+  (erc-match-get-match 'erc-match-opt-fool))
+
+(defun erc-desktop-notifications-focused-p (match)
+  "Return non-nil if the frame is focused and suppressed by context.
+See `erc-desktop-notifications-ignored-when-focused' for contexts."
+  (and (eq (current-buffer) (window-buffer))
+       (cond
+        ((erc-query-buffer-p)
+         (memq 'query erc-desktop-notifications-ignored-when-focused))
+        ((erc-match-opt-current-nick-p match)
+         (memq 'mention erc-desktop-notifications-ignored-when-focused)))
+       (frame-focus-state)))
+
+(defun erc-notifications-notify-on-match (match-type _ msg)
+  "Emit MSG if MATCH-TYPE is `current-nick' and other conditions allow."
   (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)))
-        (erc-notifications-notify nick msg)))))
+    (let ((match erc-match-highlight-matched))
+      (cl-assert (erc-match-opt-current-nick-p match))
+      (when-let* ((nick (erc-match-nick match)))
+        (unless (run-hook-with-args-until-success
+                 'erc-desktop-notifications-skip-predicates
+                 match)
+          (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)
-   (add-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match))
+  ((unless erc--updating-modules-p
+     (erc-buffer-do #'erc-desktop-notifications--setup))
+   (add-hook 'erc-mode-hook #'erc-desktop-notifications--setup))
   ;; Disable
-  ((remove-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG)
-   (remove-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match)))
+  ((erc-buffer-do #'erc-desktop-notifications--setup)
+   (remove-hook 'erc-mode-hook #'erc-desktop-notifications--setup)))
+
+(defun erc-desktop-notifications--setup ()
+  (if erc-notifications-mode
+      (progn
+        (add-hook 'erc-match-functions
+                  ;; Run after default value to detect fools.
+                  #'erc-desktop-notifications-match-query 20 t)
+        (add-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match
+                  20 t))
+    (remove-hook 'erc-match-functions
+                 #'erc-desktop-notifications-match-query t)
+    (remove-hook 'erc-text-matched-hook
+                 #'erc-notifications-notify-on-match t)))
+
+;; This flag is most likely only temporary and exists as a hedge against
+;; a likely thinko involving NOTICEs sent to query buffers.  At the time
+;; of writing, it's unclear whether the current behavior of suppressing
+;; query NOTICEs outright is TRT.  For example, a user might want
+;; NOTICEs from a particular bot to trigger notifications because it's
+;; monitoring critical updates to some library they use.  When the
+;; picture becomes clearer, the introduction of a new option/predicate
+;; pair resembling `erc-desktop-notifications-ignored-when-focused' and
+;; `erc-desktop-notifications-focused-p' may be warranted.
+(defvar erc-desktop-notifications--query-NOTICE-p nil
+  "Whether to notify on receiving a \"NOTICE\" in a query.
+Bots and services typically send these.")
+
+(cl-defstruct (erc-desktop-notifications-match-query
+               (:constructor erc-desktop-notifications-match-query)
+               (:include erc-match-user
+                         (category nil)
+                         (predicate #'erc-desktop-notifications--query-p)
+                         (handler #'erc-desktop-notifications--query-notify)))
+  "Desktop 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 erc-desktop-notifications--query-NOTICE-p
+           (eq (erc-match-command match) 'PRIVMSG))
+       (progn
+         (cl-assert (erc-match-nick match))
+         (not (run-hook-with-args-until-success
+               'erc-desktop-notifications-skip-predicates match)))))
+
+(defun erc-desktop-notifications--query-notify (match)
+  ;; No need for PRIVP arg because current buffer is correct.
+  (erc-notifications-notify (erc-target)
+                            (erc-match-get-message-body match)))
+
 
 (provide 'erc-desktop-notifications)
 
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 7c77960994d..c6675053e55 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -298,7 +298,7 @@ available via universal argument."
   "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
+  :package-version '(ERC . "5.7")
   :type '(hook :options (erc-match-opt-pal
                          erc-match-opt-fool
                          erc-match-opt-dangerous-host
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..690c0e37ac3
--- /dev/null
+++ b/test/lisp/erc/erc-desktop-notifications-tests.el
@@ -0,0 +1,139 @@
+;;; erc-desktop-notifications-tests.el --- Notifications tests  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2026 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")
+
+  (unwind-protect
+      (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-desktop-notifications-focused-contexts/default ()
+  (should-not erc-desktop-notifications-ignored-when-focused)
+
+  (erc-desktop-notifications-tests--populate-chan
+   (lambda (check)
+
+     ;; A private query triggers a notification.
+     (erc-tests-common-simulate-line ":[email protected] PRIVMSG tester yo")
+     (should (eq (current-buffer) (get-buffer "bob")))
+
+     ;; A NOTICE command doesn't trigger a notification (unless
+     ;; `erc-desktop-notifications--query-NOTICE-p' is non-nil).
+     (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 ":[email protected] PRIVMSG tester ho")
+
+     (ert-with-buffer-selected "#chan"
+       (erc-tests-common-simulate-privmsg "alice" "hi tester")
+
+       (should (equal (funcall check)
+                      '(("alice" "hi tester\n") ("bob" "ho"))))))))
+
+(ert-deftest erc-desktop-notifications-focused-contexts/unselected ()
+  (should-not erc-desktop-notifications-ignored-when-focused)
+
+  (let ((erc-desktop-notifications-ignored-when-focused '(query mention)))
+
+    (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.
+       (ert-with-buffer-selected "#chan"
+         (erc-tests-common-simulate-privmsg "alice" "hi tester")
+
+         ;; A new query arrives 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
+            ":[email protected] PRIVMSG tester yo")))
+
+       (should-not (funcall check))))))
+
+(ert-deftest erc-desktop-notifications-skip-predicates/fools ()
+  (erc-desktop-notifications-tests--populate-chan
+   (lambda (check)
+
+     ;; A private query triggers a notification.
+     (erc-tests-common-simulate-line ":[email protected] PRIVMSG tester yo")
+     (should (eq (current-buffer) (get-buffer "bob")))
+
+     (should (equal (funcall check)
+                    '(("bob" "yo")
+                      ("bob" "hi tester\n"))))
+
+     (let ((erc-fools '("bob")))
+
+       ;; A query from is suppressed if bob is a fool.
+       (erc-tests-common-simulate-line ":[email protected] PRIVMSG tester ho")
+       (should-not (funcall check))
+
+       ;; A mention from bob is suppressed if bob is a fool.
+       (with-current-buffer "#chan"
+         (erc-tests-common-simulate-privmsg "bob" "hi tester")
+         (erc-tests-common-simulate-privmsg "alice" "hi tester")
+         (should (equal (funcall check) '(("alice" "hi tester\n")))))))))
+
+;;; erc-desktop-notifications-tests.el ends here