From 2f884bc702df28e781e8029a5b3d67b5299564e2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 22 May 2024 22:59:54 -0700 Subject: [PATCH] Add ERC module querypoll as monitor placeholder * doc/misc/erc.texi: Add module `querypoll' to list of built-in modules'. * etc/ERC-NEWS: Mention new module `querypoll', and explain new default behavior for deriving query membership from that of channels. * lisp/erc/erc-goodies.el (erc--querypoll-ring) (erc--querypoll-timer): New variables. (erc-querypoll-exclude-regexp): New option. (erc-querypoll-mode, erc-querypoll-enable, erc-querypoll-disable): New module for polling with "WHO" requests for the presence of otherwise "untracked" query targets. (erc-querypoll-period-params): New variable. (erc--querypoll-compute-period) (erc--querypoll-target-in-chan-p) (erc--querypoll-get-length) (erc--querypoll-get-next) (erc--querypoll-subscribe) (erc--querypoll-on-352) (erc--querypoll-send): New functions. * lisp/erc/erc-speedbar.el (erc-speedbar-buttons): Dispatch queries as if they were channels when `erc--queries-current-p' returns non-nil. That is, show head counts alongside query targets as users come and go. (erc-speedbar-insert-target): Defer to `erc--queries-current-p' to know whether to show a query in the style of a channel. This affects both the plain speedbar integration as well as the `nickbar' module added for bug#63595. Also, use question marks rather than the empty string for query bullets, so that query and channel items are aligned vertically. * lisp/erc/erc.el (erc--queries-current-p): New function. * test/lisp/erc/erc-goodies-tests.el (erc--querypoll-compute-period) (erc--querypoll-target-in-chan-p) (erc--querypoll-get-length) (erc--querypoll-get-next): New tests. (Bug#70928) (cherry picked from commit 6888bbbe832e14c3aaaa2c9750ed27e577e0983d) --- doc/misc/erc.texi | 4 + etc/ERC-NEWS | 28 +++++ lisp/erc/erc-goodies.el | 190 +++++++++++++++++++++++++++++ lisp/erc/erc-speedbar.el | 13 +- lisp/erc/erc.el | 5 + test/lisp/erc/erc-goodies-tests.el | 57 +++++++++ 6 files changed, 292 insertions(+), 5 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 0c7e3b09f41..c7cbf7908b8 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -518,6 +518,10 @@ or your nickname is mentioned @item page Process CTCP PAGE requests from IRC +@cindex modules, querypoll +@item querypoll +Update query participant data by continually polling the server + @cindex modules, readonly @item readonly Make displayed lines read-only diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index acad0f03572..1fad62e1999 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -100,6 +100,18 @@ one's optionally accessible from the keyboard, just like any other side window. Hit '' over a nick to spawn a "/QUERY" or a "Lastlog" (Occur) session. See 'erc-nickbar-mode' for more. +** New module to keep tabs on query pals who aren't in your channels. +ERC has gotten a bit pickier about managing participants in query +buffers. "Untracked" correspondents no longer appear automatically in +membership tables, even if you respond or initiate contact. Instead, +ERC only adds and removes participant data when these same users join +and leave channels. Anyone uncomfortable with the apparent +uncertainty this brings can look to the new 'querypoll' module, which +periodically sends WHO requests to keep track of correspondents. +Those familiar with the IRCv3 Monitor extension can think of this as +"fallback code" and a temporary placeholder for the real thing. +Add 'querypoll' (and 'nickbar') to 'erc-modules' to try it out. + ** Option 'erc-timestamp-use-align-to' more versatile. While this option has always offered to right-align stamps via the 'display' text property, it's now more effective at doing so when set @@ -563,6 +575,22 @@ redubbed 'erc-channel-members'. Similarly, the utility function 'erc-get-channel-user' has been renamed to 'erc-get-channel-member'. Expect deprecations of the old names to follow in a future release. +*** Query participant tables now depend on channel membership. +ERC has always been inconsistent and difficult to predict in its +handling of records describing other IRC users. This has made simple +things like detecting the online status of query peers and the +presence of one's own user in 'erc-server-users' especially +unreliable. From now on, ERC resolves to be more sensible and +conservative in such areas. For example, it now retains its own user +info, once discovered, for the remainder of a session. It also relies +solely on channel membership to "drive" query participant information. +That is, when another IRC user departs their last known channel, any +queries with them will consider them absent, even if they're likely +still online. Anyone with difficulty adapting to this new paradigm +should contact the mailing list to inquire about associated +compatibility flags, which can be made public on request. Also see +the related news item announcing the module 'querypoll'. + *** The 'erc-channel-user' struct has a changed internally. The five boolean slots for membership prefixes have been folded ("encoded") into a single integer slot. However, the old 'setf'-able diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index fe44c3bdfcb..9837ec302ee 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -1114,6 +1114,196 @@ servers. If called from a program, PROC specifies the server process." nil erc-server-process))) (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 diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 9cde452be58..d4f91bb363a 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -133,7 +133,7 @@ This will add a speedbar major display mode." (defun erc-speedbar-buttons (buffer) "Create buttons for speedbar in BUFFER." (erase-buffer) - (let (serverp chanp queryp) + (let (serverp chanp queryp queries-current-p) (with-current-buffer buffer ;; The function `dframe-help-echo' checks the default value of ;; `dframe-help-echo-function' when deciding whether to visit @@ -145,13 +145,14 @@ This will add a speedbar major display mode." (setq-local dframe-help-echo-function #'ignore) (setq serverp (erc--server-buffer-p)) (setq chanp (erc-channel-p (erc-default-target))) - (setq queryp (erc-query-buffer-p))) + (setq queryp (erc-query-buffer-p) + queries-current-p (erc--queries-current-p))) (defvar erc-nickbar-mode) (cond ((and erc-nickbar-mode (null (get-buffer-window speedbar-buffer))) (run-at-time 0 nil #'erc-nickbar-mode -1)) (serverp (erc-speedbar-channel-buttons nil 0 buffer)) - (chanp + ((or chanp (and queryp queries-current-p)) (erc-speedbar-insert-target buffer 0) (forward-line -1) (erc-speedbar-expand-channel "+" buffer 0)) @@ -205,7 +206,8 @@ This will add a speedbar major display mode." t))))) (defun erc-speedbar-insert-target (buffer depth) - (if (erc--target-channel-p (buffer-local-value 'erc--target buffer)) + (if (with-current-buffer buffer + (or (erc--target-channel-p erc--target) (erc--queries-current-p))) (progn (speedbar-make-tag-line 'bracket ?+ 'erc-speedbar-expand-channel buffer @@ -218,8 +220,9 @@ This will add a speedbar major display mode." (speedbar-add-indicator (format "(%d)" (hash-table-count table))) (rx "(" (+ (any "0-9")) ")")))) ;; Query target + (cl-assert (erc-query-buffer-p buffer)) (speedbar-make-tag-line - nil nil nil nil + 'bracket ?? nil nil (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil depth))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bf0db894a74..d22fce1634f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -557,6 +557,11 @@ user from `erc-server-users'. Note that enabling this compatibility flag degrades the user experience and isn't guaranteed to correctly restore the described historical behavior.") +(cl-defmethod erc--queries-current-p () + "Return non-nil if ERC actively updates query manifests." + (and (not erc--decouple-query-and-channel-membership-p) + (erc-query-buffer-p) (erc-get-channel-member (erc-target)))) + (defun erc--ensure-query-member (nick) "Populate membership table in query buffer for online NICK." (erc-with-buffer (nick) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 7cbaa39d3f7..ead0bf5a979 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -609,4 +609,61 @@ (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 -- 2.39.2