monologuing, instead of alternating between it and the highest ranked
'erc-track-faces-normal-list' member in a given message.
+** Module 'querypoll' has left 'goodies' and moved in with 'notify'.
+The 'querypoll' module was initially placed in 'erc-goodies' even though
+a far more sensible home existed in 'erc-notify'. Given the similarity
+of concerns and the newer module's "experimental" status, the migration
+was deemed worth any potential disruption, despite this being a point
+release. ERC appreciates your understanding in this matter.
+
\f
* Changes in ERC 5.6
(multi-occur (erc-buffer-list nil proc) string))
-;;;; querypoll
-
-(declare-function ring-empty-p "ring" (ring))
-(declare-function ring-insert "ring" (ring item))
-(declare-function ring-insert+extend "ring" (ring item))
-(declare-function ring-length "ring" (ring))
-(declare-function ring-member "ring" (ring item))
-(declare-function ring-ref "ring" (ring index))
-(declare-function ring-remove "ring" (ring &optional index))
-
-(defvar-local erc--querypoll-ring nil)
-(defvar-local erc--querypoll-timer nil)
-
-(defcustom erc-querypoll-exclude-regexp
- (rx bot (or (: "*" (+ nonl)) (: (+ (in "A-Za-z")) "Serv")) eot)
- "Pattern to skip polling for bots and services you regularly query."
- :group 'erc
- :package-version '(ERC . "5.6")
- :type 'regexp)
-
-;;;###autoload(autoload 'erc-querypoll-mode "erc-goodies" nil t)
-(define-erc-module querypoll nil
- "Send periodic \"WHO\" requests for each query buffer.
-Omit query participants who are currently present in some channel.
-Instead of announcing arrivals and departures, rely on other modules,
-like `nickbar', to provide UI feedback when changes occur.
-
-Once ERC implements the `monitor' extension, this module will serve as
-an optional fallback for keeping query-participant rolls up to date on
-servers that lack support or are stingy with their allotments. Until
-such time, this module should be considered experimental.
-
-This is a local ERC module, so selectively polling only a subset of
-query targets is possible but cumbersome. To do so, ensure
-`erc-querypoll-mode' is enabled in the server buffer, and then toggle it
-as appropriate in desired query buffers. To stop polling for the
-current connection, toggle off the command \\[erc-querypoll-mode] from a
-server buffer, or run \\`M-x C-u erc-querypoll-disable RET' from a
-target buffer."
- ((if erc--target
- (if (erc-query-buffer-p)
- (progn ; accommodate those who eschew `erc-modules'
- (erc-with-server-buffer
- (unless erc-querypoll-mode
- (erc-querypoll-mode +1)))
- (erc--querypoll-subscribe (current-buffer)))
- (erc-querypoll-mode -1))
- (cl-assert (not erc--decouple-query-and-channel-membership-p))
- (setq-local erc--querypoll-ring (make-ring 5))
- (erc-with-all-buffers-of-server erc-server-process nil
- (unless erc-querypoll-mode
- (erc-querypoll-mode +1)))))
- ((when erc--querypoll-timer
- (cancel-timer erc--querypoll-timer))
- (if erc--target
- (when-let (((erc-query-buffer-p))
- (ring (erc-with-server-buffer erc--querypoll-ring))
- (index (ring-member ring (current-buffer)))
- ((not (erc--querypoll-target-in-chan-p (current-buffer)))))
- (ring-remove ring index)
- (unless (erc-current-nick-p (erc-target))
- (erc-remove-current-channel-member (erc-target))))
- (erc-with-all-buffers-of-server erc-server-process #'erc-query-buffer-p
- (erc-querypoll-mode -1)))
- (kill-local-variable 'erc--querypoll-ring)
- (kill-local-variable 'erc--querypoll-timer))
- 'local)
-
-(cl-defmethod erc--queries-current-p (&context (erc-querypoll-mode (eql t))) t)
-
-(defvar erc-querypoll-period-params '(10 10 1)
- "Parameters affecting the delay with respect to the number of buffers.
-The elements represent some parameters of an exponential decay function,
-a(e)^{-x/b}+c. The first number (a) affects the overall scaling. A
-higher value means longer delays for all query buffers relative to queue
-length. The second number (b) determines how quickly the delay
-decreases as the queue length increases. Larger values make the delay
-taper off more gradually. The last number (c) sets the minimum delay
-between updates regardless of queue length.")
-
-(defun erc--querypoll-compute-period (queue-size)
- "Calculate delay based on QUEUE-SIZE."
- (let ((scale (nth 0 erc-querypoll-period-params))
- (rate (* 1.0 (nth 1 erc-querypoll-period-params)))
- (min (nth 2 erc-querypoll-period-params)))
- (+ (* scale (exp (/ (- queue-size) rate))) min)))
-
-(defun erc--querypoll-target-in-chan-p (buffer)
- "Determine whether buffer's target, as a user, is joined to any channels."
- (and-let*
- ((target (erc--target-string (buffer-local-value 'erc--target buffer)))
- (user (erc-get-server-user target))
- (buffers (erc-server-user-buffers user))
- ((seq-some #'erc-channel-p buffers)))))
-
-(defun erc--querypoll-get-length (ring)
- "Return the effective length of RING, discounting chan members."
- (let ((count 0))
- (dotimes (i (ring-length ring))
- (unless (erc--querypoll-target-in-chan-p (ring-ref ring i))
- (cl-incf count 1)))
- count))
-
-(defun erc--querypoll-get-next (ring)
- (let ((n (ring-length ring)))
- (catch 'found
- (while (natnump (cl-decf n))
- (when-let ((buffer (ring-remove ring))
- ((buffer-live-p buffer)))
- ;; Push back buffers for users joined to some chan.
- (if (erc--querypoll-target-in-chan-p buffer)
- (ring-insert ring buffer)
- (throw 'found buffer)))))))
-
-(defun erc--querypoll-subscribe (query-buffer &optional penalty)
- "Add QUERY-BUFFER to FIFO and ensure timer is running."
- (when query-buffer
- (cl-assert (erc-query-buffer-p query-buffer)))
- (erc-with-server-buffer
- (when (and query-buffer
- (not (with-current-buffer query-buffer
- (or (erc-current-nick-p (erc-target))
- (string-match erc-querypoll-exclude-regexp
- (erc-target)))))
- (not (ring-member erc--querypoll-ring query-buffer)))
- (ring-insert+extend erc--querypoll-ring query-buffer))
- (unless erc--querypoll-timer
- (setq erc--querypoll-timer
- (let* ((length (erc--querypoll-get-length erc--querypoll-ring))
- (period (erc--querypoll-compute-period length)))
- (run-at-time (+ (or penalty 0) period)
- nil #'erc--querypoll-send (current-buffer)))))))
-
-(defun erc--querypoll-on-352 (target-nick args)
- "Add or update `erc-server-users' data for TARGET-NICK from ARGS.
-Then add user to participant rolls in any existing query buffers."
- (pcase-let
- ((`(,_ ,channel ,login ,host ,_server ,nick ,_flags, hop-real) args))
- (when (and (string= channel "*") (erc-nick-equal-p nick target-nick))
- (if-let ((user (erc-get-server-user nick)))
- (erc-update-user user nick host login
- (erc--extract-352-full-name hop-real))
- ;; Don't add unless target is already known.
- (when (erc-get-buffer nick erc-server-process)
- (erc-add-server-user
- nick (make-erc-server-user
- :nickname nick :login login :host host
- :full-name (erc--extract-352-full-name hop-real)))))
- (erc--ensure-query-member nick)
- t)))
-
-;; This uses heuristics to associate replies to the initial request
-;; because ERC does not yet support `labeled-response'.
-(defun erc--querypoll-send (server-buffer)
- "Send a captive \"WHO\" in SERVER-BUFFER."
- (when (and (buffer-live-p server-buffer)
- (buffer-local-value 'erc-server-connected server-buffer))
- (with-current-buffer server-buffer
- (setq erc--querypoll-timer nil)
- (if-let ((buffer (erc--querypoll-get-next erc--querypoll-ring)))
- (letrec
- ((target (erc--target-string
- (buffer-local-value 'erc--target buffer)))
- (penalty 0)
- (here-fn (erc-once-with-server-event
- "352" (lambda (_ parsed)
- (erc--querypoll-on-352
- target (erc-response.command-args parsed)))))
- (done-fn (erc-once-with-server-event
- "315"
- (lambda (_ parsed)
- (if (memq here-fn erc-server-352-functions)
- (erc-remove-user
- (nth 1 (erc-response.command-args parsed)))
- (remove-hook 'erc-server-352-functions here-fn t))
- (remove-hook 'erc-server-263-functions fail-fn t)
- (remove-hook 'erc-server-315-functions done-fn t)
- (erc--querypoll-subscribe buffer penalty)
- t)))
- (fail-fn (erc-once-with-server-event
- "263"
- (lambda (proc parsed)
- (setq penalty 60)
- (funcall done-fn proc parsed)
- t))))
- (erc-server-send (concat "WHO " target)))
- (unless (ring-empty-p erc--querypoll-ring)
- (erc--querypoll-subscribe nil 30))))))
-
(provide 'erc-goodies)
;;; erc-goodies.el ends here
(notify-on . "Detected %n on IRC network %m")
(notify-off . "%n has left IRC network %m"))
+
+;;;; Module `querypoll'
+
+;; This module is similar to `notify' in that it periodically tries to
+;; discover whether certain users are online. Unlike that module, it's
+;; not really configurable. Rather, it only selects users you've
+;; corresponded with in a query buffer, and it keeps `erc-server-users'
+;; entries for them updated.
+
+(declare-function ring-empty-p "ring" (ring))
+(declare-function ring-insert "ring" (ring item))
+(declare-function ring-insert+extend "ring" (ring item))
+(declare-function ring-length "ring" (ring))
+(declare-function ring-member "ring" (ring item))
+(declare-function ring-ref "ring" (ring index))
+(declare-function ring-remove "ring" (ring &optional index))
+
+(defvar-local erc--querypoll-ring nil)
+(defvar-local erc--querypoll-timer nil)
+
+(defcustom erc-querypoll-exclude-regexp
+ (rx bot (or (: "*" (+ nonl)) (: (+ (in "A-Za-z")) "Serv")) eot)
+ "Pattern to skip polling for bots and services you regularly query."
+ :group 'erc
+ :package-version '(ERC . "5.6")
+ :type 'regexp)
+
+;;;###autoload(autoload 'erc-querypoll-mode "erc-notify" nil t)
+(define-erc-module querypoll nil
+ "Send periodic \"WHO\" requests for each query buffer.
+Omit query participants who are currently present in some channel.
+Instead of announcing arrivals and departures, rely on other modules,
+like `nickbar', to provide UI feedback when changes occur.
+
+Once ERC implements the `monitor' extension, this module will serve as
+an optional fallback for keeping query-participant rolls up to date on
+servers that lack support or are stingy with their allotments. Until
+such time, this module should be considered experimental.
+
+This is a local ERC module, so selectively polling only a subset of
+query targets is possible but cumbersome. To do so, ensure
+`erc-querypoll-mode' is enabled in the server buffer, and then toggle it
+as appropriate in desired query buffers. To stop polling for the
+current connection, toggle off the command \\[erc-querypoll-mode] from a
+server buffer, or run \\`M-x C-u erc-querypoll-disable RET' from a
+target buffer."
+ ((if erc--target
+ (if (erc-query-buffer-p)
+ (progn ; accommodate those who eschew `erc-modules'
+ (erc-with-server-buffer
+ (unless erc-querypoll-mode
+ (erc-querypoll-mode +1)))
+ (erc--querypoll-subscribe (current-buffer)))
+ (erc-querypoll-mode -1))
+ (cl-assert (not erc--decouple-query-and-channel-membership-p))
+ (setq-local erc--querypoll-ring (make-ring 5))
+ (erc-with-all-buffers-of-server erc-server-process nil
+ (unless erc-querypoll-mode
+ (erc-querypoll-mode +1)))))
+ ((when erc--querypoll-timer
+ (cancel-timer erc--querypoll-timer))
+ (if erc--target
+ (when-let (((erc-query-buffer-p))
+ (ring (erc-with-server-buffer erc--querypoll-ring))
+ (index (ring-member ring (current-buffer)))
+ ((not (erc--querypoll-target-in-chan-p (current-buffer)))))
+ (ring-remove ring index)
+ (unless (erc-current-nick-p (erc-target))
+ (erc-remove-current-channel-member (erc-target))))
+ (erc-with-all-buffers-of-server erc-server-process #'erc-query-buffer-p
+ (erc-querypoll-mode -1)))
+ (kill-local-variable 'erc--querypoll-ring)
+ (kill-local-variable 'erc--querypoll-timer))
+ 'local)
+
+(cl-defmethod erc--queries-current-p (&context (erc-querypoll-mode (eql t))) t)
+
+(defvar erc-querypoll-period-params '(10 10 1)
+ "Parameters affecting the delay with respect to the number of buffers.
+The elements represent some parameters of an exponential decay function,
+a(e)^{-x/b}+c. The first number (a) affects the overall scaling. A
+higher value means longer delays for all query buffers relative to queue
+length. The second number (b) determines how quickly the delay
+decreases as the queue length increases. Larger values make the delay
+taper off more gradually. The last number (c) sets the minimum delay
+between updates regardless of queue length.")
+
+(defun erc--querypoll-compute-period (queue-size)
+ "Calculate delay based on QUEUE-SIZE."
+ (let ((scale (nth 0 erc-querypoll-period-params))
+ (rate (* 1.0 (nth 1 erc-querypoll-period-params)))
+ (min (nth 2 erc-querypoll-period-params)))
+ (+ (* scale (exp (/ (- queue-size) rate))) min)))
+
+(defun erc--querypoll-target-in-chan-p (buffer)
+ "Determine whether buffer's target, as a user, is joined to any channels."
+ (and-let*
+ ((target (erc--target-string (buffer-local-value 'erc--target buffer)))
+ (user (erc-get-server-user target))
+ (buffers (erc-server-user-buffers user))
+ ((seq-some #'erc-channel-p buffers)))))
+
+(defun erc--querypoll-get-length (ring)
+ "Return the effective length of RING, discounting chan members."
+ (let ((count 0))
+ (dotimes (i (ring-length ring))
+ (unless (erc--querypoll-target-in-chan-p (ring-ref ring i))
+ (cl-incf count 1)))
+ count))
+
+(defun erc--querypoll-get-next (ring)
+ (let ((n (ring-length ring)))
+ (catch 'found
+ (while (natnump (cl-decf n))
+ (when-let ((buffer (ring-remove ring))
+ ((buffer-live-p buffer)))
+ ;; Push back buffers for users joined to some chan.
+ (if (erc--querypoll-target-in-chan-p buffer)
+ (ring-insert ring buffer)
+ (throw 'found buffer)))))))
+
+(defun erc--querypoll-subscribe (query-buffer &optional penalty)
+ "Add QUERY-BUFFER to FIFO and ensure timer is running."
+ (when query-buffer
+ (cl-assert (erc-query-buffer-p query-buffer)))
+ (erc-with-server-buffer
+ (when (and query-buffer
+ (not (with-current-buffer query-buffer
+ (or (erc-current-nick-p (erc-target))
+ (string-match erc-querypoll-exclude-regexp
+ (erc-target)))))
+ (not (ring-member erc--querypoll-ring query-buffer)))
+ (ring-insert+extend erc--querypoll-ring query-buffer))
+ (unless erc--querypoll-timer
+ (setq erc--querypoll-timer
+ (let* ((length (erc--querypoll-get-length erc--querypoll-ring))
+ (period (erc--querypoll-compute-period length)))
+ (run-at-time (+ (or penalty 0) period)
+ nil #'erc--querypoll-send (current-buffer)))))))
+
+(defun erc--querypoll-on-352 (target-nick args)
+ "Add or update `erc-server-users' data for TARGET-NICK from ARGS.
+Then add user to participant rolls in any existing query buffers."
+ (pcase-let
+ ((`(,_ ,channel ,login ,host ,_server ,nick ,_flags, hop-real) args))
+ (when (and (string= channel "*") (erc-nick-equal-p nick target-nick))
+ (if-let ((user (erc-get-server-user nick)))
+ (erc-update-user user nick host login
+ (erc--extract-352-full-name hop-real))
+ ;; Don't add unless target is already known.
+ (when (erc-get-buffer nick erc-server-process)
+ (erc-add-server-user
+ nick (make-erc-server-user
+ :nickname nick :login login :host host
+ :full-name (erc--extract-352-full-name hop-real)))))
+ (erc--ensure-query-member nick)
+ t)))
+
+;; This uses heuristics to associate replies to the initial request
+;; because ERC does not yet support `labeled-response'.
+(defun erc--querypoll-send (server-buffer)
+ "Send a captive \"WHO\" in SERVER-BUFFER."
+ (when (and (buffer-live-p server-buffer)
+ (buffer-local-value 'erc-server-connected server-buffer))
+ (with-current-buffer server-buffer
+ (setq erc--querypoll-timer nil)
+ (if-let ((buffer (erc--querypoll-get-next erc--querypoll-ring)))
+ (letrec
+ ((target (erc--target-string
+ (buffer-local-value 'erc--target buffer)))
+ (penalty 0)
+ (here-fn (erc-once-with-server-event
+ "352" (lambda (_ parsed)
+ (erc--querypoll-on-352
+ target (erc-response.command-args parsed)))))
+ (done-fn (erc-once-with-server-event
+ "315"
+ (lambda (_ parsed)
+ (if (memq here-fn erc-server-352-functions)
+ (erc-remove-user
+ (nth 1 (erc-response.command-args parsed)))
+ (remove-hook 'erc-server-352-functions here-fn t))
+ (remove-hook 'erc-server-263-functions fail-fn t)
+ (remove-hook 'erc-server-315-functions done-fn t)
+ (erc--querypoll-subscribe buffer penalty)
+ t)))
+ (fail-fn (erc-once-with-server-event
+ "263"
+ (lambda (proc parsed)
+ (setq penalty 60)
+ (funcall done-fn proc parsed)
+ t))))
+ (erc-server-send (concat "WHO " target)))
+ (unless (ring-empty-p erc--querypoll-ring)
+ (erc--querypoll-subscribe nil 30))))))
+
(provide 'erc-notify)
;;; erc-notify.el ends here
(should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg))))))
-;;;; querypoll
-
-(ert-deftest erc--querypoll-compute-period ()
- (should (equal (mapcar (lambda (i)
- (/ (round (* 100 (erc--querypoll-compute-period i)))
- 100.0))
- (number-sequence 0 10))
- '(11.0 10.05 9.19 8.41 7.7 7.07 6.49 5.97 5.49 5.07 4.68))))
-
-(declare-function ring-insert "ring" (ring item))
-
-(ert-deftest erc--querypoll-target-in-chan-p ()
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-current-channel-member "bob" "bob" 'addp))
-
- (with-current-buffer (erc--open-target "bob")
- (should (erc--querypoll-target-in-chan-p (current-buffer))))
-
- (with-current-buffer (erc--open-target "alice")
- (should-not (erc--querypoll-target-in-chan-p (current-buffer))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-(ert-deftest erc--querypoll-get-length ()
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-current-channel-member "bob" "bob" 'addp))
-
- (let ((ring (make-ring 5)))
- (ring-insert ring (with-current-buffer (erc--open-target "bob")))
- (should (= 0 (erc--querypoll-get-length ring)))
- (ring-insert ring (with-current-buffer (erc--open-target "alice")))
- (should (= 1 (erc--querypoll-get-length ring))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
-(ert-deftest erc--querypoll-get-next ()
- (erc-tests-common-make-server-buf)
- (with-current-buffer (erc--open-target "#chan")
- (erc-update-current-channel-member "bob" "bob" 'addp)
- (erc-update-current-channel-member "alice" "alice" 'addp))
-
- (let ((ring (make-ring 5)))
- (ring-insert ring (with-current-buffer (erc--open-target "bob")))
- (ring-insert ring (with-current-buffer (erc--open-target "dummy")))
- (ring-insert ring (with-current-buffer (erc--open-target "alice")))
- (ring-insert ring (with-current-buffer (erc--open-target "tester")))
- (kill-buffer (get-buffer "dummy"))
-
- (should (eq (get-buffer "tester") (erc--querypoll-get-next ring))))
-
- (when noninteractive
- (erc-tests-common-kill-buffers)))
-
;;; erc-goodies-tests.el ends here
--- /dev/null
+;;; erc-notify-tests.el --- Tests for erc-notify -*- 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-notify)
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-tests-common)))
+
+
+;;;; Module `querypoll'
+
+(ert-deftest erc--querypoll-compute-period ()
+ (should (equal (mapcar (lambda (i)
+ (/ (round (* 100 (erc--querypoll-compute-period i)))
+ 100.0))
+ (number-sequence 0 10))
+ '(11.0 10.05 9.19 8.41 7.7 7.07 6.49 5.97 5.49 5.07 4.68))))
+
+(declare-function ring-insert "ring" (ring item))
+
+(ert-deftest erc--querypoll-target-in-chan-p ()
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (erc-update-current-channel-member "bob" "bob" 'addp))
+
+ (with-current-buffer (erc--open-target "bob")
+ (should (erc--querypoll-target-in-chan-p (current-buffer))))
+
+ (with-current-buffer (erc--open-target "alice")
+ (should-not (erc--querypoll-target-in-chan-p (current-buffer))))
+
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
+
+(ert-deftest erc--querypoll-get-length ()
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (erc-update-current-channel-member "bob" "bob" 'addp))
+
+ (let ((ring (make-ring 5)))
+ (ring-insert ring (with-current-buffer (erc--open-target "bob")))
+ (should (= 0 (erc--querypoll-get-length ring)))
+ (ring-insert ring (with-current-buffer (erc--open-target "alice")))
+ (should (= 1 (erc--querypoll-get-length ring))))
+
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
+
+(ert-deftest erc--querypoll-get-next ()
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (erc-update-current-channel-member "bob" "bob" 'addp)
+ (erc-update-current-channel-member "alice" "alice" 'addp))
+
+ (let ((ring (make-ring 5)))
+ (ring-insert ring (with-current-buffer (erc--open-target "bob")))
+ (ring-insert ring (with-current-buffer (erc--open-target "dummy")))
+ (ring-insert ring (with-current-buffer (erc--open-target "alice")))
+ (ring-insert ring (with-current-buffer (erc--open-target "tester")))
+ (kill-buffer (get-buffer "dummy"))
+
+ (should (eq (get-buffer "tester") (erc--querypoll-get-next ring))))
+
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
+
+;;; erc-notify-tests.el ends here
projects / emacs.git / commitdiff