commit 7aa91b299e9dd9f416a22658afed1a8edf323b30 (HEAD, refs/remotes/origin/master) Author: F. Jason Park Date: Thu Feb 8 20:28:56 2024 -0800 Fix date-stamp regression in erc-fill-wrap * lisp/erc/erc-fill.el (erc-fill-wrap, erc-fill-wrap-enable) (erc-fill-wrap-disable): Add and remove `erc-stamp--insert-date-hook' member. (erc-fill--wrap-continued-predicate): Add function-valued variable for modules to influence `erc-fill--wrap-continued-message-p', which was originally introduced as part of bug#60936. (erc-fill--wrap-rejigger-last-message): Move toward beginning of file. (erc-fill--wrap-unmerge-on-date-stamp): New function. (erc-fill-wrap): Use `erc-fill--wrap-continued-predicate'. Restore recently deleted hunk that reset the wrap marker upon seeing a date stamp. * test/lisp/erc/erc-scenarios-fill-wrap.el: New file. * test/lisp/erc/resources/fill/wrap/merge-datestamp.eld: New file. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index b2c8c991c96..9d969b39ad2 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -543,6 +543,8 @@ via `erc-fill-wrap-mode-hook'." (if erc-fill-wrap-align-prompt (setq erc-stamp--skip-left-margin-prompt-p t) (setq erc--inhibit-prompt-display-property-p t))) + (add-hook 'erc-stamp--insert-date-hook + #'erc-fill--wrap-unmerge-on-date-stamp 20 t) (setq erc-fill--function #'erc-fill-wrap) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions @@ -558,9 +560,11 @@ via `erc-fill-wrap-mode-hook'." (kill-local-variable 'erc--inhibit-prompt-display-property-p) (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) (remove-hook 'erc--refresh-prompt-hook - #'erc-fill--wrap-indent-prompt) + #'erc-fill--wrap-indent-prompt t) (remove-hook 'erc-button--prev-next-predicate-functions - #'erc-fill--wrap-merged-button-p t)) + #'erc-fill--wrap-merged-button-p t) + (remove-hook 'erc-stamp--insert-date-hook + #'erc-fill--wrap-unmerge-on-date-stamp t)) 'local) (defvar-local erc-fill--wrap-length-function nil @@ -654,6 +658,24 @@ Also cover region with text prop `erc-fill--wrap-merge' set to t." (cdr (setq erc-fill--wrap-merge-indicator-pre (cons s (erc-fill--wrap-measure (point-min) (point)))))))) +(defvar erc-fill--wrap-continued-predicate #'erc-fill--wrap-continued-message-p + "Function called with no args to detect a continued speaker.") + +(defvar erc-fill--wrap-rejigger-last-message nil + "Temporary working instance of `erc-fill--wrap-last-msg'.") + +(defun erc-fill--wrap-unmerge-on-date-stamp () + "Re-wrap message on date-stamp insertion." + (when (and erc-fill-wrap-merge (null erc-fill--wrap-rejigger-last-message)) + (let ((next-beg (point-max))) + (save-restriction + (widen) + (when-let (((get-text-property next-beg 'erc-fill--wrap-merge)) + (end (erc--get-inserted-msg-bounds next-beg)) + (beg (pop end)) + (erc-fill--wrap-continued-predicate #'ignore)) + (erc-fill--wrap-rejigger-region (1- beg) (1+ end) nil 'repairp)))))) + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." @@ -674,6 +696,8 @@ See `erc-fill-wrap-mode' for details." (skip-syntax-forward "^-") (forward-char) (cond ((eq msg-prop 'datestamp) + (when erc-fill--wrap-rejigger-last-message + (set-marker erc-fill--wrap-last-msg (point-min))) (save-excursion (goto-char (point-max)) (skip-chars-backward "\n") @@ -682,7 +706,7 @@ See `erc-fill-wrap-mode' for details." (prog1 (erc-fill--wrap-measure beg (point)) (delete-region (1- (point)) (point)))))) ((and erc-fill-wrap-merge - (erc-fill--wrap-continued-message-p)) + (funcall erc-fill--wrap-continued-predicate)) (add-text-properties (point-min) (point) '(display "" erc-fill--wrap-merge "")) @@ -713,9 +737,6 @@ See `erc-fill-wrap-mode' for details." 'line-prefix `(space :width (- erc-fill--wrap-value ,len))))) -(defvar erc-fill--wrap-rejigger-last-message nil - "Temporary working instance of `erc-fill--wrap-last-msg'.") - (defun erc-fill--wrap-rejigger-region (start finish on-next repairp) "Recalculate `line-prefix' from START to FINISH. After refilling each message, call ON-NEXT with no args. But @@ -770,6 +791,7 @@ With REPAIRP, destructively fill gaps and re-merge speakers." (goto-char next)) (goto-char end))))) +;; FIXME restore rough window position after finishing. (defun erc-fill-wrap-refill-buffer (repair) "Recalculate all `fill-wrap' prefixes in the current buffer. With REPAIR, attempt to refresh \"speaker merges\", which may be diff --git a/test/lisp/erc/erc-scenarios-fill-wrap.el b/test/lisp/erc/erc-scenarios-fill-wrap.el new file mode 100644 index 00000000000..4ebbc6bba73 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-fill-wrap.el @@ -0,0 +1,94 @@ +;;; erc-scenarios-fill-wrap.el --- Fill-wrap module -*- 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 . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(defun erc-scenarios-fill-wrap--merged-p () + (get-text-property (pos-bol) 'erc-fill--wrap-merge)) + +;; This asserts that an intervening date stamp between two messages +;; from the same speaker will trigger a break in merge detection, so +;; the second message's speaker tag won't be hidden. +(ert-deftest erc-scenarios-fill-wrap/merge-datestamp () + :tags '(:expensive-test) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "fill/wrap") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'merge-datestamp)) + (erc-stamp--tz t) + ;; Start at 2023-10-22T06:16:43.445Z + (erc-stamp--current-time (if (< emacs-major-version 29) + '(25908 23515 445000 0) + '(1697930203445 . 1000))) + (erc-timer-hook (cons (lambda (&rest _) + (setq erc-stamp--current-time + (time-add erc-stamp--current-time 15))) + erc-timer-hook)) + (expect (erc-d-t-make-expecter)) + (erc-autojoin-channels-alist '((foonet "#chan" "#control"))) + (erc-modules `(nicks fill-wrap scrolltobottom ,@erc-modules)) + (port (process-contact dumb-server :service))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "This server is in debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy")) + (funcall expect 10 " hi") + (funcall expect 10 " there")) + + (with-current-buffer "#chan" + (funcall expect 10 " tester, welcome") + + ;; Force date change. + (setq erc-stamp--current-time + (time-add erc-stamp--current-time (* 60 60)))) + + (with-current-buffer "#control" + (erc-send-message "1")) + + (with-current-buffer "#chan" + (funcall expect 10 "[Sun Oct 22 2023]") + (funcall expect 10 " one") + (should-not (erc-scenarios-fill-wrap--merged-p))) + + (with-current-buffer "#control" + (erc-send-message "2")) + + (with-current-buffer "dummy" + (funcall expect 10 "[Sun Oct 22 2023]") + (funcall expect 10 " again") + (should-not (erc-scenarios-fill-wrap--merged-p))) + + (with-current-buffer "#chan" + (funcall expect 10 " bob: He was famous")) + + (erc-scrolltobottom-mode -1))) + +;;; erc-scenarios-fill-wrap.el ends here diff --git a/test/lisp/erc/resources/fill/wrap/merge-datestamp.eld b/test/lisp/erc/resources/fill/wrap/merge-datestamp.eld new file mode 100644 index 00000000000..e8dcbe2b350 --- /dev/null +++ b/test/lisp/erc/resources/fill/wrap/merge-datestamp.eld @@ -0,0 +1,55 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 26 May 2024 09:32:55 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server") + (0.02 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 2 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.03 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.00 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +Zi") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode-user 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +Zi")) + +((join 10 "JOIN #chan") + (0.02 ":tester!~u@psu3bp52z9f34.irc JOIN #chan") + (0.06 ":irc.foonet.org 353 tester = #chan :bob dummy tester @fsbot alice") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")) + +((join 10 "JOIN #control") + (0.02 ":tester!~u@psu3bp52z9f34.irc JOIN #control") + (0.06 ":irc.foonet.org 353 tester = #control :@tester") + (0.01 ":irc.foonet.org 366 tester #control :End of NAMES list")) + +((mode-chan 10 "MODE #chan") + (0.02 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1716715981") + (0.00 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!") + (0.00 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #control") + (0.02 ":irc.foonet.org 324 tester #control +Cnt") + (0.01 ":irc.foonet.org 329 tester #control 1716715981") + + (0.02 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :hi") + (0.03 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :there")) + +;; Date changes here. +((privmsg-chan-a 10 "PRIVMSG #control :1") + (0.07 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :one")) + +((privmsg-chan-a 10 "PRIVMSG #control :2") + (0.00 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :two") + (0.02 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :again") + (0.04 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob: He was famous, sir, in his profession, and it was his great right to be so: Gerard de Narbon.")) commit 6888bbbe832e14c3aaaa2c9750ed27e577e0983d Author: F. Jason Park Date: Wed May 22 22:59:54 2024 -0700 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) 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 565f18163df..b375df1edb6 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 commit 5f84213c9802181b4d800615915e3c8dded7b94f Author: F. Jason Park Date: Thu Apr 25 05:16:23 2024 -0700 Retain client's own user in erc-server-users * lisp/erc/erc-backend.el (erc-server-KICK, erc-server-PART): Use new function `erc--remove-channel-user-but' instead of `erc-remove-channel-users'. In `erc-server-KICK', remove sender's channel membership data after displaying the message so that nicks are buttonized. Return nil. In `erc-server-PART', don't run `erc-remove-channel-member' when the client itself has parted. * lisp/erc/erc-common.el (erc--remove-user-from-targets): New function. * lisp/erc/erc.el (erc-remove-server-user): Redo doc string. (erc--forget-server-user-function): New variable. (erc--forget-server-user): New function. (erc--forget-server-user-ignoring-queries): New function, the default value of `erc--forget-server-user-function'. (erc-remove-channel-user): Defer to `erc--forget-server-user-function' to do the actual removal. (erc-remove-user): Defer to `erc--remove-user-from-targets'. (erc-remove-channel-users): Redo doc (erc--remove-channel-users-but): New function. The only use case thus far is for protecting the client's own `erc-server-users' entry from removal when draining `erc-channel-members' tables after the client leaves a target buffer or quits. (erc-kill-buffer-function): Don't remove own user from `erc-server-users'. * test/lisp/erc/erc-scenarios-base-renick.el (erc-scenarios-base-renick-queries-solo): Assert own client parting its only channel doesn't remove own user from server. Also assert that another user parting their only channel removes them from all queries. (Bug#70928) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index a26cdd50dd7..a1f84ee5165 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -124,6 +124,7 @@ (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) @@ -1797,7 +1798,6 @@ add things to `%s' instead." (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 @@ -1806,17 +1806,20 @@ add things to `%s' instead." (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 @@ -1926,15 +1929,15 @@ Return a list of buffers in which to announce the 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) @@ -1942,7 +1945,8 @@ Return a list of buffers in which to announce the 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) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index c01ee6546cb..4ba7990ab98 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -560,6 +560,18 @@ Use the CASEMAPPING ISUPPORT parameter to determine the style." (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.el b/lisp/erc/erc.el index 5be557dee4a..565f18163df 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -581,13 +581,7 @@ Ensure targets with an entry in `erc-server-users' are present in erc-server-process)) (defun erc-remove-server-user (nick) - "This function is for internal use only. - -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. - -See also: `erc-remove-user'." + "Remove NICK from the session's `erc-server-users' table." (erc-with-server-buffer (remhash (erc-downcase nick) erc-server-users))) @@ -610,15 +604,29 @@ other buffers are also changed." (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) + (and (not erc--decouple-query-and-channel-membership-p) + (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))) @@ -626,32 +634,19 @@ See also: `erc-remove-server-user' and `erc-remove-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 @@ -662,6 +657,19 @@ Removes all users in the current channel. This is called by 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 + (if erc--decouple-query-and-channel-membership-p + 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 @@ -9691,7 +9699,9 @@ one of the following hooks: `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-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index 19cb1ecde1d..c96b0353e55 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -185,21 +185,43 @@ (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 commit 04477cf97be9eb2bb5ae09eff114252864461f05 Author: F. Jason Park Date: Wed May 8 19:04:13 2024 -0700 Tether query rolls to channel membership in ERC * lisp/erc/erc-backend.el (erc-server-JOIN): Update query membership via `erc--ensure-query-member' when someone else joins a channel. (erc-server-NICK): Update query membership via `erc--ensure-query-member' after someone else changes their nick. (erc-server-PRIVMSG): After printing a query message from some other person, remove their nick's data from the query buffer's user table if they're "untracked," i.e., not a member of a channel. (erc-server-263, erc-server-263-functions): New function and variable, a default response handler and hook for "RPL_TRYAGAIN", which servers send for things like rejecting "WHO" and "WHOX" responses due to rate limiting. (erc-server-311): Fix call to `erc-update-user-nick' so the userhost login component is no longer supplied as the `info' parameter but rather, correctly, as the `login'. (erc--extract-352-full-name): Factor out trailing hop-count and GECOS parsing for use by overriding handlers or those for adjacent numerics. (erc-server-352): Refactor to handle asterisk as `channel' parameter, which indicates a nick rather than a channel target. (erc-server-366): Update membership in all query buffers via `erc--ensure-query-members' after all names have been received. (erc-server-401): Forget a known user completely when the server reports them as nonexistent. * lisp/erc/erc-common.el (erc--get-server-user): New function, a thin wrapper around `erc-get-server-user' for cases were inlining would require declaring symbols not defined in erc-common. * lisp/erc/erc.el (erc-channel-members): Mention that instances are used for query-participant tables as well. (erc--decouple-query-and-channel-membership-p): New variable, a compatibility flag to access pre-5.6 query bookkeeping behavior. (erc--ensure-query-member, erc--ensure-query-members): New functions. (erc-cmd-QUERY): Ensure parties are present in the query buffer's membership table if they're known to be on the server by simple virtue of being present in some joined channel. (erc-message-english-s352-you): New variable. * test/lisp/erc/erc-scenarios-base-query-participants.el (erc-scenarios-base-query-participants) (erc-scenarios-base-query-participants/legacy): Rename former to latter. Enable compat flag to activate legacy query behavior in which channel membership does not impact query membership. (erc-scenarios-base-query-participants/coupled): New test asserting new behavior in which channel membership dictates query membership. (Bug#70928) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 97aab0e25c3..a26cdd50dd7 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -118,6 +118,8 @@ (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)) @@ -1781,6 +1783,8 @@ add things to `%s' instead." (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)))))) @@ -1906,7 +1910,8 @@ Return a list of buffers in which to announce the 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)))))) @@ -2054,7 +2059,7 @@ like `erc-insert-modify-hook'.") (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)) @@ -2081,10 +2086,14 @@ like `erc-insert-modify-hook'.") (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. + (defvar erc--decouple-query-and-channel-membership-p) + (unless (or erc--decouple-query-and-channel-membership-p + (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) @@ -2123,7 +2132,9 @@ like `erc-insert-modify-hook'.") (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 @@ -2335,6 +2346,9 @@ A server may send more than one 005 message." 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) @@ -2387,7 +2401,7 @@ See `erc-display-server-message'." nil (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)))) @@ -2549,18 +2563,28 @@ See `erc-display-server-message'." nil (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 @@ -2575,7 +2599,9 @@ See `erc-display-server-message'." nil (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 @@ -2641,7 +2667,9 @@ See `erc-display-server-message'." nil (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 51a93bdaa50..c01ee6546cb 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -557,6 +557,9 @@ Use the CASEMAPPING ISUPPORT parameter to determine the style." (gethash (erc-downcase ,nick) (erc-with-server-buffer erc-server-users))))) +(defun erc--get-server-user (nick) + (erc-get-server-user nick)) + (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.el b/lisp/erc/erc.el index 4de7f089aaf..5be557dee4a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -509,7 +509,7 @@ Functions are passed a buffer as the first argument." (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,6 +549,37 @@ Adds USER with nickname NICK to the `erc-server-users' hash table." (erc-with-server-buffer (puthash (erc-downcase nick) user erc-server-users))) +(defvar erc--decouple-query-and-channel-membership-p nil + "When non-nil, don't tether query participation to channel membership. +Specifically, add users to query tables when they speak, don't remove +them when they leave all channels, and allow removing the client's own +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.") + +(defun erc--ensure-query-member (nick) + "Populate membership table in query buffer for online NICK." + (erc-with-buffer (nick) + (when-let (((not erc--decouple-query-and-channel-membership-p)) + ((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))) + +(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 (((not erc--decouple-query-and-channel-membership-p)) + ((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)) + (defun erc-remove-server-user (nick) "This function is for internal use only. @@ -5155,8 +5186,7 @@ just as you provided it. Use this command with care!" (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 ;-)" @@ -5172,7 +5202,11 @@ on the value of `erc-interactive-display'." (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) @@ -9525,6 +9559,7 @@ SOFTP, only do so when defined as a variable." (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") diff --git a/test/lisp/erc/erc-scenarios-base-query-participants.el b/test/lisp/erc/erc-scenarios-base-query-participants.el index 9e9109091ac..30c04974bb6 100644 --- a/test/lisp/erc/erc-scenarios-base-query-participants.el +++ b/test/lisp/erc/erc-scenarios-base-query-participants.el @@ -24,7 +24,7 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(ert-deftest erc-scenarios-base-query-participants () +(ert-deftest erc-scenarios-base-query-participants/legacy () :tags '(:expensive-test) (erc-scenarios-common-with-cleanup @@ -32,6 +32,7 @@ (erc-server-flood-penalty 0.1) (dumb-server (erc-d-run "localhost" t 'legacy)) (expect (erc-d-t-make-expecter)) + (erc--decouple-query-and-channel-membership-p t) (port (process-contact dumb-server :service))) (ert-info ("Connect to foonet") @@ -113,5 +114,95 @@ (should-not (erc-get-server-user "bob")) ; missing from query (should (erc-get-server-user "dummy")))))) +(ert-deftest erc-scenarios-base-query-participants/coupled () + :tags '(:expensive-test) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/query-participants") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'legacy)) + (expect (erc-d-t-make-expecter)) + (port (process-contact dumb-server :service))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "This server is in debug mode") + (erc-scenarios-common-say "/query bob"))) + + (ert-info ("Opening query on untracked user bob doesn't create entry.") + (with-current-buffer "bob" + (should-not (erc-get-channel-member "bob")))) + + (ert-info ("DM from untracked user also doesn't create a query entry.") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy")) + (funcall expect 10 " hi") + (should-not (erc-get-channel-member "dummy")) + (should-not (erc-get-server-user "dummy")))) + + (with-current-buffer "foonet" + (erc-scenarios-common-say "/join #chan")) + + (ert-info ("Members in new chan added to existing query buffers") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "bob ")) ; bob is present in #chan (353) + (with-current-buffer "bob" + (should (erc-get-server-user "bob")) + ;; Can't assert immediately: must wait until 366 arrives. + (erc-d-t-wait-for 10 (erc-get-channel-member "bob")))) + + (ert-info ("Opening query on tracked user creates entry") + (with-current-buffer "#chan" + (funcall expect 10 " alice") ;; alice is present + (erc-scenarios-common-say "hi channel") ; gate + (funcall expect 10 " hi channel") + (erc-scenarios-common-say "/query alice")) + (with-current-buffer "alice" + (should (erc-get-channel-member "alice")))) + + ;; Bob says something. + (with-current-buffer "bob" + (funcall expect 10 " hi") + (should (erc-get-channel-member "bob"))) + + (ert-info ("Query pal parting channel removes them from query") + ;; Identical result if they're kicked: they're removed from the + ;; server AND their target buffers + (with-current-buffer "#chan" + (funcall expect 10 "has left") + (should-not (erc-get-channel-member "dummy")) + (should-not (erc-get-server-user "dummy"))) + (with-current-buffer "dummy" + (should-not (erc-get-channel-member "dummy")))) + + ;; This is unchanged from legacy behavior. + (ert-info ("Query pal quitting channel removes them everywhere") + (with-current-buffer "#chan" + (funcall expect 10 "has quit") + (should-not (erc-get-channel-member "bob")) + (should-not (erc-get-server-user "bob"))) + (with-current-buffer "bob" + (should-not (erc-get-channel-member "bob")))) + + (ert-info ("Query pal re-joining repopulates query") + (with-current-buffer "#chan" + (erc-scenarios-common-say "bob gone") + (funcall expect 10 " bob, welcome back!") + (should (erc-get-server-user "bob"))) + (with-current-buffer "bob" + (should (erc-get-channel-member "bob")))) + + (ert-info ("Parting removes chan members from server and queries") + (with-current-buffer "#chan" + (erc-scenarios-common-say "/part") + (funcall expect 10 "you have left") + (should-not (erc-get-server-user "fsbot")) + (should-not (erc-get-server-user "alice")) ; she never said anything + (should-not (erc-get-server-user "bob")) ; missing from query + (should-not (erc-get-server-user "dummy")))))) + ;;; erc-scenarios-base-query-participants.el ends here commit 75aefe6514854bfdbe2a398cf1b7265012c9a88b Author: F. Jason Park Date: Wed May 8 19:04:13 2024 -0700 Reuse old query buffers for reassumed nicks in ERC * lisp/erc/erc-backend.el (erc--wrangle-query-buffers-on-nick-change): New function for handling buffer renaming and message routing triggered by a nick change. Such twiddling used to reside in `erc-server-NICK' but has been separated out for use by built-in modules overriding `erc-server-NICK'. The behavior has also changed to favor always reusing an existing query buffer whenever possible instead of creating a new, -suffixed buffer. This addresses some arguably unfinished business from bug#48598. (erc-server-NICK): Fix erroneous call to `erc-update-user-nick' that passed the sender's login as the function's INFO argument. Move buffer renaming logic to `erc--wrangle-query-buffers-on-nick-change' for use by "NICK" handlers managed by modules. Also, print the notice in all query buffers when the client changes its own nick. (erc-server-QUIT): Show messages in all query buffers when the client itself quits, but prevent `track' from updating the mode line with redundant noise. * lisp/erc/erc.el (erc-generate-new-buffer-name): Fix typo in doc. (erc--query-list): New function. * test/lisp/erc/erc-scenarios-base-query-participants.el: New file. * test/lisp/erc/erc-scenarios-base-renick.el (erc-scenarios-base-renick-queries-solo): Revise slightly to use modern helper API. (erc-scenarios-base-renick-queries/reassume): New test. (erc-scenarios-base-renick-self/merge-query): New test. * test/lisp/erc/resources/base/query-participants/legacy.eld: New file. * test/lisp/erc/resources/base/reconnect/options-again.eld: Adjust timeout. * test/lisp/erc/resources/base/renick/queries/reassume.eld: New file. * test/lisp/erc/resources/base/renick/self/manual.eld: Update timeouts. * test/lisp/erc/resources/base/renick/self/merge-query-a.eld: New file. * test/lisp/erc/resources/base/renick/self/merge-query-b.eld: New file. (Bug#70928) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 90c46eadaf4..97aab0e25c3 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -121,6 +121,7 @@ (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--target-from-string "erc" (string)) (declare-function erc--update-modes "erc" (raw-args)) (declare-function erc-active-buffer "erc" nil) @@ -1839,6 +1840,37 @@ add things to `%s' instead." ?h host ?t tgt ?m mode))) (erc-banlist-update proc parsed)))) +(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 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 (erc-current-nick-p old)) ; e.g., for note taking, etc. + buffers) + (when new-buffer + (push new-buffer buffers)) + (when old-buffer + (push old-buffer buffers) + ;; Ensure the new nick is absent from the old query. + (unless selfp + (erc-remove-channel-member old-buffer old)) + (when (or selfp (null new-buffer)) + (let ((target (erc--target-from-string new)) + (id (erc-networks--id-given erc-networks--id))) + (with-current-buffer old-buffer + (setq erc-default-recipients (cons new + (cdr erc-default-recipients)) + erc--target target)) + (setq new-buffer (erc-get-buffer-create erc-session-server + erc-session-port + nil target id))))) + (when new-buffer + (with-current-buffer new-buffer + (erc-update-mode-line))) + buffers)) + (define-erc-response-handler (NICK) "Handle nick change messages." nil (let ((nn (erc-response.contents parsed)) @@ -1853,21 +1885,14 @@ add things to `%s' instead." ;; erc-channel-users won't contain it ;; ;; Possibly still relevant: bug#12002 - (when-let ((buf (erc-get-buffer nick erc-server-process)) - (tgt (erc--target-from-string nn))) - (with-current-buffer buf - (setq erc-default-recipients (cons nn (cdr erc-default-recipients)) - erc--target tgt)) - (with-current-buffer (erc-get-buffer-create erc-session-server - erc-session-port nil tgt - (erc-networks--id-given - erc-networks--id)) - ;; Current buffer is among bufs - (erc-update-mode-line))) - (erc-update-user-nick nick nn host nil nil login) + (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 @@ -2103,15 +2128,20 @@ like `erc-insert-modify-hook'.") (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 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 3d73c33312a..4de7f089aaf 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1990,7 +1990,7 @@ either SERVER or PORT (but not both) to be nil to accommodate oddball `erc-server-connect-function's. When TGT-INFO is non-nil, expect its string field to match the redundant -param TARGET (retained for compatibility). Whenever possibly, prefer +param TARGET (retained for compatibility). Whenever possible, prefer returning TGT-INFO's string unmodified. But when a case-insensitive collision prevents that, return target@ID when ID is non-nil or target@network otherwise after renaming the conflicting buffer in the @@ -2151,6 +2151,10 @@ all channel buffers on all servers." (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 diff --git a/test/lisp/erc/erc-scenarios-base-query-participants.el b/test/lisp/erc/erc-scenarios-base-query-participants.el new file mode 100644 index 00000000000..9e9109091ac --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-query-participants.el @@ -0,0 +1,117 @@ +;;; erc-scenarios-base-query-participants.el --- Query user tables -*- 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 . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(ert-deftest erc-scenarios-base-query-participants () + :tags '(:expensive-test) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/query-participants") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'legacy)) + (expect (erc-d-t-make-expecter)) + (port (process-contact dumb-server :service))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "This server is in debug mode") + (erc-scenarios-common-say "/query bob"))) + + (ert-info ("Opening query on untracked user bob doesn't create entry.") + (with-current-buffer "bob" + (should-not (erc-get-channel-member "bob")))) + + (ert-info ("DM from untracked user creates a query entry.") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy")) + (funcall expect 10 " hi") + (should (erc-get-channel-member "dummy")) + (should (erc-get-server-user "dummy")))) + + (with-current-buffer "foonet" + (erc-scenarios-common-say "/join #chan")) + + (ert-info ("Members in new chan not added to existing query buffers") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "bob ")) ; some user bob is present in #chan + (with-current-buffer "bob" + (should-not (erc-get-channel-member "bob")))) + + (ert-info ("Opening query on tracked user doesn't create entry") + ;; And DM'ing them makes no difference. + (with-current-buffer "#chan" + (funcall expect 10 " alice") ;; some user alice is present + (erc-scenarios-common-say "hi channel") + (funcall expect 10 " hi channel") + (erc-scenarios-common-say "/query alice")) + (with-current-buffer "alice" + (should-not (erc-get-channel-member "alice")))) + + (ert-info ("DM from a tracked user creates entry in preexisting buffer") + (with-current-buffer "bob" + (funcall expect 10 " hi") + (should (erc-get-channel-member "bob")))) + + (ert-info ("Query pal parting channel doesn't remove them from query") + ;; Identical result if they're kicked: they're removed from the + ;; server if they have no target buffers remaining, which can't + ;; be true if a query with them remains. + (with-current-buffer "#chan" + (funcall expect 10 "has left") + (should-not (erc-get-channel-member "dummy")) + (should (erc-get-server-user "dummy"))) + (with-current-buffer "dummy" + (should (erc-get-channel-member "dummy")))) + + (ert-info ("Query pal quitting channel removes them everywhere") + (with-current-buffer "#chan" + (funcall expect 10 "has quit") + (should-not (erc-get-channel-member "bob")) + (should-not (erc-get-server-user "bob"))) + (with-current-buffer "bob" + (should-not (erc-get-channel-member "bob")))) + + (ert-info ("Query pal re-joining doesn't repopulate query") + (with-current-buffer "#chan" + (erc-scenarios-common-say "bob gone") + (funcall expect 10 " bob, welcome back!") + (should (erc-get-server-user "bob"))) + (with-current-buffer "bob" + (should-not (erc-get-channel-member "bob")))) + + (ert-info ("Parting removes chan members from server unless in some query") + (with-current-buffer "#chan" + (erc-scenarios-common-say "/part") + (funcall expect 10 "you have left") + (should-not (erc-get-server-user "fsbot")) + (should-not (erc-get-server-user "alice")) ; she never said anything + (should-not (erc-get-server-user "bob")) ; missing from query + (should (erc-get-server-user "dummy")))))) + + +;;; erc-scenarios-base-query-participants.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index 3001fde6da0..19cb1ecde1d 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -160,6 +160,7 @@ (erc-server-flood-penalty 0.1) (erc-server-flood-margin 20) (dumb-server (erc-d-run "localhost" t 'solo)) + (expect (erc-d-t-make-expecter)) (port (process-contact dumb-server :service)) erc-autojoin-channels-alist erc-server-buffer-foo) @@ -175,33 +176,189 @@ (erc-d-t-wait-for 10 (get-buffer "foonet")) - (ert-info ("Joined by bouncer to #foo, pal persent") + (ert-info ("Joined by bouncer to #foo, pal Lal is present") (with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo")) - (erc-d-t-search-for 5 "On Thursday") + (funcall expect 10 " alice: On Thursday") (erc-scenarios-common-say "hi"))) - (erc-d-t-wait-for 10 "Query buffer appears with message from pal" - (get-buffer "Lal")) - - (ert-info ("Chat with pal, who changes name") - (with-current-buffer "Lal" - (erc-d-t-search-for 3 "hello") + (ert-info ("Query buffer appears from Lal, who renicks") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "Lal")) + (funcall expect 10 " hello") (erc-scenarios-common-say "hi") - (erc-d-t-search-for 10 "is now known as Linguo") - (should-not (search-forward "is now known as Linguo" nil t)))) - - (erc-d-t-wait-for 1 (get-buffer "Linguo")) - (should-not (get-buffer "Lal")) - - (with-current-buffer "Linguo" (erc-scenarios-common-say "howdy Linguo")) + (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")) + (erc-scenarios-common-say "howdy Linguo"))) (with-current-buffer "#foo" - (erc-d-t-search-for 10 "is now known as Linguo") - (should-not (search-forward "is now known as Linguo" nil t)) - (erc-cmd-PART "")) + (funcall expect 10 "is now known as Linguo") + (funcall expect -0.1 "is now known as Linguo") + (erc-scenarios-common-say "/part")) (with-current-buffer "Linguo" - (erc-d-t-search-for 10 "get along")))) + (funcall expect 10 "get along")))) + +;; Someone you have a query with disconnects and reconnects under a +;; new nick (perhaps due to their client appending a backtick or +;; underscore). They then engage you in another query before +;; renicking to their original nick. Prior to 5.5, ERC would add a +;; uniquifying suffix of the form bob<2> to the new, post-renick +;; query. ERC 5.6+ acts differently. It mimics popular standalone +;; clients in reusing existing query buffers. +(ert-deftest erc-scenarios-base-renick-queries/reassume () + :tags '(:expensive-test) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/renick/queries") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'reassume)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (erc-autojoin-channels-alist '((foonet "#chan")))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester") + (funcall expect 10 "This server is in debug mode"))) + + (ert-info ("User dummy opens a query with you") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy")) + (funcall expect 10 "hi"))) + + (ert-info ("User dummy quits, reconnects as user warwick") + (with-current-buffer "#chan" + (funcall expect 10 "has quit") + (should-not (erc-get-channel-member "dummy")) + (with-current-buffer "dummy" + (should-not (erc-get-channel-member "dummy"))) + (funcall expect 10 " Alas! sir") + (funcall expect 10 " warwick, welcome") + (funcall expect 10 " hola"))) + + (ert-info ("User warwick queries you, creating a new buffer") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "warwick")) + (should (get-buffer "dummy")) ; not reused + (funcall expect 10 " howdy") + (funcall expect 10 "is now known as dummy") + (should-not (erc-get-channel-member "warwick")) + (should-not (erc-get-channel-member "dummy")))) + + (ert-info ("User warwick renicks as user dummy") + (with-current-buffer "#chan" + (funcall expect 10 "is now known as dummy") + (should-not (erc-get-channel-member "warwick")))) + + (with-current-buffer "dummy" + (should-not (get-buffer "dummy<2>")) + (funcall expect 10 "has quit" (point-min)) + (funcall expect -0.1 "merging buffer") + (funcall expect 10 "is now known as dummy") + (should (erc-get-channel-member "dummy")) + (funcall expect 10 " hey")) + + (with-current-buffer "#chan" + (funcall expect 10 " bob: Than those that")))) + +;; This test asserts behavior for the other side of the conversation +;; described by `erc-scenarios-base-renick-queries/reassume' above. +;; After speaking with someone in a query, you disconnect and +;; reconnect under a new nick. You then open a new query with the +;; same person before changing your nick back to the previous one. +;; The buffers for the two session should then be merged with the help +;; of `erc-networks--transplant-target-buffer-function' and +;; `erc-networks--copy-server-buffer-functions'. +(ert-deftest erc-scenarios-base-renick-self/merge-query () + :tags '(:expensive-test) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/renick/self") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'merge-query-a 'merge-query-b)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (erc-autojoin-channels-alist '((foonet "#chan")))) + + (ert-info ("Connect to foonet as tester") + (with-current-buffer (erc :server "127.0.0.1" :port port :nick "tester") + (funcall expect 10 "This server is in debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 " bob: Speak to the people") + (erc-scenarios-common-say "/query observer")) + + (with-current-buffer "observer" + (erc-scenarios-common-say "hi") + (funcall expect 10 " hi?")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (erc-scenarios-common-say "/quit")) + + (with-current-buffer "foonet" + (funcall expect 10 "*** ERC finished ***")) + + (ert-info ("Reconnect to foonet as dummy") + (with-current-buffer (erc :server "127.0.0.1" :port port :nick "dummy") + (funcall expect 10 "This server is in debug mode"))) + + (with-current-buffer + (erc-d-t-wait-for 10 (get-buffer "#chan@foonet/dummy")) + ;; Uniquification has been performed. + (should-not (get-buffer "#chan")) + (should (get-buffer "#chan@foonet/tester")) + (should-not (get-buffer "foonet")) + (should (get-buffer "foonet/tester")) + (should (get-buffer "foonet/dummy")) + (funcall expect 10 " bob: Pray you") + (erc-scenarios-common-say "/query observer")) + + (with-current-buffer "observer@foonet/dummy" + (should-not (get-buffer "observer")) + (should (get-buffer "observer@foonet/tester")) + (erc-scenarios-common-say "hola") + (funcall expect 10 " whodis?")) + + (with-current-buffer + (erc-d-t-wait-for 10 (get-buffer "#chan@foonet/dummy")) + (erc-scenarios-common-say "/nick tester")) + + ;; All buffers have been merged. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "observer")) + (should-not (get-buffer "observer@foonet/dummy")) + (should-not (get-buffer "observer@foonet/tester")) + ;; Goto last message from previous session. Notice that the + ;; quit message appears in all buffers, including queries. + (funcall expect 10 "has quit" (point-min)) + (funcall expect -0.01 "\n\n[") ; duplicate date stamp removed + (funcall expect 1 (concat "*** Grafting buffer `observer@foonet/dummy'" + " onto `observer@foonet/tester'")) + (funcall expect 1 " hola") + (funcall expect 1 " whodis?") + ;; The nickname change is announced in the query as well so that + ;; the nature of the merge is clear. + (funcall expect 1 "*** Your new nickname is tester")) + + (with-current-buffer "foonet" + (should-not (get-buffer "foonet/dummy")) + (should-not (get-buffer "foonet/tester")) + ;; Goto last assertion. + (funcall expect 10 "*** ERC finished ***" (point-min)) + (funcall expect -0.01 "\n\n[") ; duplicate date stamp removed + (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 "*** Grafting buffer `#chan@foonet/dummy'" + " onto `#chan@foonet/tester'")) + (funcall expect 1 "You have joined channel #chan") + (funcall expect 1 " alice: Have here bereft") + (funcall expect 1 "*** Your new nickname is tester")))) ;; You share a channel and a query buffer with a user on two different ;; networks (through a proxy). The user changes their nick on both diff --git a/test/lisp/erc/resources/base/query-participants/legacy.eld b/test/lisp/erc/resources/base/query-participants/legacy.eld new file mode 100644 index 00000000000..6b18023655d --- /dev/null +++ b/test/lisp/erc/resources/base/query-participants/legacy.eld @@ -0,0 +1,62 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 26 May 2024 09:32:55 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server") + (0.02 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 2 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.03 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.00 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +Zi") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +Zi") + (0.07 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :hi")) + +((join 10 "JOIN #chan") + (0.02 ":tester!~u@psu3bp52z9f34.irc JOIN #chan") + (0.06 ":irc.foonet.org 353 tester = #chan :bob dummy tester @fsbot alice") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!") + (0.03 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #chan") + (0.02 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1716715981")) + +((privmsg-chan-a 10 "PRIVMSG #chan :hi channel") + (0.06 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :Perchance, Iago, I will ne'er go home.") + + ;; Bob (now known) sends us a DM + (0.07 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG tester :hi") + (0.02 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :alice: He is most in the company of the right noble Claudio.") + (0.05 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob: Such were our faults; or then we thought them none.") + (0.03 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :You, sir, I entertain you for one of my hundred; only I do not like the fashion of your garments: you will say, they are Persian attire; but let them be changed.") + + ;; Dummy parts + (0.01 ":dummy!~u@psu3bp52z9f34.irc PART #chan :bye") + (0.08 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :alice: To lay a complot to betray thy foes.") + + ;; Bob quits + (0.02 ":bob!~u@zmmipd3xfii2w.irc QUIT :later") + (0.08 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob: He was famous, sir, in his profession, and it was his great right to be so: Gerard de Narbon.")) + +;; Bob rejoins +((privmsg-chan-b 10 "PRIVMSG #chan :bob gone") + + (0.04 ":bob!~u@zmmipd3xfii2w.irc JOIN #chan") + (0.01 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob, welcome back!") + (0.03 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :Our states are forfeit: seek not to undo us.")) + +((part 10 "PART #chan :\2ERC\2") + (0.02 ":tester!~u@psu3bp52z9f34.irc PART #chan :\2ERC\2")) 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.")) diff --git a/test/lisp/erc/resources/base/renick/queries/reassume.eld b/test/lisp/erc/resources/base/renick/queries/reassume.eld new file mode 100644 index 00000000000..50764a143b6 --- /dev/null +++ b/test/lisp/erc/resources/base/renick/queries/reassume.eld @@ -0,0 +1,64 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.00 ":irc.foonet.org 003 tester :This server was created Thu, 09 May 2024 05:19:24 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.00 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 6 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 2 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 6 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 6 6 :Current local users 6, max 6") + (0.00 ":irc.foonet.org 266 tester 6 6 :Current global users 6, max 6") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #chan") + (0.03 ":irc.foonet.org 221 tester +i") ; dupe + (0.00 ":tester!~u@s8ceryiqkkcxk.irc JOIN #chan") + (0.04 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice dummy tester") + (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :tester, welcome!") + (0.00 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :tester, welcome!") + (0.03 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :That eye that told you so look'd but a-squint.")) + +((mode-chan 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1715231970") + + ;; existing query with dummy + (0.05 ":dummy!~u@s8ceryiqkkcxk.irc PRIVMSG tester :hi") + (0.02 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :alice: Villains, forbear! we are the empress' sons.") + (0.01 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: This matter of marrying his king's daughter,wherein he must be weighed rather by her value than his own,words him, I doubt not, a great deal from the matter.") + + ;; dummy quits + (0.07 ":dummy!~u@s8ceryiqkkcxk.irc QUIT :Quit: \2ERC\2 5.5.0.29.1 (IRC client for GNU Emacs 29.3.50)") + (0.03 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :We will afflict the emperor in his pride.") + (0.03 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: Why, then, is my pump well flowered.") + (0.05 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :Alas! sir, I know not Jupiter; I never drank with him in all my life.") + + ;; rejoins as warwick + (0.03 ":warwick!~u@s8ceryiqkkcxk.irc JOIN #chan") + (0.00 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :warwick, welcome!") + (0.00 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :warwick, welcome!") + (0.03 ":warwick!~u@s8ceryiqkkcxk.irc PRIVMSG #chan :hola") + (0.03 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: And stint thou too, I pray thee, nurse, say I.") + + ;; Makes contact in a query + (0.02 ":warwick!~u@s8ceryiqkkcxk.irc PRIVMSG tester :howdy") + (0.03 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: Nor more willingly leaves winter; such summer-birds are men. Gentlemen, our dinner will not recompense this long stay: feast your ears with the music awhile, if they will fare so harshly o' the trumpet's sound; we shall to 't presently.") + (0.03 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :If it please your honour, I know not well what they are; but precise villains they are, that I am sure of, and void of all profanation in the world that good Christians ought to have.") + + ;; warwick renicks back to dummy + (0.08 ":warwick!~u@s8ceryiqkkcxk.irc NICK dummy") + (0.04 ":bob!~u@68v4mpismdues.irc PRIVMSG #chan :Pleasure and action make the hours seem short.") + (0.01 ":dummy!~u@s8ceryiqkkcxk.irc PRIVMSG tester :hey") + (0.02 ":alice!~u@68v4mpismdues.irc PRIVMSG #chan :bob: Than those that have more cunning to be strange.")) diff --git a/test/lisp/erc/resources/base/renick/self/manual.eld b/test/lisp/erc/resources/base/renick/self/manual.eld index dd107b806d5..a6220ffc2e6 100644 --- a/test/lisp/erc/resources/base/renick/self/manual.eld +++ b/test/lisp/erc/resources/base/renick/self/manual.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :foonet:changeme")) +((pass 10 "PASS :foonet:changeme")) ((nick 1 "NICK tester")) ((user 1 "USER user 0 * :tester") (0 ":irc.foonet.org 001 tester :Welcome to the FooNet Internet Relay Chat Network tester") @@ -24,7 +24,7 @@ (0 ":irc.foonet.org 372 tester :- Please visit us in #libera for questions and support.") (0 ":irc.foonet.org 376 tester :End of /MOTD command.")) -((mode-user 1.2 "MODE tester +i") +((mode-user 10 "MODE tester +i") (0 ":tester!~u@gq7yjr7gsu7nn.irc MODE tester :+RZi") (0 ":irc.znc.in 306 tester :You have been marked as being away") (0 ":tester!~u@gq7yjr7gsu7nn.irc JOIN #foo") @@ -38,13 +38,13 @@ (0 ":irc.foonet.org NOTICE tester :[09:56:57] This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") (0 ":irc.foonet.org 305 tester :You are no longer marked as being away")) -((mode 1 "MODE #foo") +((mode-foo 10 "MODE #foo") (0 ":irc.foonet.org 324 tester #foo +nt") (0 ":irc.foonet.org 329 tester #foo 1622454985") (0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.") (0.1 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :alice: On Thursday, sir ? the time is very short.")) -((nick 2 "NICK dummy") +((nick 10 "NICK dummy") (0 ":tester!~u@gq7yjr7gsu7nn.irc NICK :dummy") (0.1 ":dummy!~u@gq7yjr7gsu7nn.irc MODE dummy :+RZi") (0.1 ":bob!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :dummy: Hi.")) diff --git a/test/lisp/erc/resources/base/renick/self/merge-query-a.eld b/test/lisp/erc/resources/base/renick/self/merge-query-a.eld new file mode 100644 index 00000000000..27ef7ecd2ff --- /dev/null +++ b/test/lisp/erc/resources/base/renick/self/merge-query-a.eld @@ -0,0 +1,46 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.00 ":irc.foonet.org 003 tester :This server was created Sun, 12 May 2024 00:41:10 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 6 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.02 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 2 :channels formed") + (0.01 ":irc.foonet.org 255 tester :I have 6 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 6 6 :Current local users 6, max 6") + (0.00 ":irc.foonet.org 266 tester 6 6 :Current global users 6, max 6") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode-user 10 "MODE tester +i")) + +((join 10 "JOIN #chan") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":tester!~u@hyyensdmcrjxc.irc JOIN #chan") + (0.02 ":irc.foonet.org 353 tester = #chan :someone tester @fsbot alice bob observer") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester #chan +Cnt") + (0.02 ":irc.foonet.org 329 tester #chan 1715474476") + (0.09 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: And, uncle, so will I, an if I live.") + (0.03 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :bob: Speak to the people, and they pity her.")) + +((privmsg-observer 10 "PRIVMSG observer :hi") + (0.04 ":observer!~u@hyyensdmcrjxc.irc PRIVMSG tester :hi?") + (0.07 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :To ask of whence you are: report it.")) + +((quit 10 "QUIT :\2ERC\2") + (0.03 ":tester!~u@hyyensdmcrjxc.irc QUIT :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)") + (0.03 "ERROR :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/base/renick/self/merge-query-b.eld b/test/lisp/erc/resources/base/renick/self/merge-query-b.eld new file mode 100644 index 00000000000..4d7581b3884 --- /dev/null +++ b/test/lisp/erc/resources/base/renick/self/merge-query-b.eld @@ -0,0 +1,48 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK dummy")) +((user 10 "USER user 0 * :unknown") + (0.01 ":irc.foonet.org 001 dummy :Welcome to the foonet IRC Network dummy") + (0.01 ":irc.foonet.org 002 dummy :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 dummy :This server was created Sun, 12 May 2024 00:41:10 UTC") + (0.00 ":irc.foonet.org 004 dummy irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.03 ":irc.foonet.org 005 dummy AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.03 ":irc.foonet.org 005 dummy KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 dummy draft/CHATHISTORY=25 :are supported by this server") + (0.00 ":irc.foonet.org 251 dummy :There are 0 users and 6 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 dummy 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 dummy 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 dummy 2 :channels formed") + (0.00 ":irc.foonet.org 255 dummy :I have 6 clients and 0 servers") + (0.00 ":irc.foonet.org 265 dummy 6 6 :Current local users 6, max 6") + (0.00 ":irc.foonet.org 266 dummy 6 6 :Current global users 6, max 6") + (0.03 ":irc.foonet.org 422 dummy :MOTD File is missing") + (0.00 ":irc.foonet.org 221 dummy +i") + (0.00 ":irc.foonet.org NOTICE dummy :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode-user 10 "MODE dummy +i")) + +((join-chan 10 "JOIN #chan") + (0.01 ":irc.foonet.org 221 dummy +i") + (0.00 ":dummy!~u@hyyensdmcrjxc.irc JOIN #chan") + (0.02 ":irc.foonet.org 353 dummy = #chan :@fsbot alice bob observer someone dummy") + (0.01 ":irc.foonet.org 366 dummy #chan :End of NAMES list") + (0.00 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :dummy, welcome!") + (0.01 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :dummy, welcome!")) + +((mode-chan 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 dummy #chan +Cnt") + (0.02 ":irc.foonet.org 329 dummy #chan 1715474476") + (0.09 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: Indeed, sir, he that sleeps feels not the toothache; but a man that were to sleep your sleep, and a hangman to help him to bed, I think he would change places with his officer; for look you, sir, you know not which way you shall go.") + (0.03 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :bob: Pray you, sir, deliver me this paper.")) + +((privmsg-observer 10 "PRIVMSG observer :hola") + (0.01 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: In manner and form following, sir; all those three: I was seen with her in the manor-house, sitting with her upon the form, and taken following her into the park; which, put together, is, in manner and form following. Now, sir, for the manner,it is the manner of a man to speak to a woman, for the form,in some form.") + (0.05 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :In Isbel's case and mine own. Service is no heritage; and I think I shall never have the blessing of God till I have issue o' my body, for they say barnes are blessings.") + (0.01 ":observer!~u@hyyensdmcrjxc.irc PRIVMSG dummy :whodis?") + (0.02 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: Have here bereft my brother of his life.")) + +((nick-tester 10 "NICK tester") + (0.02 ":dummy!~u@hyyensdmcrjxc.irc NICK tester") + + (0.04 ":alice!~u@zb3s8yrduykma.irc PRIVMSG #chan :bob: You have too courtly a wit for me: I'll rest.") + (0.07 ":bob!~u@zb3s8yrduykma.irc PRIVMSG #chan :alice: And abstinence engenders maladies.")) commit ab78cbfabc856b0f9c069ab42ad8827cdaa499ce Author: F. Jason Park Date: Thu May 23 20:50:20 2024 -0700 Mention if an ERC module is local in its doc string * lisp/erc/erc-common.el (erc--assemble-toggle) (define-erc-module): Update language of doc string to indicate if a module is local. * test/lisp/erc/erc-tests.el (define-erc-module--global) (define-erc-module--local) (define-erc-module--local/permanent-locals): Update expected output. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 4115e314b39..51a93bdaa50 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -216,7 +216,7 @@ instead of a `set' state, which precludes any actual saving." `(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 @@ Example: `(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))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 6a46246725e..f393402fe81 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3667,9 +3667,9 @@ (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 @@ -3724,10 +3724,10 @@ Some docstring." (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 @@ -3738,7 +3738,7 @@ Some docstring." (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") @@ -3751,7 +3751,7 @@ connection." (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") commit 1b633ea59ad7f27263bf2a74ecc0e7d048b5eab5 Author: F. Jason Park Date: Tue May 21 05:37:39 2024 -0700 Delete original speedbar frame in erc-nickbar-mode * lisp/erc/erc-speedbar.el (erc-speedbar-buttons): Disable `erc-nickbar-mode' when it's not displayed in a window. (erc-speedbar--highlight-self-and-ops): Check `status' slot of `erc-channel-user' object instead of calling accessors. (erc-speedbar--hidden-speedbar-frame) (erc-speedbar--emulate-speedbar): Add doc string. (erc-speedbar--handle-delete-frame): New function. (erc-speedbar--toggle-nicknames-sidebar): Remove function because its conditional logic was needlessly complicated and is no longer needed. (erc-speedbar--ensure): Create `speedbar-buffer' when needed, and delete the original frame, but still keep a reference to it in `erc-speedbar--hidden-speedbar-frame'. Set `dframe-delete-frame-function' to own handler. (erc-speedbar--shutting-down-p): Remove unused variable. (erc-speedbar--run-timer-on-post-insert) (erc-speedbar--prod-dframe-timer): Rename former to latter. Return nil, and accept any number of args. (erc-nickbar-mode, erc-nickbar-disable): Tear down completely when disabling, regardless of universal argument. This changes user-facing behavior that was originally introduced with this module as part of bug#63595. Run `erc-speedbar--prod-dframe-timer' on `erc-server-PONG-functions' as well as `erc-insert-post-hook' so that the panel will eventually update if no messages are being received. (erc-speedbar--dframe-controlled): Don't make frame visible because it's been deleted and was never made invisible. * test/lisp/erc/erc-scenarios-status-sidebar.el (erc-scenarios-status-sidebar--nickbar): Update assertions. diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index b156f61d5d9..9cde452be58 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -146,7 +146,10 @@ This will add a speedbar major display mode." (setq serverp (erc--server-buffer-p)) (setq chanp (erc-channel-p (erc-default-target))) (setq queryp (erc-query-buffer-p))) - (cond (serverp + (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 (erc-speedbar-insert-target buffer 0) @@ -288,15 +291,9 @@ composed or anonymous, or nil.") '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 +444,11 @@ The INDENT level is ignored." (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 +464,7 @@ The INDENT level is ignored." #'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 +484,32 @@ The INDENT level is ignored." (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 +520,45 @@ The INDENT level is ignored." ;; 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 +571,47 @@ The INDENT level is ignored." "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 +623,18 @@ file a bug report with \\[erc-bug]." (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/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 @@ (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 @@ ;; 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) commit 8c54a79ec10d21cfc961476d85db06b643260e38 Author: F. Jason Park Date: Sun May 19 23:04:49 2024 -0700 Return nil from more ERC response handlers * etc/ERC-NEWS: Mention that certain aberrant response handlers now return nil. * lisp/erc/erc-backend.el (define-erc-response-handler): Mention that body should explicitly return nil. (erc-server-PART) (erc-server-PING): Return nil. * lisp/erc/erc-sasl.el (erc-sasl--destroy): Return nil. * lisp/erc/erc.el (erc-display-message): Mention in doc string that the return value is undefined. (erc-kill-channel-hook): Fix package-version. * test/lisp/erc/erc-networks-tests.el (erc-networks--set-name): Ensure `erc--route-insertion' returns nil because this influences whether response-handler hooks continue running. * test/lisp/erc/erc-sasl-tests.el (erc-sasl-create-client-ecdsa): Fix regression that made test unusable, although it's still relatively useless and therefore skipped by default. * test/lisp/erc/erc-services-tests.el (erc-services-tests--auth-source-standard) (erc-services-tests--auth-source-announced): Clarify annotations. * test/lisp/erc/erc-tests.el (erc-message): Don't return non-nil in mocked `erc-display-message'. (erc-send-modify-hook): Shadow `erc-send-modify-hook' because `erc-stamp--date-mode' modifies it locally. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 62970f52396..acad0f03572 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -685,6 +685,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. +The goal is to guarantee that trailing members of response hooks, like +'erc-server-005-functions', have an opportunity to run after the +default handler. For now, certain default handlers that may have +previously returned non-nil, like 'erc-server-PONG' and +'erc-server-904', have been updated to return nil in all cases. + *** 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 ef99d762a07..90c46eadaf4 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1566,13 +1566,23 @@ This creates: `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. @@ -1902,7 +1912,8 @@ add things to `%s' instead." (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)))))) + nil) (define-erc-response-handler (PING) "Handle ping messages." nil @@ -1914,7 +1925,8 @@ add things to `%s' instead." (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 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 @@ This doesn't solicit or validate a suite of supported mechanisms." "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.el b/lisp/erc/erc.el index 9100ab5577d..3d73c33312a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3987,7 +3987,9 @@ As of ERC 5.6, assume third-party code will use this function 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)) @@ -9626,7 +9628,7 @@ See also `format-spec'." 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) 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-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-sasl-tests.el b/test/lisp/erc/erc-sasl-tests.el index afe55f522dd..9c6def9cb38 100644 --- a/test/lisp/erc/erc-sasl-tests.el +++ b/test/lisp/erc/erc-sasl-tests.el @@ -319,16 +319,27 @@ IRX9cyi2wdYg9mUUYyh9GKdBCYHGUJAiCA== :tags '(:unstable) ;; This is currently useless because it just roundtrips shelling out ;; to pkeyutl. - (ert-skip "Placeholder") + (ert-skip "Placeholder for manual debugging") (unless (executable-find "openssl") (ert-skip "System lacks openssl")) + (ert-with-temp-file keyfile :prefix "ecdsa_key" :suffix ".pem" :text erc-sasl-tests-ecdsa-key-file - (let* ((erc-server-current-nick "jilles") - (erc-sasl--options `((password . ,keyfile))) - (client (erc-sasl--create-client 'ecdsa-nist256p-challenge)) + + (erc-mode) + (erc--initialize-markers (point) nil) + (setq erc-server-process (make-process :name "sleep" + :buffer (current-buffer) + :command '("sleep" "1") + :noquery t) + erc-session-username "jilles") + (let ((erc-sasl-mechanism 'ecdsa-nist256p-challenge) + (erc-sasl-password keyfile)) + (erc-sasl-mode +1)) + + (let* ((client (erc-sasl--state-client erc-sasl--state)) (step (sasl-next-step client nil))) (ert-info ("Client's initial request") (should (equal (format "%S" [erc-sasl--ecdsa-first "jilles"]) diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el index 9bafba98dc6..126f6d7bbdd 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -70,7 +70,7 @@ (defun erc-services-tests--auth-source-standard (search) (setq search (erc-services-tests--wrap-search search)) - (ert-info ("Session wins") + (ert-info ("Session ID wins") (let ((erc-session-server "irc.gnu.org") (erc-server-announced-name "my.gnu.org") (erc-session-port 6697) @@ -92,9 +92,14 @@ (let ((erc-session-server "irc.gnu.org") (erc-server-announced-name "my.gnu.org") (erc-session-port 6697) - erc-network (erc-networks--id (erc-networks--id-create nil))) - (should (string= (funcall search :user "#chan") "baz"))))) + (should (string= (funcall search :user "#chan") "baz")))) + + (ert-info ("Dialed wins") + (let ((erc-session-server "irc.gnu.org") + (erc-session-port 6697) + (erc-networks--id (erc-networks--id-create nil))) + (should (string= (funcall search :user "#chan") "bar"))))) (defun erc-services-tests--auth-source-announced (search) (setq search (erc-services-tests--wrap-search search)) @@ -102,7 +107,8 @@ (erc-server-parameters '(("CHANTYPES" . "&#"))) (erc--target (erc--target-from-string "&chan"))) - (ert-info ("Announced prioritized") + ;; Pretend #chan is just some account name and not a channel. + (ert-info ("Host priorities reversed when target is local") (ert-info ("Announced wins") (let* ((erc-session-server "irc.gnu.org") @@ -113,7 +119,7 @@ (erc-networks--id (erc-networks--id-create nil))) (should (string= (funcall search :user "#chan") "baz")))) - (ert-info ("Peer next") + (ert-info ("Dialed next") (let* ((erc-server-announced-name "irc.gnu.org") (erc-session-port 6697) (erc-network 'GNU.chat) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 999d9f100c9..6a46246725e 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -330,6 +330,7 @@ (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) @@ -1268,6 +1269,7 @@ (should-not (erc--valid-local-channel-p "#chan")) (should (erc--valid-local-channel-p "&local"))))) +;; FIXME remove this because it serves no purpose. See bug#71178. (ert-deftest erc--restore-initialize-priors () (unless (>= emacs-major-version 28) (ert-skip "Lisp nesting exceeds `max-lisp-eval-depth'")) @@ -2533,7 +2535,7 @@ 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) commit 1a9128e0208d60f414401679d76f3722fa4085fd Author: João Távora Date: Mon May 27 16:58:48 2024 -0500 Eglot: run eglot-managed-mode-hook when turning off (bug#70958) * lisp/progmodes/eglot.el (eglot--managed-mode): Run eglot-managed-mode-hook. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 94b45abe1d8..edbe484157b 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2044,6 +2044,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (when eglot--current-flymake-report-fn (eglot--report-to-flymake nil) (setq eglot--current-flymake-report-fn nil)) + (run-hooks 'eglot-managed-mode-hook) (let ((server eglot--cached-server)) (setq eglot--cached-server nil) (when server commit a2ada9094824a673b441f082857c3e77347a1ff8 Author: Stefan Kangas Date: Mon May 27 22:38:28 2024 +0200 ; Fix thinko in my last change * lisp/progmodes/which-func.el (which-func-update-delay): Fix thinko. diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 870db91166a..28aacd335ba 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -111,7 +111,7 @@ activation of Which Function until Imenu is used for the first time." ;; Backwards-compatibility: if users had changed this before ;; `idle-update-delay' was declared obsolete, let's respect that. (with-suppressed-warnings ((obsolete idle-update-delay)) - (if (/= idle-update-delay 0.5) idle-update-delay 0.5)) + idle-update-delay) ; 0.5 "Idle time delay before `which-function-mode` updates its display. When point moves, wait this many seconds after Emacs becomes idle before doing an update." commit 509e7f877baca1df25274f2e0e861d4499dfc25d Author: Andrea Corallo Date: Mon May 27 17:38:22 2024 +0200 * Rework 'comp-normalize-valset' (bug#71116) * lisp/emacs-lisp/comp-cstr.el (comp-normalize-valset): Rework to improve consistency. diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index b13c63a2a08..0b34cf8098c 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -231,20 +231,22 @@ Return them as multiple value." (defun comp-normalize-valset (valset) "Sort and remove duplicates from VALSET then return it." - (cl-sort (cl-remove-duplicates valset :test #'eq) - (lambda (x y) - (cond - ((and (symbolp x) (symbolp y)) - (string< x y)) - ((and (symbolp x) (not (symbolp y))) - t) - ((and (not (symbolp x)) (symbolp y)) - nil) - ((or (consp x) (consp y) - nil)) - (t - (< (sxhash-equal x) - (sxhash-equal y))))))) + ;; Sort valset as much as possible (by type and by value for symbols + ;; and strings) to increase cache hits. But refrain to use + ;; `sxhash-equal' to be reproducible across on different builds. + (cl-loop + with vals = (cl-remove-duplicates valset :test #'eq) + with type-val = (cl-loop + for type in (cl-remove-duplicates (mapcar #'cl-type-of vals) + :test #'eq) + collect (cons type nil)) + for x in vals + do (push x (cdr (assq (cl-type-of x) type-val))) + finally return (cl-loop + for (type . values) in (cl-sort type-val #'string< :key #'car) + append (if (memq type '(symbol string)) + (cl-sort values #'string<) + values)))) (defun comp-union-valsets (&rest valsets) "Union values present into VALSETS." commit 2cadad6f8ce47921cb014d2c5dd3e897e85c47ce Author: Juri Linkov Date: Mon May 27 21:18:17 2024 +0300 minibuffer-allow-text-properties can be buffer-local and affects completions * doc/lispref/minibuf.texi (Text from Minibuffer): Mention that minibuffer-allow-text-properties can be let-bound or buffer-local in the minibuffer. Correct the description of minibuffer-allow-text-properties to explain what it did even before applying code changes in this patch. Remove wrong example for read-no-blanks-input. * lisp/imenu.el (imenu--completion-buffer): Set buffer-local minibuffer-allow-text-properties to t. (imenu--completion-buffer): Get text property 'imenu-choice'. (imenu--flatten-index-alist): Propertize annotation with text property 'imenu-choice'. * lisp/simple.el (choose-completion): Don't remove text properties from the returned completion string since the value of minibuffer-allow-text-properties is already respected in completion--replace. * src/minibuf.c (read_minibuf): Preserve text properties not only when allow_props is non-nil but also in case when minibuffer_allow_text_properties is non-nil. (Fread_from_minibuffer): Mention in the docstring that minibuffer-allow-text-properties can be buffer-local in the minibuffer. (minibuffer-allow-text-properties): Improve docstring to describe when text properties are discarded. https://lists.gnu.org/archive/html/emacs-devel/2024-05/msg00949.html diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8f2d0d702f9..73ff170401e 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -185,7 +185,8 @@ a starting position in the history list as well. @xref{Minibuffer History}. If the variable @code{minibuffer-allow-text-properties} is -non-@code{nil}, then the string that is returned includes whatever text +non-@code{nil}, either let-bound or buffer-local in the minibuffer, +then the string that is returned includes whatever text properties were present in the minibuffer. Otherwise all the text properties are stripped when the value is returned. (By default this variable is @code{nil}.) @@ -352,28 +353,32 @@ See @code{read-regexp} above for details of how these values are used. @defvar minibuffer-allow-text-properties If this variable is @code{nil}, the default, then -@code{read-from-minibuffer} and @code{read-string} strip all text -properties from the minibuffer input before returning it. However, -@code{read-no-blanks-input} (see below), as well as -@code{read-minibuffer} and related functions (@pxref{Object from -Minibuffer,, Reading Lisp Objects With the Minibuffer}), and all -functions that do minibuffer input with completion, remove the -@code{face} property unconditionally, regardless of the value of this +@code{read-from-minibuffer} and all functions that do minibuffer input +strip all text properties from the minibuffer input before returning it. + +However, @code{read-minibuffer} and related functions (@pxref{Object +from Minibuffer,, Reading Lisp Objects With the Minibuffer}), remove the +text properties unconditionally, regardless of the value of this variable. -If this variable is non-@code{nil}, most text properties on strings -from the completion table are preserved---but only on the part of the -strings that were completed. +If this variable is non-@code{nil}, either let-bound or buffer-local in +the minibuffer, then @code{read-from-minibuffer}, @code{read-string}, +and all related functions preserve text properties. But functions that +do minibuffer input with completion remove the @code{face} property +while preserving other text properties. @lisp -(let ((minibuffer-allow-text-properties t)) - (completing-read "String: " (list (propertize "foobar" 'data 'zot)))) -=> #("foobar" 3 6 (data zot)) +(minibuffer-with-setup-hook + (lambda () + (setq-local minibuffer-allow-text-properties t)) + (completing-read + "String: " (list (propertize "foobar" 'face 'baz 'data 'zot)))) +=> #("foobar" 0 6 (data zot)) @end lisp In this example, the user typed @samp{foo} and then hit the @kbd{TAB} -key, so the text properties are only preserved on the last three -characters. +key, and all text properties are preserved except the @code{face} +property. @end defvar @vindex minibuffer-mode-map @@ -433,18 +438,6 @@ function, and passes the value of the @code{minibuffer-local-ns-map} keymap as the @var{keymap} argument for that function. Since the keymap @code{minibuffer-local-ns-map} does not rebind @kbd{C-q}, it @emph{is} possible to put a space into the string, by quoting it. - -This function discards text properties, regardless of the value of -@code{minibuffer-allow-text-properties}. - -@smallexample -@group -(read-no-blanks-input @var{prompt} @var{initial}) -@equiv{} -(let (minibuffer-allow-text-properties) - (read-from-minibuffer @var{prompt} @var{initial} minibuffer-local-ns-map)) -@end group -@end smallexample @end defun @c Slightly unfortunate name, suggesting it might be related to the diff --git a/etc/NEWS b/etc/NEWS index ea8729f3939..abd347dfcb2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2044,6 +2044,17 @@ UTF-8 byte sequence, and the optional parameter MULTIBYTE of 'dbus-string-to-byte-array' should be a regular Lisp string, not a unibyte string. ++++ +** 'minibuffer-allow-text-properties' now can be set buffer-local. +'read-from-minibuffer' and functions that use it can take the +buffer-local value from the minibuffer. + ++++ +** 'minibuffer-allow-text-properties' also affects completions. +When it has a non-nil value, then completion functions like +'completing-read' don't discard text properties from the returned +completion candidate. + * Lisp Changes in Emacs 30.1 diff --git a/lisp/imenu.el b/lisp/imenu.el index ea097f5da3a..93d84106ec1 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -752,6 +752,7 @@ Return one of the entries in index-alist or nil." ;; Display the completion buffer. (minibuffer-with-setup-hook (lambda () + (setq-local minibuffer-allow-text-properties t) (setq-local completion-extra-properties `( :category imenu ,@(when (eq imenu-flatten 'annotation) @@ -765,10 +766,12 @@ Return one of the entries in index-alist or nil." nil t nil 'imenu--history-list name))) (when (stringp name) - (setq choice (assoc name prepared-index-alist)) - (if (imenu--subalist-p choice) - (imenu--completion-buffer (cdr choice) prompt) - choice)))) + (or (get-text-property 0 'imenu-choice name) + (progn + (setq choice (assoc name prepared-index-alist)) + (if (imenu--subalist-p choice) + (imenu--completion-buffer (cdr choice) prompt) + choice)))))) (defun imenu--mouse-menu (index-alist event &optional title) "Let the user select from a buffer index from a mouse menu. @@ -798,7 +801,9 @@ Returns t for rescan and otherwise an element or subelement of INDEX-ALIST." (new-prefix (and concat-names (if prefix (concat prefix imenu-level-separator name) - name)))) + (if (eq imenu-flatten 'annotation) + (propertize name 'imenu-choice item) + name))))) (cond ((not (imenu--subalist-p item)) (list (cons (if (and (eq imenu-flatten 'annotation) prefix) diff --git a/lisp/simple.el b/lisp/simple.el index 88a4a388518..44197c3189a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10144,9 +10144,9 @@ minibuffer, but don't quit the completions window." (completion-no-auto-exit (if no-exit t completion-no-auto-exit)) (choice (if choose-completion-deselect-if-after - (if-let ((str (get-text-property (posn-point (event-start event)) 'completion--string))) - (substring-no-properties str) - (error "No completion here")) + (or (get-text-property (posn-point (event-start event)) + 'completion--string) + (error "No completion here")) (save-excursion (goto-char (posn-point (event-start event))) (let (beg) @@ -10161,8 +10161,7 @@ minibuffer, but don't quit the completions window." (setq beg (or (previous-single-property-change beg 'completion--string) beg)) - (substring-no-properties - (get-text-property beg 'completion--string))))))) + (get-text-property beg 'completion--string)))))) (unless (buffer-live-p buffer) (error "Destination buffer is dead")) diff --git a/src/minibuf.c b/src/minibuf.c index 9c1c86680d4..1dfee0a59c9 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -563,7 +563,8 @@ If the current buffer is not a minibuffer, return its entire contents. */) DEFALT specifies the default value for the sake of history commands. - If ALLOW_PROPS, do not throw away text properties. + If ALLOW_PROPS or `minibuffer-allow-text-properties' (possibly + buffer-local) is non-nil, do not throw away text properties. if INHERIT_INPUT_METHOD, the minibuffer inherits the current input method. */ @@ -928,7 +929,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* Make minibuffer contents into a string. */ Fset_buffer (minibuffer); - if (allow_props) + if (allow_props || minibuffer_allow_text_properties) val = Fminibuffer_contents (); else val = Fminibuffer_contents_no_properties (); @@ -1321,7 +1322,8 @@ Sixth arg DEFAULT-VALUE, if non-nil, should be a string, which is used Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits the current input method and the setting of `enable-multibyte-characters'. -If the variable `minibuffer-allow-text-properties' is non-nil, +If the variable `minibuffer-allow-text-properties' is non-nil + (either let-bound or buffer-local in the minibuffer), then the string which is returned includes whatever text properties were present in the minibuffer. Otherwise the value has no text properties. @@ -2464,9 +2466,10 @@ basic completion functions like `try-completion' and `all-completions'. */); DEFVAR_BOOL ("minibuffer-allow-text-properties", minibuffer_allow_text_properties, doc: /* Non-nil means `read-from-minibuffer' should not discard text properties. -This also affects `read-string', but it does not affect `read-minibuffer', -`read-no-blanks-input', or any of the functions that do minibuffer input -with completion; they always discard text properties. */); +The value could be let-bound or buffer-local in the minibuffer. +This also affects `read-string', or any of the functions that do +minibuffer input with completion, but it does not affect `read-minibuffer' +that always discards text properties. */); minibuffer_allow_text_properties = 0; DEFVAR_LISP ("minibuffer-prompt-properties", Vminibuffer_prompt_properties, commit 804f36d5abdbc38a4664a341aaea563195f79b03 Author: Michael Heerdegen Date: Sun May 26 16:31:26 2024 +0200 Don't let pp fall back to prin1 for conses * lisp/emacs-lisp/pp.el (pp--insert-lisp): Don't `prin1' non-list conses; use our pp function for cons and list printing `pp--format-list' instead. diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 3176ee42533..e550bd4d689 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -491,7 +491,7 @@ the bounds of a region containing Lisp code to pretty-print." (pp--insert-lisp (cadr sexp))) (pp--format-list sexp)))) (t - (prin1 sexp (current-buffer))))) + (pp--format-list sexp)))) ;; Print some of the smaller integers as characters, perhaps? (integer (if (<= ?0 sexp ?z) commit 3580dc155c3c9f48fb1b7855b4d858eec3948dfb Author: Michael Heerdegen Date: Sun May 12 19:58:14 2024 +0200 Don't try to pretty-print non-lists as binding list * lisp/emacs-lisp/pp.el (pp--format-definition): Ensure that what we try to print as a list of bindings has an appropriate format. This avoids raising an error for SEXPs like (let X Y) inside `pcase' forms where our heuristic expects a binding list in the X position. diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index d578e685ca9..3176ee42533 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -577,7 +577,8 @@ the bounds of a region containing Lisp code to pretty-print." (unless (consp edebug) (setq edebug nil)) (if (and (consp (car edebug)) - (eq (caar edebug) '&rest)) + (eq (caar edebug) '&rest) + (proper-list-p (car sexp))) (pp--insert-binding (pop sexp)) (if (null (car sexp)) (insert "()") commit db6599818fa6ca7325c482b4aa1ce564688469ef Author: Eli Zaretskii Date: Mon May 27 14:54:01 2024 +0300 ; * src/lread.c (syms_of_lread) : Doc fix (bug#70914). diff --git a/src/lread.c b/src/lread.c index f5e7b2fc0fe..05642f011b1 100644 --- a/src/lread.c +++ b/src/lread.c @@ -6096,13 +6096,12 @@ that are loaded before your customizations are read! */); load_prefer_newer = 0; DEFVAR_BOOL ("load-no-native", load_no_native, - doc: /* Non-nil means not to load a native code automatically unless -explicitly requested. + doc: /* Non-nil means not to load native code unless explicitly requested. -To load explicitly a `.eln' file use (load FILE) where FILE is the -filename of the eln file. -`load-no-native' non-nil will make Emacs not load native code through -`require'. */); +To load a `.eln' file when this variable is non-nil, use `(load FILE)' +where FILE is the filename of the eln file, including the .eln extension. +`load-no-native' non-nil will also make Emacs not load native code +through `require'. */); load_no_native = false; /* Vsource_directory was initialized in init_lread. */ commit 435df51d1e7bffd768de15a6c91b7d6f7baa5cbf Author: Po Lu Date: Mon May 27 17:59:36 2024 +0800 Fix minor issues in textconv.c * src/textconv.c (really_commit_text): Introduce a few additional debugging printouts. (locate_and_save_position_in_field): Fix typo. diff --git a/src/textconv.c b/src/textconv.c index 06d9af335c5..0e43bd9d458 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -632,6 +632,7 @@ really_commit_text (struct frame *f, EMACS_INT position, otherwise. */ mark = get_mark (); + TEXTCONV_DEBUG ("the mark is: %zd", mark); if (MARKERP (f->conversion.compose_region_start) || mark != -1) { /* Replace its contents. Set START and END to the start and end @@ -649,6 +650,9 @@ really_commit_text (struct frame *f, EMACS_INT position, end = max (mark, PT); } + TEXTCONV_DEBUG ("replacing text in composing region: %zd, %zd", + start, end); + /* If it transpires that the start of the compose region is not point, move point there. */ @@ -1204,7 +1208,7 @@ locate_and_save_position_in_field (struct frame *f, struct window *w, { TEXTCONV_DEBUG ("confined composing region to %td, %td", newstart, newend); - Fset_marker (f->conversion.compose_region_end, + Fset_marker (f->conversion.compose_region_start, make_fixed_natnum (newstart), Qnil); Fset_marker (f->conversion.compose_region_end, make_fixed_natnum (newend), Qnil); commit 8283f0ae4ad7648a5fd4988e10b75878f4f87771 Author: Andrea Corallo Date: Mon May 27 11:32:19 2024 +0200 ; * src/lread.c (load-no-native): Improve docstring. diff --git a/src/lread.c b/src/lread.c index 233f08b0727..f5e7b2fc0fe 100644 --- a/src/lread.c +++ b/src/lread.c @@ -6096,7 +6096,13 @@ that are loaded before your customizations are read! */); load_prefer_newer = 0; DEFVAR_BOOL ("load-no-native", load_no_native, - doc: /* Non-nil means not to load a .eln file when a .elc was requested. */); + doc: /* Non-nil means not to load a native code automatically unless +explicitly requested. + +To load explicitly a `.eln' file use (load FILE) where FILE is the +filename of the eln file. +`load-no-native' non-nil will make Emacs not load native code through +`require'. */); load_no_native = false; /* Vsource_directory was initialized in init_lread. */ commit 25f61f7f8f5432cb301b69ee8ea1825826c8469d Author: Stefan Kangas Date: Mon May 27 10:54:46 2024 +0200 ; Silence byte-compiler diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index e928999ab5e..870db91166a 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -110,7 +110,8 @@ activation of Which Function until Imenu is used for the first time." (defcustom which-func-update-delay ;; Backwards-compatibility: if users had changed this before ;; `idle-update-delay' was declared obsolete, let's respect that. - (if (/= idle-update-delay 0.5) idle-update-delay 0.5) + (with-suppressed-warnings ((obsolete idle-update-delay)) + (if (/= idle-update-delay 0.5) idle-update-delay 0.5)) "Idle time delay before `which-function-mode` updates its display. When point moves, wait this many seconds after Emacs becomes idle before doing an update." commit a212687e24fb6a7492db28e62070b03b43784660 Author: Stefan Kangas Date: Mon May 27 10:51:54 2024 +0200 Make `idle-update-delay` obsolete This user option was introduced in 2003, and was advertised as a general variable for a "delay before updating various things on the screen". But this has never been true: it was only used by 'which-function-mode', and, to make matters worse, users of that mode would basically never know that this user option existed without reading the code. Conversely, users that did find the user option would be surprised to see that it only took effect in 'which-func-mode'. The lack of other users of 'idle-update-delay' reveals that it has not been considered generally useful. Thus, it makes more sense to introduce a new mode specific user option `which-func-update-delay`, and to mark the old one obsolete. * lisp/simple.el (idle-update-delay): Make obsolete. * lisp/progmodes/which-func.el (which-func-update-delay): New defcustom. (which-function-mode): Use above new defcustom instead of 'idle-update-delay'. diff --git a/etc/NEWS b/etc/NEWS index d058acc3572..ea8729f3939 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1071,6 +1071,13 @@ function name is displayed. The default is 'mode' to display in the mode line. 'header' will display in the header line; 'mode-and-header' displays in both the header line and mode line. ++++ +*** New user option 'which-func-update-delay'. +This replaces the user option 'idle-update-delay', which was previously +used to control the delay before `which-function-mode` updated its +display. The user option 'idle-update-delay', which was only used by +Which Function mode, is now obsolete. + ** Tramp +++ diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index b36e13104e3..e928999ab5e 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -107,6 +107,17 @@ long time to send the information, you can use this option to delay activation of Which Function until Imenu is used for the first time." :type 'integer) +(defcustom which-func-update-delay + ;; Backwards-compatibility: if users had changed this before + ;; `idle-update-delay' was declared obsolete, let's respect that. + (if (/= idle-update-delay 0.5) idle-update-delay 0.5) + "Idle time delay before `which-function-mode` updates its display. +When point moves, wait this many seconds after Emacs becomes idle before +doing an update." + :type 'number + :group 'display + :version "30.1") + (defvar which-func-keymap (let ((map (make-sparse-keymap))) (define-key map [mode-line mouse-1] 'beginning-of-defun) @@ -293,9 +304,9 @@ in certain major modes." (cancel-timer which-func-update-timer)) (setq which-func-update-timer nil) (when which-function-mode - ;;Turn it on. + ;; Turn it on. (setq which-func-update-timer - (run-with-idle-timer idle-update-delay t #'which-func-update))) + (run-with-idle-timer which-func-update-delay t #'which-func-update))) (dolist (buf (buffer-list)) (with-current-buffer buf (which-func--header-line-remove) diff --git a/lisp/simple.el b/lisp/simple.el index ae8a824cb54..88a4a388518 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -37,6 +37,7 @@ (defvar compilation-current-error) (defvar compilation-context-lines) +(make-obsolete-variable 'idle-update-delay 'which-func-update-delay "30.1") (defcustom idle-update-delay 0.5 "Idle time delay before updating various things on the screen. Various Emacs features that update auxiliary information when point moves