mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2026-09-10 07:46:51 -04:00
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)
This commit is contained in:
F. Jason Park
parent
3c0fa74ca9
commit
5d3fadb247
20
etc/ERC-NEWS
20
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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
139
test/lisp/erc/erc-desktop-notifications-tests.el
Normal file
139
test/lisp/erc/erc-desktop-notifications-tests.el
Normal file
|
|
@ -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 ":bob!~bob@fsf.org 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 ":bob!~bob@fsf.org 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
|
||||
":bob!~bob@fsf.org 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 ":bob!~bob@fsf.org 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 ":bob!~bob@fsf.org 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
|
||||
Loading…
Reference in a new issue