side window. Hit '<RET>' 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
'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
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
(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
projects / emacs.git / commitdiff