From 6635456239fbb7ac0ac818992129114288c0f7f5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 24 May 2024 20:09:31 -0700 Subject: [PATCH 0/7] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (7): [5.6] Return nil from more ERC response handlers [5.6] Delete original speedbar frame in erc-nickbar-mode [5.6] Reuse old query buffers for round-trip renicks in ERC [5.6] Mention if an ERC module is local in its doc string [5.6] Update ERC query participants on JOIN and after NAMES [5.6] Retain client's own user in erc-server-users [5.6] Add ERC module querypoll as monitor fallback etc/ERC-NEWS | 20 ++ lisp/erc/erc-backend.el | 166 ++++++++++---- lisp/erc/erc-common.el | 23 +- lisp/erc/erc-goodies.el | 187 +++++++++++++++ lisp/erc/erc-sasl.el | 3 +- lisp/erc/erc-speedbar.el | 216 +++++++++--------- lisp/erc/erc.el | 123 ++++++---- test/lisp/erc/erc-goodies-tests.el | 57 +++++ test/lisp/erc/erc-networks-tests.el | 2 +- test/lisp/erc/erc-scenarios-base-renick.el | 210 +++++++++++++++-- test/lisp/erc/erc-scenarios-status-sidebar.el | 16 +- test/lisp/erc/erc-tests.el | 21 +- .../base/reconnect/options-again.eld | 2 +- .../base/renick/queries/roundtrip.eld | 64 ++++++ .../erc/resources/base/renick/self/manual.eld | 8 +- .../base/renick/self/merge-query-a.eld | 46 ++++ .../base/renick/self/merge-query-b.eld | 48 ++++ 17 files changed, 972 insertions(+), 240 deletions(-) create mode 100644 test/lisp/erc/resources/base/renick/queries/roundtrip.eld create mode 100644 test/lisp/erc/resources/base/renick/self/merge-query-a.eld create mode 100644 test/lisp/erc/resources/base/renick/self/merge-query-b.eld Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 62970f52396..0341bcc6d04 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 @@ -685,6 +697,14 @@ The option 'erc-format-nick-function' has been renamed to actual role. So too has the related function 'erc-format-nick', which is now 'erc-determine-speaker-from user'. +*** All default response handlers return nil. +Actually, this isn't yet true, but ERC is moving in this direction, +with the aim of guaranteeing all response-handler hook members +directly following a default handler always run. In service of this +goal, default handlers like 'erc-server-PONG' and 'erc-server-904' +that may previously have returned non-nil have been updated to return +nil in all cases. User-defined default handlers should do the same. + *** A template-based approach to formatting inserted chat messages. Predicting and influencing how ERC formats messages containing a leading "" has never been straightforward. The characters diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index b644417e1ed..89e40ac8374 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -118,9 +118,13 @@ erc-nick (defvar erc-nick-change-attempt-count) (defvar erc-verbose-server-ping) +(declare-function erc--ensure-query-member "erc" (name)) +(declare-function erc--ensure-query-members "erc" ()) (declare-function erc--init-channel-modes "erc" (channel raw-args)) (declare-function erc--open-target "erc" (target)) (declare-function erc--parse-nuh "erc" (string)) +(declare-function erc--query-list "erc" ()) +(declare-function erc--remove-channel-users-but "erc" (nick)) (declare-function erc--target-from-string "erc" (string)) (declare-function erc--update-modes "erc" (raw-args)) (declare-function erc-active-buffer "erc" nil) @@ -1566,13 +1570,23 @@ define-erc-response-handler `erc-server-NAME'. - a function `erc-server-NAME' with body FN-BODY. +\(Note that here, NAME merely refers to the parameter NAME rather than +an actual IRC response or server-sent command.) + If ALIASES is non-nil, each alias in ALIASES is `defalias'ed to `erc-server-NAME'. Alias hook variables are created as `erc-server-ALIAS-functions' and initialized to the same default value as `erc-server-NAME-functions'. -FN-BODY is the body of `erc-server-NAME' it may refer to the two -function arguments PROC and PARSED. +ERC uses FN-BODY as the body of the default response handler +`erc-server-NAME', which handles all incoming IRC \"NAME\" responses, +unless overridden (see below). ERC calls the function with two +arguments, PROC and PARSED, whose symbols (lowercase) are bound to the +current `erc-server-process' and `erc-response' instance within FN-BODY. +Implementers should take care not to shadow them inadvertently. In all +cases, FN-BODY should return nil to allow third parties to run code +after `erc-server-NAME' returns. For historical reasons, ERC does not +currently enforce this, however future versions very well may. If EXTRA-FN-DOC is non-nil, it is inserted at the beginning of the defined function's docstring. @@ -1770,6 +1784,8 @@ erc--server-determine-join-display-context (list 'JOIN ?n nick ?u login ?h host ?c chnl))))) (when buffer (set-buffer buffer)) (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login) + (unless (erc-current-nick-p nick) + (erc--ensure-query-member nick)) ;; on join, we want to stay in the new channel buffer ;;(set-buffer ob) (apply #'erc-display-message parsed 'notice buffer args)))))) @@ -1782,7 +1798,6 @@ erc--server-determine-join-display-context (buffer (erc-get-buffer ch proc))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) - (erc-remove-channel-member buffer tgt) (cond ((string= tgt (erc-current-nick)) (erc-display-message @@ -1791,17 +1806,20 @@ erc--server-determine-join-display-context (run-hook-with-args 'erc-kick-hook buffer) (erc-with-buffer (buffer) - (erc-remove-channel-users)) + (erc--remove-channel-users-but tgt)) (with-suppressed-warnings ((obsolete erc-delete-default-channel)) (erc-delete-default-channel ch buffer)) (erc-update-mode-line buffer)) ((string= nick (erc-current-nick)) (erc-display-message parsed 'notice buffer - 'KICK-by-you ?k tgt ?c ch ?r reason)) + 'KICK-by-you ?k tgt ?c ch ?r reason) + (erc-remove-channel-member buffer tgt)) (t (erc-display-message - parsed 'notice buffer - 'KICK ?k tgt ?n nick ?u login ?h host ?c ch ?r reason)))))) + parsed 'notice buffer + 'KICK ?k tgt ?n nick ?u login ?h host ?c ch ?r reason) + (erc-remove-channel-member buffer tgt))))) + nil) (define-erc-response-handler (MODE) "Handle server mode changes." nil @@ -1829,17 +1847,19 @@ erc--server-determine-join-display-context ?h host ?t tgt ?m mode))) (erc-banlist-update proc parsed)))) -(defun erc--wrangle-query-buffers-on-nick-change (old new buffers) +(defun erc--wrangle-query-buffers-on-nick-change (old new) "Create or reuse a query buffer for NEW nick after considering OLD nick. -Return a (possibly updated) list of BUFFERS in which to announce the -change." +Return a list of buffers in which to announce the change." + ;; Note that `new-buffer' may be older than `old-buffer', e.g., if + ;; the query target is switching to a previously used nick. (let ((new-buffer (erc-get-buffer new erc-server-process)) (old-buffer (erc-get-buffer old erc-server-process)) - (selfp (string= old (erc-current-nick)))) + (selfp (erc-current-nick-p old)) ; e.g., for note taking, etc. + buffers) (when new-buffer (push new-buffer buffers)) (when old-buffer - (cl-pushnew old-buffer buffers) + (push old-buffer buffers) ;; Ensure the new nick is absent from the old query. (unless selfp (erc-remove-channel-member old-buffer old)) @@ -1872,11 +1892,14 @@ erc--wrangle-query-buffers-on-nick-change ;; erc-channel-users won't contain it ;; ;; Possibly still relevant: bug#12002 - (setq bufs (erc--wrangle-query-buffers-on-nick-change nick nn bufs)) + (dolist (buf (erc--wrangle-query-buffers-on-nick-change nick nn)) + (cl-pushnew buf bufs)) (erc-update-user-nick nick nn host login) (cond ((string= nick (erc-current-nick)) (cl-pushnew (erc-server-buffer) bufs) + ;; Show message in all query buffers. + (setq bufs (append (erc--query-list) bufs)) (erc-set-current-nick nn) ;; Rename session, possibly rename server buf and all targets (when erc-server-connected @@ -1890,7 +1913,8 @@ erc--wrangle-query-buffers-on-nick-change (run-hook-with-args 'erc-nick-changed-functions nn nick)) (t (when erc-server-connected - (erc-networks--id-reload erc-networks--id proc parsed)) + (erc-networks--id-reload erc-networks--id proc parsed) + (erc--ensure-query-member nn)) (erc-handle-user-status-change 'nick (list nick login host) (list nn)) (erc-display-message parsed 'notice bufs 'NICK ?n nick ?u login ?h host ?N nn)))))) @@ -1905,15 +1929,15 @@ erc--wrangle-query-buffers-on-nick-change ;; When `buffer' is nil, `erc-remove-channel-member' and ;; `erc-remove-channel-users' do almost nothing, and the message ;; is displayed in the server buffer. - (erc-remove-channel-member buffer nick) (erc-display-message parsed 'notice buffer 'PART ?n nick ?u login ?h host ?c chnl ?r (or reason "")) - (when (string= nick (erc-current-nick)) + (cond + ((string= nick (erc-current-nick)) (run-hook-with-args 'erc-part-hook buffer) (erc-with-buffer (buffer) - (erc-remove-channel-users)) + (erc--remove-channel-users-but nick)) (with-suppressed-warnings ((obsolete erc-delete-default-channel)) (erc-delete-default-channel chnl buffer)) (erc-update-mode-line buffer) @@ -1921,7 +1945,9 @@ erc--wrangle-query-buffers-on-nick-change (when (and erc-kill-buffer-on-part buffer) (defvar erc-killing-buffer-on-part-p) (let ((erc-killing-buffer-on-part-p t)) - (kill-buffer buffer))))))) + (kill-buffer buffer)))) + (t (erc-remove-channel-member buffer nick))))) + nil) (define-erc-response-handler (PING) "Handle ping messages." nil @@ -1933,7 +1959,8 @@ erc--wrangle-query-buffers-on-nick-change (erc-display-message parsed 'error proc 'PING ?s (erc-time-diff erc-server-last-ping-time (erc-current-time)))) - (setq erc-server-last-ping-time (erc-current-time)))) + (setq erc-server-last-ping-time (erc-current-time))) + nil) (define-erc-response-handler (PONG) "Handle pong messages." nil @@ -2036,7 +2063,7 @@ erc--speaker-status-prefix-wanted-p (erc--speaker-status-prefix-wanted-p nil) (erc-current-message-catalog erc--message-speaker-catalog) ;; - buffer statusmsg cmem-prefix fnick) + finalize buffer statusmsg cmem-prefix fnick) (setq buffer (erc-get-buffer (if privp nick tgt) proc)) ;; Even worth checking for empty target here? (invalid anyway) (unless (or buffer noticep (string-empty-p tgt) (eq ?$ (aref tgt 0)) @@ -2063,10 +2090,12 @@ erc--speaker-status-prefix-wanted-p (setq buffer (erc--open-target tgt)))))) (when buffer (with-current-buffer buffer - (when privp (erc--unhide-prompt)) - ;; update the chat partner info. Add to the list if private - ;; message. We will accumulate private identities indefinitely - ;; at this point. + (when privp + (erc--unhide-prompt) + ;; Remove untracked query partners after display. + (unless (erc--get-server-user nick) + (setq finalize (lambda () + (erc-remove-channel-member buffer nick))))) (erc-update-channel-member (if privp nick tgt) nick nick privp nil nil nil nil nil host login nil nil t) (defvar erc--cmem-from-nick-function) @@ -2105,20 +2134,27 @@ erc--speaker-status-prefix-wanted-p (run-hook-with-args 'erc-echo-notice-always-hook fmtmsg parsed buffer nick) (run-hook-with-args-until-success - 'erc-echo-notice-hook fmtmsg parsed buffer nick)))))))))) + 'erc-echo-notice-hook fmtmsg parsed buffer nick))))) + (when finalize (funcall finalize))) + nil)))) (define-erc-response-handler (QUIT) "Another user has quit IRC." nil (let ((reason (erc-response.contents parsed)) + (erc--msg-prop-overrides erc--msg-prop-overrides) bufs) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) (setq bufs (erc-buffer-list-with-nick nick proc)) - (erc-remove-user nick) + (when (erc-current-nick-p nick) + (setq bufs (append (erc--query-list) bufs)) + (push '(erc--skip . (track)) erc--msg-prop-overrides)) (setq reason (erc-wash-quit-reason reason nick login host)) (erc-display-message parsed 'notice bufs 'QUIT ?n nick ?u login - ?h host ?r reason)))) + ?h host ?r reason) + (erc-remove-user nick))) + nil) (define-erc-response-handler (TOPIC) "The channel topic has changed." nil @@ -2312,6 +2348,9 @@ erc--with-isupport-data See `erc-display-server-message'." nil (erc-display-server-message proc parsed)) +(define-erc-response-handler (263) "RPL_TRYAGAIN." nil + (erc-handle-unknown-server-response proc parsed)) + (define-erc-response-handler (275) "Display secure connection message." nil (pcase-let ((`(,nick ,_user ,_message) @@ -2364,7 +2403,7 @@ erc--with-isupport-data (catalog-entry (intern (format "s%s" (erc-response.command parsed))))) (pcase-let ((`(,nick ,user ,host) (cdr (erc-response.command-args parsed)))) - (erc-update-user-nick nick nick host nil fname user) + (erc-update-user-nick nick nick host user fname) (erc-display-message parsed 'notice 'active catalog-entry ?n nick ?f fname ?u user ?h host)))) @@ -2526,18 +2565,28 @@ erc-server-322-message (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's341 ?n nick ?c channel))) -;; FIXME update or add server user instead when channel is "*". +(defun erc--extract-352-full-name (contents) + "Return full name from 352 trailing param, discarding hop count." + (pcase contents + ((rx (: bot (+ (any "0-9")) " ") (let full-name (group (* nonl))) eot) + full-name) + (_ contents))) + (define-erc-response-handler (352) - "WHO notice." nil - (pcase-let ((`(,channel ,user ,host ,_server ,nick ,away-flag) - (cdr (erc-response.command-args parsed)))) - (let ((full-name (erc-response.contents parsed))) - (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) - (setq full-name (match-string 2 full-name))) - (erc-update-channel-member channel nick nick nil nil nil nil nil nil host user full-name) - (erc-display-message parsed 'notice 'active 's352 - ?c channel ?n nick ?a away-flag - ?u user ?h host ?f full-name)))) + "RPL_WHOREPLY response." nil + (pcase-let* + ((`(,_ ,channel ,user ,host ,_server ,nick ,flags, hop-real) + (erc-response.command-args parsed)) + (full-name (erc--extract-352-full-name hop-real)) + (selfp (string= channel "*")) + (template (if selfp 's352-you 's352))) + (if selfp + (erc-update-user-nick nick nick host user full-name) + (erc-update-channel-member channel nick nick nil nil nil nil nil nil + host user full-name)) + (erc-display-message parsed 'notice 'active template + ?c channel ?n nick ?a flags + ?u user ?h host ?f full-name))) (define-erc-response-handler (353) "NAMES notice." nil @@ -2552,7 +2601,9 @@ erc-server-322-message (define-erc-response-handler (366) "End of NAMES." nil (erc-with-buffer ((cadr (erc-response.command-args parsed)) proc) - (erc-channel-end-receiving-names))) + (erc-channel-end-receiving-names)) + (erc--ensure-query-members) + nil) (define-erc-response-handler (367) "Channel ban list entries." nil @@ -2618,7 +2669,9 @@ erc-server-322-message (erc-log (format "cmd: WHOWAS: %s" nick/channel)) (erc-server-send (format "WHOWAS %s 1" nick/channel))) (erc-display-message parsed '(notice error) 'active - 's401 ?n nick/channel))) + 's401 ?n nick/channel) + (unless (erc-channel-p nick/channel) + (erc-remove-user nick/channel)))) (define-erc-response-handler (402) "No such server." nil diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 4115e314b39..4ba7990ab98 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -216,7 +216,7 @@ erc--assemble-toggle `(defun ,ablsym ,(if localp `(&optional ,arg) '()) ,(erc--fill-module-docstring (if val "Enable" "Disable") - " ERC " (symbol-name name) " mode." + " ERC " (symbol-name name) " mode" (and localp " locally") "." (when localp (concat "\nWhen called interactively," " do so in all buffers for the current connection."))) @@ -413,11 +413,11 @@ define-erc-module `(progn (define-minor-mode ,mode - ,(erc--fill-module-docstring (format "Toggle ERC %s mode. -With a prefix argument ARG, enable %s if ARG is positive, + ,(erc--fill-module-docstring (format "Toggle ERC %s mode%s. +If called interactively, enable `%s' if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -\n%s" name name doc)) +\n%s" name (if local-p " locally" "") mode doc)) :global ,(not local-p) :group (erc--find-group ',name ,(and alias (list 'quote alias))) ,@(unless local-p `(:require ',(erc--find-feature name alias))) @@ -557,6 +557,21 @@ erc-get-server-user (gethash (erc-downcase ,nick) (erc-with-server-buffer erc-server-users))))) +(defun erc--get-server-user (nick) + (erc-get-server-user nick)) + +(define-inline erc--remove-user-from-targets (downcased-nick buffers) + "Remove DOWNCASED-NICK from `erc-channel-members' in BUFFERS." + (inline-quote + (progn + (defvar erc-channel-members-changed-hook) + (dolist (buffer ,buffers) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (remhash ,downcased-nick erc-channel-users) + (when erc-channel-members-changed-hook + (run-hooks 'erc-channel-members-changed-hook)))))))) + (defmacro erc--with-dependent-type-match (type &rest features) "Massage Custom :type TYPE with :match function that pre-loads FEATURES." `(backquote-list* ',(car type) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index fe44c3bdfcb..180c5c3758e 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -1114,6 +1114,193 @@ erc-occur 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. +But omit query participants who share a channel with the client. + +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)) + (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-sasl.el b/lisp/erc/erc-sasl.el index f1cc68e2620..1998e4f129b 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -373,7 +373,8 @@ erc-sasl--destroy "Destroy process PROC and warn user that their settings are likely faulty." (delete-process proc) (erc--lwarn 'erc-sasl :error - "Disconnected from %s; please review SASL settings" proc)) + "Disconnected from %s; please review SASL settings" proc) + nil) (define-erc-response-handler (902) "Handle an ERR_NICKLOCKED response." nil diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index b156f61d5d9..d4f91bb363a 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -133,7 +133,7 @@ erc-speedbar-browser (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,10 +145,14 @@ erc-speedbar-buttons (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))) - (cond (serverp + (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)) @@ -202,7 +206,8 @@ erc-speedbar-channel-buttons 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 @@ -215,8 +220,9 @@ erc-speedbar-insert-target (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))) @@ -288,15 +294,9 @@ erc-speedbar--highlight-self-and-ops 'erc-current-nick-face 'erc-my-nick-face)) (v v)) - ;; FIXME overload `erc-channel-user-owner-p' and friends to - ;; accept an `erc-channel-user' object and replace this unrolled - ;; stuff with a single call to `erc-get-user-mode-prefix'. - (and cuser (or (erc-channel-user-owner cuser) - (erc-channel-user-admin cuser) - (erc-channel-user-op cuser) - (erc-channel-user-halfop cuser) - (erc-channel-user-voice cuser)) - erc-button-nickname-face)))) + (or (and cuser (not (zerop (erc-channel-user-status cuser))) + erc-button-nickname-face) + 'erc-default-face)))) (defun erc-speedbar--on-click (nick sbtoken _indent) ;; 0: finger, 1: name, 2: info, 3: buffer-name @@ -447,7 +447,11 @@ erc-speedbar--buffer-options (speedbar-use-images . nil) (speedbar-hide-button-brackets-flag . t))) -(defvar erc-speedbar--hidden-speedbar-frame nil) +(defvar erc-speedbar--hidden-speedbar-frame nil + "The original `speedbar-frame', which `erc-nickbar-mode' deletes. +It keeps a reference to it in order to run upstream teardown +procedures without having to create a dummy frame for that +purpose.") (defun erc-speedbar--emulate-sidebar-set-window-preserve-size () (let ((erc-status-sidebar-buffer-name (buffer-name speedbar-buffer)) @@ -463,6 +467,7 @@ erc-speedbar--status-sidebar-mode--unhook #'erc-speedbar--emulate-sidebar-set-window-preserve-size)) (defun erc-speedbar--emulate-sidebar () + "Perform local setup for `erc-nickbar-mode' in a new `speedbar-buffer'." (require 'erc-status-sidebar) (cl-assert speedbar-frame) (cl-assert (eq speedbar-buffer (current-buffer))) @@ -482,30 +487,32 @@ erc-speedbar--emulate-sidebar (add-function :around (local 'erc-speedbar--nick-face-function) #'erc-speedbar--compose-nicks-face)))) -(defun erc-speedbar--toggle-nicknames-sidebar (arg) - (let ((force (numberp arg))) - (if speedbar-buffer - (progn - (cl-assert (buffer-live-p speedbar-buffer)) - (if (or (and force (< arg 0)) - (and (not force) (get-buffer-window speedbar-buffer nil))) - ;; Close associated windows and stop updating but leave timer. - (progn - (dolist (window (get-buffer-window-list speedbar-buffer nil t)) - (unless (frame-root-window-p window) - (when erc-speedbar--hidden-speedbar-frame - (cl-assert - (not (eq (window-frame window) - erc-speedbar--hidden-speedbar-frame)))) - (delete-window window))) - (with-current-buffer speedbar-buffer - (setq speedbar-update-flag nil) - (speedbar-set-mode-line-format))) - (when (or (not force) (>= arg 0)) - (with-selected-frame speedbar-frame - (erc-speedbar--emulate-sidebar-set-window-preserve-size) - (erc-speedbar-toggle-nicknames-window-lock -1))))) - (when-let (((or (not force) (>= arg 0))) +(defun erc-speedbar--handle-delete-frame (event) + "Disable the nickbar if EVENT is deleting the proxy frame." + (when (and speedbar-frame + (cdr (frame-list)) + (pcase event + (`(delete-frame (,frame)) (eq frame speedbar-frame)))) + (erc-nickbar-mode -1))) + +(defun erc-speedbar--ensure (&optional forcep) + "Perform common setup for `erc-nickbar-mode'. +Without FORCEP, return early when the calling context isn't +associated with an ERC session." + (save-excursion + (when (or (erc-server-buffer) forcep) + (when erc-track-mode + (cl-pushnew '(derived-mode . speedbar-mode) + erc-track--switch-fallback-blockers :test #'equal)) + (unless speedbar-update-flag + (erc-button--display-error-notice-with-keys + (erc-server-buffer) + "Module `nickbar' needs `speedbar-update-flag' to be non-nil" + (and (not (display-graphic-p)) " in text terminals") + ". Setting to t for the current Emacs session." + " Customize it permanently to avoid this message.") + (setq speedbar-update-flag t)) + (when-let (((null speedbar-buffer)) (speedbar-frame-parameters (backquote-list* '(visibility . nil) '(no-other-frame . t) @@ -516,52 +523,45 @@ erc-speedbar--toggle-nicknames-sidebar ;; created twice. (speedbar-change-initial-expansion-list "ERC") (speedbar-frame-mode 1) - ;; If we put the remaining parts in the "create hook" along - ;; with everything else, the frame with `window-main-window' - ;; gets raised and steals focus if you've switched away from - ;; Emacs in the meantime. - (make-frame-invisible speedbar-frame) - (select-frame (setq speedbar-frame (previous-frame))) + ;; The setup steps below can't go in the "create hook" because + ;; the frame with `window-main-window' will be raised and + ;; steal focus if you switch away from Emacs in the meantime. + (let ((frame speedbar-frame)) + (cl-assert (not (eq speedbar-frame (selected-frame)))) + (select-frame (setq speedbar-frame (selected-frame))) + (delete-frame frame)) + ;; Allow deleting (our) `speedbar-frame' with the mouse. + (with-current-buffer speedbar-buffer + (kill-local-variable 'dframe-delete-frame-function) + (setq dframe-delete-frame-function + #'erc-speedbar--handle-delete-frame))) + (with-selected-frame speedbar-frame (erc-speedbar--emulate-sidebar-set-window-preserve-size) - (erc-speedbar-toggle-nicknames-window-lock -1)))) - (cl-assert (not (cdr (erc-speedbar--get-timers))) t)) - -(defun erc-speedbar--ensure (&optional force) - (when (or (erc-server-buffer) force) - (when erc-track-mode - (cl-pushnew '(derived-mode . speedbar-mode) - erc-track--switch-fallback-blockers :test #'equal)) - (unless speedbar-update-flag - (erc-button--display-error-notice-with-keys - (erc-server-buffer) - "Module `nickbar' needs `speedbar-update-flag' to be non-nil" - (and (not (display-graphic-p)) " in text terminals") - ". Setting to t for the current Emacs session." - " Customize it permanently to avoid this message.") - (setq speedbar-update-flag t)) - (erc-speedbar--toggle-nicknames-sidebar +1) - (with-current-buffer speedbar-buffer - (setq speedbar-update-flag t) - (speedbar-set-mode-line-format)))) + (erc-speedbar-toggle-nicknames-window-lock -1)) + (cl-assert (null (cdr (erc-speedbar--get-timers)))) + (with-current-buffer speedbar-buffer + (setq speedbar-update-flag t) + (speedbar-set-mode-line-format))))) -(defvar erc-speedbar--shutting-down-p nil) -(defvar erc-speedbar--force-update-interval-secs 5 "Speedbar update period.") +(defvar erc-speedbar--force-update-interval-secs 5 + "Speedbar update period.") (defvar-local erc-speedbar--last-ran nil "When non-nil, a lisp timestamp updated when the speedbar timer runs.") -(defun erc-speedbar--run-timer-on-post-insert () - "Refresh speedbar if idle for `erc-speedbar--force-update-interval-secs'." - (when speedbar-buffer +(defun erc-speedbar--prod-dframe-timer (&rest _) + "Refresh speedbar if dormant for `erc-speedbar--force-update-interval-secs'." + (when (buffer-live-p speedbar-buffer) (with-current-buffer speedbar-buffer - (when-let - ((dframe-timer) - ((erc--check-msg-prop 'erc--cmd 'PRIVMSG)) - (interval erc-speedbar--force-update-interval-secs) - ((or (null erc-speedbar--last-ran) - (time-less-p erc-speedbar--last-ran - (time-subtract (current-time) interval))))) - (run-at-time 0 nil #'dframe-timer-fn))))) + (when + (and dframe-timer + (or (null erc-speedbar--last-ran) + (time-less-p erc-speedbar--last-ran + (time-subtract + (current-time) + erc-speedbar--force-update-interval-secs)))) + (run-at-time 0 nil #'dframe-timer-fn)))) + nil) (defun erc-speedbar--reset-last-ran-on-timer () "Reset `erc-speedbar--last-ran'." @@ -574,42 +574,47 @@ nickbar "Show nicknames for current target buffer in a side window. When enabling, create a speedbar session if one doesn't exist and show its buffer in an `erc-status-sidebar' window instead of a -separate frame. When disabling, close the window or, with a -negative prefix arg, destroy the session. +separate frame. If ERC doesn't yet have any live connections, +defer activation until such time. This means the variable +`erc-nickbar-mode' may be t even though no actual speedbar yet +exists. When disabling, destroy the speedbar session. For controlling whether the speedbar window is selectable with -`other-window', see `erc-nickbar-toggle-nicknames-window-lock'. -Note that during initialization, this module may produce unwanted -side effects, like the raising of frames or the stealing of input -focus. If you witness such a thing and can reproduce it, please -file a bug report with \\[erc-bug]." +`other-window', see `erc-nickbar-toggle-nicknames-window-lock'." ((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) - (add-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) (add-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) + (add-hook 'erc-insert-post-hook #'erc-speedbar--prod-dframe-timer) + (add-hook 'erc-server-PONG-functions #'erc-speedbar--prod-dframe-timer) (erc-speedbar--ensure) (unless (or erc--updating-modules-p - (and-let* ((speedbar-buffer) - (win (get-buffer-window speedbar-buffer 'all-frames)) - ((eq speedbar-frame (window-frame win)))))) + (and speedbar-buffer + (eq speedbar-frame + (window-frame (get-buffer-window speedbar-buffer t))))) (when-let ((buf (or (and (derived-mode-p 'erc-mode) (current-buffer)) (car (erc-buffer-filter #'erc--server-buffer-p))))) (with-current-buffer buf - (erc-speedbar--ensure 'force))))) + (erc-speedbar--ensure 'forcep))))) ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) - (remove-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) (remove-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) + (remove-hook 'erc-insert-post-hook #'erc-speedbar--prod-dframe-timer) + (remove-hook 'erc-server-PONG-functions #'erc-speedbar--prod-dframe-timer) (when erc-track-mode (setq erc-track--switch-fallback-blockers (remove '(derived-mode . speedbar-mode) erc-track--switch-fallback-blockers))) - (erc-speedbar--toggle-nicknames-sidebar -1) - (when-let (((not erc-speedbar--shutting-down-p)) - (arg erc--module-toggle-prefix-arg) - ((numberp arg)) - ((< arg 0))) - (with-current-buffer speedbar-buffer - (dframe-close-frame) - (setq erc-speedbar--hidden-speedbar-frame nil))))) + (cl-assert speedbar-buffer) + ;; Close associated windows and stop updating but leave timer. + (dolist (window (get-buffer-window-list speedbar-buffer nil t)) + (unless (frame-root-window-p window) + (when erc-speedbar--hidden-speedbar-frame + (cl-assert (not (eq (window-frame window) + erc-speedbar--hidden-speedbar-frame)))) + (delete-window window))) + (with-current-buffer speedbar-buffer + (setq speedbar-update-flag nil) + (speedbar-set-mode-line-format) + (unless (eq erc--module-toggle-prefix-arg most-negative-fixnum) + (dframe-close-frame))))) (defun erc-speedbar--get-timers () (cl-remove #'dframe-timer-fn timer-idle-list @@ -621,21 +626,18 @@ erc-speedbar--dframe-controlled (cl-assert (eq speedbar-buffer (current-buffer)))) (when (and erc-speedbar--hidden-speedbar-frame (numberp arg) (< arg 0)) (when erc-nickbar-mode - (let ((erc-speedbar--shutting-down-p t)) - (erc-nickbar-mode -1))) + (erc-nickbar-mode most-negative-fixnum)) (setq speedbar-frame erc-speedbar--hidden-speedbar-frame erc-speedbar--hidden-speedbar-frame nil) - ;; It's unknown whether leaving the frame invisible interferes - ;; with the upstream teardown sequence. - (when (display-graphic-p) - (make-frame-visible speedbar-frame)) (speedbar-frame-mode arg) ; -1 ;; As of Emacs 29, `dframe-set-timer' can't remove `dframe-timer'. (cl-assert (= 1 (length (erc-speedbar--get-timers))) t) (cancel-function-timers #'dframe-timer-fn) ;; `dframe-close-frame' kills the buffer but no function in ;; erc-speedbar.el resets this to nil. - (setq speedbar-buffer nil))) + (setq erc-speedbar--hidden-speedbar-frame nil + speedbar-buffer nil + speedbar-frame nil))) (defun erc-speedbar-toggle-nicknames-window-lock (arg) "Toggle whether nicknames window is selectable with \\[other-window]. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 1665b2cacf7..8ec5a54ab3b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -509,7 +509,7 @@ erc-connect-pre-hook (defvaralias 'erc-channel-users 'erc-channel-members) (defvar-local erc-channel-members nil - "Hash table of members in the current channel. + "Hash table of members in the current channel or query buffer. It associates nicknames with cons cells of the form \(SERVER-USER . MEMBER-DATA), where SERVER-USER is a `erc-server-user' object and MEMBER-DATA is a `erc-channel-user' @@ -549,14 +549,33 @@ erc-add-server-user (erc-with-server-buffer (puthash (erc-downcase nick) user erc-server-users))) -(defun erc-remove-server-user (nick) - "This function is for internal use only. +(cl-defmethod erc--queries-current-p () + "Return non-nil if ERC actively updates query manifests." + (and (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) + (when-let (((zerop (hash-table-count erc-channel-users))) + (user (erc-get-server-user nick))) + (erc-update-current-channel-member nick nil t) + (erc--unhide-prompt) + t))) -Removes the user with nickname NICK from the `erc-server-users' -hash table. This user is not removed from the -`erc-channel-users' lists of other buffers. +(defun erc--ensure-query-members () + "Update membership tables in all query buffers. +Ensure targets with an entry in `erc-server-users' are present in +`erc-channel-members'." + (erc-with-all-buffers-of-server erc-server-process #'erc-query-buffer-p + (when-let (((zerop (hash-table-count erc-channel-users))) + (target (erc-target)) + ((erc-get-server-user target))) + (erc-update-current-channel-member target nil t) + (erc--unhide-prompt)) + erc-server-process)) -See also: `erc-remove-user'." +(defun erc-remove-server-user (nick) + "Remove NICK from the session's `erc-server-users' table." (erc-with-server-buffer (remhash (erc-downcase nick) erc-server-users))) @@ -579,15 +598,27 @@ erc-change-user-nickname (puthash (erc-downcase new-nick) cdata erc-channel-users))))))) -(defun erc-remove-channel-user (nick) - "This function is for internal use only. - -Removes the user with nickname NICK from the `erc-channel-users' -list for this channel. If this user is not in the -`erc-channel-users' list of any other buffers, the user is also -removed from the server's `erc-server-users' list. +(defvar erc--forget-server-user-function + #'erc--forget-server-user-ignoring-queries + "Function to conditionally remove a user from `erc-server-users'. +Called with a nick and its `erc-server-user' object.") + +(defun erc--forget-server-user (nick user) + "Remove NICK's USER from server table if they're not in any target buffers." + (unless (erc-server-user-buffers user) + (erc-remove-server-user nick))) + +(defun erc--forget-server-user-ignoring-queries (nick user) + "Remove NICK's USER from `erc-server-users' if they've parted all channels." + (let ((buffers (erc-server-user-buffers user))) + (when (or (null buffers) (cl-every #'erc-query-buffer-p buffers)) + (when buffers + (erc--remove-user-from-targets (erc-downcase nick) buffers)) + (erc-remove-server-user nick)))) -See also: `erc-remove-server-user' and `erc-remove-user'." +(defun erc-remove-channel-user (nick) + "Remove NICK from the current target buffer's `erc-channel-members'. +If this was their only target, also remove them from `erc-server-users'." (let ((channel-data (erc-get-channel-user nick))) (when channel-data (let ((user (car channel-data))) @@ -595,32 +626,19 @@ erc-remove-channel-user (delq (current-buffer) (erc-server-user-buffers user))) (remhash (erc-downcase nick) erc-channel-users) - (if (null (erc-server-user-buffers user)) - (erc-remove-server-user nick)))))) + (funcall erc--forget-server-user-function nick user))))) (defun erc-remove-user (nick) - "This function is for internal use only. - -Removes the user with nickname NICK from the `erc-server-users' -list as well as from all `erc-channel-users' lists. - -See also: `erc-remove-server-user' and -`erc-remove-channel-user'." + "Remove NICK from the server and all relevant channels tables." (let ((user (erc-get-server-user nick))) (when user - (let ((buffers (erc-server-user-buffers user))) - (dolist (buf buffers) - (if (buffer-live-p buf) - (with-current-buffer buf - (remhash (erc-downcase nick) erc-channel-users) - (run-hooks 'erc-channel-members-changed-hook))))) + (erc--remove-user-from-targets (erc-downcase nick) + (erc-server-user-buffers user)) (erc-remove-server-user nick)))) (defun erc-remove-channel-users () - "This function is for internal use only. - -Removes all users in the current channel. This is called by -`erc-server-PART' and `erc-server-QUIT'." + "Drain current buffer's `erc-channel-members' table. +Also remove members from the server table if this was their only buffer." (when (erc--target-channel-p erc--target) (setf (erc--target-channel-joined-p erc--target) nil)) (when (and erc-server-connected @@ -631,6 +649,17 @@ erc-remove-channel-users erc-channel-users) (clrhash erc-channel-users))) +(defun erc--remove-channel-users-but (nick) + "Drain channel users and remove from server, sparing NICK." + (when-let ((users (erc-with-server-buffer erc-server-users)) + (my-user (gethash (erc-downcase nick) users)) + (original-function erc--forget-server-user-function) + (erc--forget-server-user-function + (lambda (nick user) + (unless (eq user my-user) + (funcall original-function nick user))))) + (erc-remove-channel-users))) + (defmacro erc--define-channel-user-status-compat-getter (name c d) "Define a gv getter for historical `erc-channel-user' status slot NAME. Expect NAME to be a string, C to be its traditionally associated @@ -2151,6 +2180,10 @@ erc-buffer-list-with-nick (erc-server-user-buffers user) nil)))) +(defun erc--query-list () + "Return all query buffers for the current connection." + (erc-buffer-list #'erc-query-buffer-p erc-server-process)) + ;; Some local variables ;; TODO eventually deprecate this variable @@ -3987,7 +4020,9 @@ erc-display-message instead of lower-level ones, like `erc-insert-line', to insert arbitrary informative messages as if sent by the server. That is, tell modules to treat a \"local\" message for which PARSED is -nil like any other server-sent message." +nil like any other server-sent message. Finally, expect users to +treat the return value of this function as undefined even though +various default response handlers may appear to presume nil." (let* ((erc--msg-props (or erc--msg-props (let ((table (make-hash-table)) @@ -5149,8 +5184,7 @@ erc-cmd-QUOTE (defun erc-cmd-QUERY (&optional user) "Open a query with USER. -How the query is displayed (in a new window, frame, etc.) depends -on the value of `erc-interactive-display'." +Display the query buffer in accordance with `erc-interactive-display'." ;; FIXME: The doc string used to say at the end: ;; "If USER is omitted, close the current query buffer if one exists ;; - except this is broken now ;-)" @@ -5166,7 +5200,11 @@ erc-cmd-QUERY (erc--display-context `((erc-interactive-display . /QUERY) ,@erc--display-context))) (erc-with-server-buffer - (erc--open-target user)))) + (if-let ((buffer (erc-get-buffer user erc-server-process))) + (prog1 buffer + (erc-setup-buffer buffer)) + (prog1 (erc--open-target user) ; becomes current buffer + (erc--ensure-query-member user)))))) (defalias 'erc-cmd-Q #'erc-cmd-QUERY) @@ -5902,23 +5940,19 @@ erc-debug-missing-hooks nil) (defun erc--open-target (target) - "Open an ERC buffer on TARGET and return the buffer. -Ensure own nick is present in the buffer's `erc-channel-members'." - (let ((buffer (erc-open erc-session-server - erc-session-port - (erc-current-nick) - erc-session-user-full-name - nil - nil - (list target) - target - erc-server-process - nil - erc-session-username - (erc-networks--id-given erc-networks--id)))) - (prog1 buffer - (when (erc-query-buffer-p buffer) - (erc-update-channel-member target (erc-current-nick) nil t))))) + "Open an ERC buffer on TARGET." + (erc-open erc-session-server + erc-session-port + (erc-current-nick) + erc-session-user-full-name + nil + nil + (list target) + target + erc-server-process + nil + erc-session-username + (erc-networks--id-given erc-networks--id))) (defun erc-query (target server-buffer) "Open a query buffer on TARGET using SERVER-BUFFER. @@ -9523,6 +9557,7 @@ english (s333 . "%c: topic set by %n, %t") (s341 . "Inviting %n to channel %c") (s352 . "%-11c %-10n %-4a %u@%h (%f)") + (s352-you . "%n %a %u@%h (%f)") (s353 . "Users on %c: %u") (s367 . "Ban for %b on %c") (s367-set-by . "Ban for %b on %c set by %s on %t") @@ -9630,7 +9665,7 @@ erc-kill-channel-hook erc-networks-shrink-ids-and-buffer-names erc-networks-rename-surviving-target-buffer) "Invoked whenever a channel-buffer is killed via `kill-buffer'." - :package-version '(ERC . "5.5") + :package-version '(ERC . "5.6") ; FIXME sync on release :group 'erc-hooks :type 'hook) @@ -9654,7 +9689,9 @@ erc-kill-buffer-function `erc-kill-channel-hook' if a channel buffer was killed, or `erc-kill-buffer-hook' if any other buffer." (when (eq major-mode 'erc-mode) - (erc-remove-channel-users) + (when-let ((erc--target) + (nick (erc-current-nick))) + (erc--remove-channel-users-but nick)) (cond ((eq (erc-server-buffer) (current-buffer)) (run-hooks 'erc-kill-server-hook)) 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 @@ erc--get-inserted-msg-bounds/readonly (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 diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 90d6f13f2f6..f0a7c37ddf2 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1199,7 +1199,7 @@ erc-networks--set-name (erc-mode) (cl-letf (((symbol-function 'erc--route-insertion) - (lambda (&rest r) (push r calls)))) + (lambda (&rest r) (ignore (push r calls))))) (ert-info ("Signals when `erc-server-announced-name' unset") (should-error (erc-networks--set-name nil (make-erc-response))) diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index 290230259cb..866075e0b3b 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -185,21 +185,43 @@ erc-scenarios-base-renick-queries-solo (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "Lal")) (funcall expect 10 " hello") (erc-scenarios-common-say "hi") + (should-not (erc-get-channel-member "tester")) (funcall expect 10 "is now known as Linguo") ;; No duplicate message. (funcall expect -0.1 "is now known as Linguo") ;; No duplicate buffer. (erc-d-t-wait-for 1 (equal (buffer-name) "Linguo")) (should-not (get-buffer "Lal")) + ;; Channel member has been updated + (should-not (erc-get-channel-member "Lal")) + (should-not (erc-get-server-user "Lal")) + (should (erc-get-channel-member "Linguo")) (erc-scenarios-common-say "howdy Linguo"))) (with-current-buffer "#foo" (funcall expect 10 "is now known as Linguo") (funcall expect -0.1 "is now known as Linguo") + (funcall expect 10 "has left")) + + ;; User parting a common channel removes them from queries. + (with-current-buffer "Linguo" + (should-not (erc-get-channel-member "tester")) + (erc-d-t-wait-for 10 (null (erc-get-channel-member "Linguo"))) + (should-not (erc-get-server-user "Linguo"))) + + ;; Leaving the client's only channel doesn't remove its user data + ;; from the server table (see below, after "get along ..."). + (with-current-buffer "#foo" (erc-scenarios-common-say "/part")) + ;; Server and "channel" user are *not* (re)created upon receiving + ;; a direct message for a user we already have an open query with + ;; but with whom we no longer share a channel. (with-current-buffer "Linguo" - (funcall expect 10 "get along")))) + (funcall expect 10 "get along") + (should-not (erc-get-channel-member "Linguo")) + (should-not (erc-get-channel-member "tester")) + (should (erc-get-server-user "tester"))))) ;; Someone you have a query with disconnects and reconnects under a ;; new nick (perhaps due to their client appending a backtick or @@ -332,7 +354,7 @@ erc-scenarios-base-renick-self/merge-query ;; Goto last message from previous session. (funcall expect 10 "has quit" (point-min)) (funcall expect -0.01 "\n\n[") ; duplicate date stamp removed - (funcall expect 1 (concat "*** Grafted buffer `observer@foonet/dummy'" + (funcall expect 1 (concat "*** Grafting buffer `observer@foonet/dummy'" " onto `observer@foonet/tester'")) (funcall expect 1 " hola") (funcall expect 1 " whodis?") @@ -344,14 +366,14 @@ erc-scenarios-base-renick-self/merge-query ;; Goto last assertion. (funcall expect 10 "*** ERC finished ***" (point-min)) (funcall expect -0.01 "\n\n[") ; duplicate date stamp removed - (funcall expect 10 "Grafted buffer `foonet/dummy' onto `foonet/tester'")) + (funcall expect 5 "Grafting buffer `foonet/dummy' onto `foonet/tester'")) (with-current-buffer "#chan" (should-not (get-buffer "#chan@foonet/dummy")) (should-not (get-buffer "#chan@foonet/tester")) (funcall expect 10 "has quit" (point-min)) (funcall expect -0.01 "\n\n[") ; duplicate date stamp removed - (funcall expect 1 (concat "*** Grafted buffer `#chan@foonet/dummy'" + (funcall expect 1 (concat "*** Grafting buffer `#chan@foonet/dummy'" " onto `#chan@foonet/tester'")) (funcall expect 1 "You have joined channel #chan") (funcall expect 1 " alice: Have here bereft") diff --git a/test/lisp/erc/erc-scenarios-status-sidebar.el b/test/lisp/erc/erc-scenarios-status-sidebar.el index 2523ff9ee46..4cec00e2312 100644 --- a/test/lisp/erc/erc-scenarios-status-sidebar.el +++ b/test/lisp/erc/erc-scenarios-status-sidebar.el @@ -98,12 +98,14 @@ erc-scenarios-status-sidebar--bufbar (defvar erc-nickbar-mode) (defvar speedbar-buffer) +;; FIXME move to own file because it takes 20+ seconds, uncompiled. (ert-deftest erc-scenarios-status-sidebar--nickbar () :tags `(:expensive-test :unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) - (when noninteractive (ert-skip "Interactive only")) + (when (and noninteractive (= emacs-major-version 27)) + (ert-skip "Hangs on Emacs 27, asking for input")) - (erc-scenarios-common-with-cleanup + (erc-scenarios-common-with-noninteractive-in-term ((erc-scenarios-common-dialog "base/gapless-connect") (erc-server-flood-penalty 0.1) (erc-server-flood-penalty erc-server-flood-penalty) @@ -156,14 +158,14 @@ erc-scenarios-status-sidebar--nickbar ;; etc. for testing commands that call those same functions. (call-interactively #'erc-nickbar-mode) (should-not erc-nickbar-mode) - (should-not (and speedbar-buffer - (get-buffer-window speedbar-buffer))) - (should speedbar-buffer) + (should-not speedbar-buffer) + (should-not (get-buffer " SPEEDBAR")) (erc-nickbar-mode +1) - (should (and speedbar-buffer - (get-buffer-window speedbar-buffer))) + (should (and speedbar-buffer (get-buffer-window speedbar-buffer))) + (should (eq speedbar-buffer (get-buffer " SPEEDBAR"))) (should (get-buffer " SPEEDBAR")) + (erc-nickbar-mode -1) (should-not (get-buffer " SPEEDBAR")) (should-not erc-nickbar-mode) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 999d9f100c9..7bd5479f524 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -330,6 +330,7 @@ erc--refresh-prompt (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook + erc-send-modify-hook (erc-last-input-time 0) (erc-modules (remq 'stamp erc-modules)) (erc-send-input-line-function #'ignore) @@ -2533,7 +2534,7 @@ erc-message erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (cl-letf (((symbol-function 'erc-display-message) (lambda (_ _ _ msg &rest args) - (push (apply #'erc-format-message msg args) calls))) + (ignore (push (apply #'erc-format-message msg args) calls)))) ((symbol-function 'erc-server-send) (lambda (line _) (push line calls))) ((symbol-function 'erc-server-buffer) @@ -3665,9 +3666,9 @@ define-erc-module--global (define-minor-mode erc-mname-mode "Toggle ERC mname mode. -With a prefix argument ARG, enable mname if ARG is positive, and -disable it otherwise. If called from Lisp, enable the mode if -ARG is omitted or nil. +If called interactively, enable `erc-mname-mode' if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. Some docstring." :global t @@ -3722,10 +3723,10 @@ define-erc-module--local (should (equal got `(progn (define-minor-mode erc-mname-mode - "Toggle ERC mname mode. -With a prefix argument ARG, enable mname if ARG is positive, and -disable it otherwise. If called from Lisp, enable the mode if -ARG is omitted or nil. + "Toggle ERC mname mode locally. +If called interactively, enable `erc-mname-mode' if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. Some docstring." :global nil @@ -3736,7 +3737,7 @@ define-erc-module--local (erc-mname-disable)))) (defun erc-mname-enable (&optional ,arg-en) - "Enable ERC mname mode. + "Enable ERC mname mode locally. When called interactively, do so in all buffers for the current connection." (interactive "p") @@ -3749,7 +3750,7 @@ define-erc-module--local (ignore a) (ignore b)))) (defun erc-mname-disable (&optional ,arg-dis) - "Disable ERC mname mode. + "Disable ERC mname mode locally. When called interactively, do so in all buffers for the current connection." (interactive "p") diff --git a/test/lisp/erc/resources/base/reconnect/options-again.eld b/test/lisp/erc/resources/base/reconnect/options-again.eld index 8a3264fda9c..a3a86fb7100 100644 --- a/test/lisp/erc/resources/base/reconnect/options-again.eld +++ b/test/lisp/erc/resources/base/reconnect/options-again.eld @@ -18,7 +18,7 @@ (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") (0 ":irc.foonet.org 422 tester :MOTD File is missing")) -((mode-user 3.2 "MODE tester +i") +((mode-user 10 "MODE tester +i") (0 ":irc.foonet.org 221 tester +i") (0 ":irc.foonet.org NOTICE tester :This server is still in debug mode.")) -- 2.45.1