From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync Date: Thu, 05 Sep 2024 14:58:52 -0700 Message-ID: <87mskl3gpv.fsf__46752.9249306367$1725573630$gmane$org@neverwas.me> References: <87plq3551s.fsf@neverwas.me> <87msl123y6.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="27616"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 72736@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Sep 06 00:00:22 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1smKWa-0006yu-Py for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 06 Sep 2024 00:00:21 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1smKWG-0005yP-Iq; Thu, 05 Sep 2024 18:00:00 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1smKWD-0005y1-QV for bug-gnu-emacs@gnu.org; Thu, 05 Sep 2024 17:59:57 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1smKWD-0006dJ-Cu for bug-gnu-emacs@gnu.org; Thu, 05 Sep 2024 17:59:57 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:References:In-Reply-To:From:To:Subject; bh=29l8sIXpfSACMVX+8mXsroRngmtjOm4oU5GqOFt36fE=; b=epHNCn/G2ZrGnAs+Mf6k4VvwbHXAGJz+d8CPKdNLByCYkJ0FYxetXit0lJx1UXOIfvQM8aV7atxOT8MOfamMgbwX03LdfrStaU6tuPCIKQ2346bCEw2ix26nks2Wkq1ngLhMoiJjhiO8s5rx8fE983/YHD6IfLGGsAROtqwwEXwSq9vOLzJ8aRuIXCfLlJrITKsoik83EXcjCWIjgu6njYCf9G9ELCir1KBlMSfu9SIY/MTKrtMVo8AryoVAqoNk9OSwQE2kBt1taNYJWGOu3JE4YMJGelcBza5HpAhtRDh3c/pyUtLM2Vrehq8U1DsibnJJunD938XA5x1kJ52eCg==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1smKXG-00060a-Sy for bug-gnu-emacs@gnu.org; Thu, 05 Sep 2024 18:01:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 05 Sep 2024 22:01:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72736 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 72736-submit@debbugs.gnu.org id=B72736.172557360422825 (code B ref 72736); Thu, 05 Sep 2024 22:01:02 +0000 Original-Received: (at 72736) by debbugs.gnu.org; 5 Sep 2024 22:00:04 +0000 Original-Received: from localhost ([127.0.0.1]:38474 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1smKWK-0005w5-PB for submit@debbugs.gnu.org; Thu, 05 Sep 2024 18:00:04 -0400 Original-Received: from mail-108-mta14.mxroute.com ([136.175.108.14]:39487) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1smKWJ-0005vj-I4 for 72736@debbugs.gnu.org; Thu, 05 Sep 2024 18:00:03 -0400 Original-Received: from filter006.mxroute.com ([136.175.111.3] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta14.mxroute.com (ZoneMTA) with ESMTPSA id 191c4329a410003e01.001 for <72736@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Thu, 05 Sep 2024 21:58:56 +0000 X-Zone-Loop: b17ece55c4ee197c3f75d7164ba5cfd8f7a027065eb3 X-Originating-IP: [136.175.111.3] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=29l8sIXpfSACMVX+8mXsroRngmtjOm4oU5GqOFt36fE=; b=jSm6sw3P2kWXMWBHYugfAmT/W2 3ai5RsYS/1HztFqw1wVBMI4LmXYJngjSyUPEuqdwDJ2QxHaJz0AfJDgt+x76Yx2C8gj5opIQOa2TE x99ltJEpG+niwRvX56hkkT6j8Tlpbp2sLa4CDmWHmgkKCEfCAlznT3/SQ+ZigzlXAYEiCYGH+w4Z1 NVj7KLQlTjuOObKVly1gl86xZfRel87U1SYi660GZZJAMYC6Me4sNCyfODX16EvIBZN7wNGwUxw6k j73QrWnjiBl0xRREIxNDdA9bnL59+0SrRGguDgROOrIpG74Oy5fCSSE+Xrb1kyY0xGXmuA9naQlxS /iMZloKA==; In-Reply-To: <87msl123y6.fsf@neverwas.me> (J. P.'s message of "Sat, 24 Aug 2024 11:03:45 -0700") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:291295 Archived-At: --=-=-= Content-Type: text/plain v2. Only update `erc-channel-banlist' if initialized. Redo shared hook mechanism for buffer truncation. "J.P." writes: > Both for clarity and compatibility with the current behavior, I think we > should instead keep `erc-channel-banlist' empty (and locally unbound) > until formally initialized for a given channel within an ERC session. An > easy way to do that would be to guard the above like so: > > (when erc--channel-banlist-synchronized-p > (erc--banlist-update state arg)) I've done this in the latest set of patches (attached). I've also tacked on a reworking of the rather awkward hook mechanism by which modules can run code prior to a buffer's truncation. This was previously handled by the abnormal hook `erc--pre-clear-functions', which was run by both the `truncate' module and the `erc-cmd-CLEAR' slash command. Part of this overhaul involved deferring most of the code that formerly ran on `erc-insert-done-hook' to a per-response, ephemeral `erc-timing-hook' member. The main reason for this move is to escape the insertion related context imposed on such hooks by response-handling code further back in the call stack. We're not inserting anything, so it makes little sense to abuse such hooks for their side effects, which is a design flaw and a common antipattern (though an excusable one, seeing as there's no real sensible alternative). Regardless, deferring to a known call site over a limited extent via `erc-timer-hook' seems far more predictable and manageable than relying on `run-at-time' or similar. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From 5297613ac24bfbee5ed43f01875c08c147b7f618 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 5 Sep 2024 14:22:11 -0700 Subject: [PATCH 0/6] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (6): [5.6.1] ; Rename internal variable in erc-fill [5.6.1] Store one string per user in erc--spkr msg prop [5.6.1] Bind current erc-response around all handlers [5.6.1] Fix inconsistent handling of ban lists in ERC [5.6.1] Fix overlooked case in erc--get-inserted-msg-beg-at [5.6.1] Redo ERC truncation and /CLEAR hook mechanism etc/ERC-NEWS | 9 + lisp/erc/erc-backend.el | 10 +- lisp/erc/erc-fill.el | 14 +- lisp/erc/erc-log.el | 10 +- lisp/erc/erc-pcomplete.el | 8 + lisp/erc/erc-stamp.el | 101 ++++-- lisp/erc/erc-truncate.el | 103 +++--- lisp/erc/erc.el | 299 ++++++++++-------- test/lisp/erc/erc-fill-tests.el | 2 +- test/lisp/erc/erc-goodies-tests.el | 5 + test/lisp/erc/erc-scenarios-log.el | 22 +- test/lisp/erc/erc-tests.el | 94 +++++- .../erc/resources/erc-scenarios-common.el | 2 +- test/lisp/erc/resources/erc-tests-common.el | 16 +- 14 files changed, 474 insertions(+), 221 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5dd72e6f1b3..0b5385f0589 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -17,7 +17,7 @@ GNU Emacs since Emacs version 22.1. ** Reliable library access for ban lists. Say goodbye to continually running "/BANLIST" for programmatic purposes. Modules can instead use the function 'erc-sync-banlist' to -guarantee that the variable 'erc-channel-banlist' remain synced for +guarantee that the variable 'erc-channel-banlist' remains synced for the remainder of an IRC session. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index fa9d2071ccd..6f3d51f6937 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -547,6 +547,8 @@ fill-wrap (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) + (add-function :after (local 'erc--clear-function) + #'erc-stamp--redo-right-stamp-post-clear '((depth . 50))) (erc-stamp--display-margin-mode +1) (visual-line-mode +1)) ((visual-line-mode -1) @@ -557,6 +559,8 @@ fill-wrap (kill-local-variable 'erc-fill--wrap-last-msg) (kill-local-variable 'erc--inhibit-prompt-display-property-p) (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) + (remove-function (local 'erc--clear-function) + #'erc-stamp--redo-right-stamp-post-clear) (remove-hook 'erc--refresh-prompt-hook #'erc-fill--wrap-indent-prompt t) (remove-hook 'erc-button--prev-next-predicate-functions diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 66420662c23..6bb240f56d7 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -231,7 +231,7 @@ log (add-hook 'erc-part-hook #'erc-conditional-save-buffer) ;; append, so that 'erc-initialize-log-marker runs first (add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append) - (add-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs 50) + ;; FIXME use proper local "setup" function and major-mode hook. (dolist (buffer (erc-buffer-list)) (erc-log-setup-logging buffer)) (erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs)) @@ -244,7 +244,6 @@ log (remove-hook 'erc-quit-hook #'erc-conditional-save-queries) (remove-hook 'erc-part-hook #'erc-conditional-save-buffer) (remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging) - (remove-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs) (dolist (buffer (erc-buffer-list)) (erc-log-disable-logging buffer)) (erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs))) @@ -259,6 +258,8 @@ erc-log-setup-logging (auto-save-mode -1) (setq buffer-file-name nil) (add-hook 'write-file-functions #'erc-save-buffer-in-logs nil t) + (add-function :before (local 'erc--clear-function) + #'erc-log--save-on-clear '((depth . 50))) (when erc-log-insert-log-on-open (ignore-errors (save-excursion @@ -271,6 +272,7 @@ erc-log-disable-logging "Disable logging in BUFFER." (when (erc-logging-enabled buffer) (with-current-buffer buffer + (remove-function (local 'erc--clear-function) #'erc-log--save-on-clear) (setq buffer-offer-save nil erc-enable-logging nil)))) @@ -415,6 +417,7 @@ erc-save-buffer-in-logs (widen) ;; early on in the initialization, don't try and write the log out (when (and (markerp erc-last-saved-position) + (null erc--insert-marker) ; suppress when splicing (> erc-insert-marker (1+ erc-last-saved-position))) (let ((start (1+ (marker-position erc-last-saved-position))) (end (marker-position erc-insert-marker))) @@ -446,6 +449,9 @@ erc-save-buffer-in-logs (set-buffer-modified-p nil)))))) t) +(defun erc-log--save-on-clear (_ end) + (erc-save-buffer-in-logs end)) + ;; This is a kludge to avoid littering erc-truncate.el with forward ;; declarations needed only for a corner-case compatibility check. (defun erc-log--call-when-logging-enabled-sans-module (fn) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index bebc1d0be38..7d773c8f4b2 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -182,13 +182,11 @@ stamp (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) ((remove-hook 'erc-mode-hook #'erc-stamp--setup) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear) (erc-buffer-do #'erc-stamp--setup))) (defvar erc-stamp--invisible-property nil @@ -707,7 +705,8 @@ erc-stamp--find-insertion-point ;; Continue searching after encountering a message without a ;; timestamp because date stamps must be unique, and ;; "Re-establishing connection" messages should have stamps. - (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) + (while-let ((pp (max (1- p) (point-min))) + (q (previous-single-property-change pp 'erc--ts)) (qq (erc--get-inserted-msg-beg q)) (ts (get-text-property qq 'erc--ts)) ((not (time-less-p ts target-time)))) @@ -753,7 +752,7 @@ erc-stamp--defer-date-insertion-on-post-modify (set-marker marker (point-min)) (set-marker-insertion-type marker t) (erc--hide-message 'timestamp)) - ,@erc-insert-post-hook)) + ,@(ensure-list erc-insert-post-hook))) (erc-insert-timestamp-function #'erc-stamp--propertize-left-date-stamp) (pos (erc-stamp--find-insertion-point marker aligned)) @@ -980,11 +979,16 @@ erc-stamp--add-csf-on-post-modify (defun erc-stamp--setup () "Enable or disable buffer-local `erc-stamp-mode' modifications." (if erc-stamp-mode - (erc-stamp--manage-local-options-state) + (progn + (erc-stamp--manage-local-options-state) + (add-function :around (local 'erc--clear-function) + #'erc-stamp--reset-on-clear '((depth . 40)))) (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) (erc-stamp--manage-local-options-state)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' + (remove-function (local 'erc--clear-function) + #'erc-stamp--reset-on-clear) (kill-local-variable 'erc-stamp--last-stamp) (kill-local-variable 'erc-timestamp-last-inserted) (kill-local-variable 'erc-timestamp-last-inserted-right) @@ -1023,6 +1027,8 @@ erc-toggle-timestamps (defvar-local erc-stamp--last-stamp nil) +;; FIXME rename this to avoid confusion with IRC messages. +;; Something like `erc-stamp--on-clear-echo-area-message'. (defun erc-stamp--on-clear-message (&rest _) "Return `dont-clear-message' when operating inside the same stamp." (and erc-stamp--last-stamp erc-echo-timestamps @@ -1052,25 +1058,74 @@ erc-echo-timestamp (defun erc--echo-ts-csf (_window _before dir) (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc--ts))) -(defun erc-stamp--update-saved-position (&rest _) - (remove-hook 'erc-stamp--insert-date-hook - #'erc-stamp--update-saved-position t) - (move-marker erc-last-saved-position (1- (point-max)))) - -(defun erc-stamp--reset-on-clear (pos) - "Forget last-inserted stamps when POS is at insert marker. +(defun erc-stamp--redo-right-stamp-post-clear (_ end) + "Append new right stamp to first inserted message after END." + ;; During truncation, the last existing right stamp is often deleted + ;; regardless of `erc-timestamp-only-if-changed-flag'. As of ERC 5.6, + ;; recreating inserted messages from scratch isn't doable. (Although, + ;; attempting surgery like this is likely unwise.) + (when-let ((erc-stamp--date-mode) + ((< end erc-insert-marker)) + (bounds (erc--get-inserted-msg-bounds (1+ end))) + (ts (get-text-property (car bounds) 'erc--ts)) + (format (with-suppressed-warnings + ((obsolete erc-timestamp-format-right)) + (or erc-timestamp-format-right erc-timestamp-format))) + (rendered (erc-format-timestamp ts format)) + ((not (equal rendered erc-timestamp-last-inserted-right))) + (erc--msg-props (map-into `((erc--ts . ,ts)) 'hash-table))) + (save-excursion + (save-restriction + (let ((erc-timestamp-last-inserted erc-timestamp-last-inserted) + (erc-timestamp-last-inserted-right + erc-timestamp-last-inserted-right)) + (narrow-to-region (car bounds) (cdr bounds)) + (erc-add-timestamp)))))) + +(defun erc-stamp--reset-on-clear (orig beg end) + "Forget stamps older than POS. And discard stale references in `erc-stamp--date-stamps'." - (when erc-stamp--date-stamps - (setq erc-stamp--date-stamps - (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos)) - erc-stamp--date-stamps))) - (when (= pos (1- erc-insert-marker)) - (when erc-stamp--date-mode - (add-hook 'erc-stamp--insert-date-hook - #'erc-stamp--update-saved-position 0 t)) - (setq erc-timestamp-last-inserted nil - erc-timestamp-last-inserted-left nil - erc-timestamp-last-inserted-right nil))) + (let (culled) + (when erc-stamp--date-stamps + (setq erc-stamp--date-stamps + ;; This assumes `seq-filter' visits items in order. + (seq-filter (lambda (o) + (or (> (erc-stamp--date-marker o) end) + (ignore + (set-marker (erc-stamp--date-marker o) nil) + (push o culled)))) + erc-stamp--date-stamps))) + (funcall orig beg end) + (when-let ((culled) + ((not (or (erc--memq-msg-prop 'erc--skip 'stamp) + (and erc--msg-prop-overrides + (memq 'stamp + (alist-get 'erc--skip + erc--msg-prop-overrides)))))) + (ct (erc-stamp--date-ts (car culled)))) + (cl-assert erc-stamp--date-mode) + (let ((hook (make-symbol "temporary-hook")) + (rendered (erc-stamp--format-date-stamp ct)) + (want-rhs-p (= end erc-insert-marker))) + ;; Object successfully removed from model but snapshot remains. + (cl-assert (null (cl-find rendered erc-stamp--date-stamps + :test #'string= + :key #'erc-stamp--date-str))) + ;; When it's midnight, `rendered' may still be yesterday while + ;; `erc-timestamp-last-inserted-left' is already today. + (let* ((data (make-erc-stamp--date :ts ct :str rendered)) + (erc-stamp--deferred-date-stamp data) + (erc-timestamp-last-inserted-left nil)) + (erc-stamp--defer-date-insertion-on-post-modify hook) + (set-marker (erc-stamp--date-marker data) end) + (run-hooks hook) + (unless (= ?\n (char-after erc-last-saved-position)) + (cl-assert (or erc--called-as-input-p (null erc--msg-props))) + (cl-assert (= erc-last-saved-position erc-insert-marker)) + (set-marker erc-last-saved-position (1- erc-insert-marker)))) + (when want-rhs-p + (setq erc-timestamp-last-inserted-right nil + erc-timestamp-last-inserted nil)))))) (defun erc-stamp--dedupe-date-stamps (old-stamps) "Update `erc-stamp--date-stamps' from its counterpart OLD-STAMPS. diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 4b602074ebb..c471d7a72ad 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -38,7 +38,7 @@ erc-truncate (defcustom erc-max-buffer-size 30000 "Maximum size in chars of each ERC buffer. Used only when auto-truncation is enabled. -\(see `erc-truncate-buffer' and `erc-insert-post-hook')." +\(Also see `erc-truncate-buffer'.)" :type 'integer) ;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -49,10 +49,31 @@ truncate tracking heavy-traffic channels." ;;enable ((add-hook 'erc-insert-done-hook #'erc-truncate-buffer) - (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging)) + (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) + (add-hook 'erc-mode-hook #'erc-truncate--setup) + (unless erc--updating-modules-p (erc-buffer-do #'erc-truncate--setup))) ;; disable ((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer) - (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging))) + (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) + (remove-hook 'erc-mode-hook #'erc-truncate--setup) + (erc-buffer-do #'erc-truncate--setup))) + +(defvar-local erc-truncate--buffer-size nil + "Temporary buffer-local override for `erc-max-buffer-size'.") + +(defun erc-truncate--setup () + "Enable or disable buffer-local `erc-truncate-mode' modifications." + (if erc-truncate-mode + (progn + (when-let ((priors (or erc--server-reconnecting erc--target-priors)) + (val (alist-get 'erc-truncate--buffer-size priors))) + (setq erc-truncate--buffer-size val)) + (add-function :before (local 'erc--clear-function) + #'erc-truncate--inhibit-when-local-and-interactive + '((depth . 20)))) + (remove-function (local 'erc--clear-function) + #'erc-truncate--inhibit-when-local-and-interactive) + (kill-local-variable 'erc-truncate--buffer-size))) (defun erc-truncate--warn-about-logging (&rest _) (when (and (not erc--target) @@ -90,49 +111,51 @@ erc-truncate-buffer-to-size (setq buffer (current-buffer)) (unless (get-buffer buffer) (error "erc-truncate-buffer-to-size: %S is not a buffer" buffer))) - (when (> (buffer-size buffer) (+ size 512)) - (with-current-buffer buffer - ;; Note that when erc-insert-post-hook runs, the buffer is - ;; narrowed to the new message. So do this delicate widening. - ;; I am not sure, I think this was not recommended behavior in - ;; Emacs 20. - (save-restriction - (widen) - (let ((end (- erc-insert-marker size))) - ;; Truncate at message boundary (formerly line boundary - ;; before 5.6). - (goto-char end) - (goto-char (or (erc--get-inserted-msg-beg end) - (pos-bol))) - (setq end (point)) - ;; try to save the current buffer using - ;; `erc-save-buffer-in-logs'. We use this, in case the - ;; user has both `erc-save-buffer-in-logs' and - ;; `erc-truncate-buffer' in `erc-insert-post-hook'. If - ;; this is the case, only the non-saved part of the current - ;; buffer should be saved. Rather than appending the - ;; deleted part of the buffer to the log file. - ;; - ;; Alternatively this could be made conditional on: - ;; (not (memq 'erc-save-buffer-in-logs - ;; erc-insert-post-hook)) - ;; Comments? - ;; The comments above concern pre-5.6 behavior and reflect - ;; an obsolete understanding of how `erc-logging-enabled' - ;; behaves in practice. - (run-hook-with-args 'erc--pre-clear-functions end) - ;; disable undoing for the truncating - (buffer-disable-undo) - (let ((inhibit-read-only t)) - (delete-region (point-min) end))) - (buffer-enable-undo))))) + (with-current-buffer buffer + (when (and (not erc--inhibit-clear-p) + (> (buffer-size) + (+ (if (and erc-truncate--buffer-size + (> erc-truncate--buffer-size size)) + (setq size erc-truncate--buffer-size) + size) + 512))) + ;; Though unneeded, widen anyway to preserve pre-5.5 behavior. + (save-excursion + (save-restriction + (widen) + (let ((beg (point-min-marker)) + (end (goto-char (- erc-insert-marker size)))) + ;; Truncate at message boundary (formerly line boundary + ;; before 5.6). + (goto-char (or (erc--get-inserted-msg-beg end) (pos-bol))) + (setq end (point-marker)) + (with-silent-modifications + (funcall erc--clear-function beg end)) + (set-marker beg nil) + (set-marker end nil))))))) ;;;###autoload (defun erc-truncate-buffer () "Truncate current buffer to `erc-max-buffer-size'." (interactive) + ;; This `save-excursion' only exists for historical reasons because + ;; `erc-truncate-buffer-to-size' normally runs in a different buffer. (save-excursion - (erc-truncate-buffer-to-size erc-max-buffer-size))) + (if (and erc--parsed-response erc--msg-props) + (let ((symbol (make-symbol "erc-truncate--buffer-deferred")) + (buffer (current-buffer))) + (fset symbol + (lambda (&rest _) + (remove-hook 'erc-timer-hook symbol t) + (erc-truncate-buffer-to-size erc-max-buffer-size buffer))) + (erc-with-server-buffer (add-hook 'erc-timer-hook symbol -80 t))) + (erc-truncate-buffer-to-size erc-max-buffer-size)))) + +(defun erc-truncate--inhibit-when-local-and-interactive (&rest _) + "Ensure `erc-truncate--buffer-size' is nil on /CLEAR." + (when (and erc--called-as-input-p erc-truncate--buffer-size) + (message "Resetting max buffer size to %d" erc-max-buffer-size) + (setq erc-truncate--buffer-size nil))) (provide 'erc-truncate) ;;; erc-truncate.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ef8515790cd..8938db81c20 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1793,7 +1793,9 @@ erc-mode (setq-local completion-ignore-case t) (add-hook 'post-command-hook #'erc-check-text-conversion nil t) (add-hook 'kill-buffer-hook #'erc-kill-buffer-function nil t) - (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t)) + (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t) + (add-function :before (local 'erc--clear-function) + #'erc--skip-past-headroom-on-clear '((depth . 30)))) ;; activation @@ -3323,10 +3325,14 @@ erc--get-inserted-msg-beg-at (macroexp-let2* nil ((point point) (at-start-p at-start-p)) `(or (and ,at-start-p ,point) - (and-let* ((p (previous-single-property-change ,point 'erc--msg))) - (if (and (= p (1- ,point)) (get-text-property p 'erc--msg)) - p - (1- p)))))) + (let ((p (previous-single-property-change ,point 'erc--msg))) + (cond + ((and p (= p (1- ,point)) (get-text-property p 'erc--msg)) p) + (p (1- p)) + ((and (null p) + (> ,point (point-min)) + (get-text-property (1- point) 'erc--msg)) + (1- point))))))) (defmacro erc--get-inserted-msg-end-at (point at-start-p) (macroexp-let2 nil point point @@ -3355,9 +3361,9 @@ erc--get-inserted-msg-bounds (and-let* ((b (erc--get-inserted-msg-beg-at point at-start-p))) (cons b (erc--get-inserted-msg-end-at point at-start-p))))) -(defun erc--get-inserted-msg-prop (prop) +(defun erc--get-inserted-msg-prop (prop &optional point) "Return the value of text property PROP for some message at point." - (and-let* ((stack-pos (erc--get-inserted-msg-beg (point)))) + (and-let* ((stack-pos (erc--get-inserted-msg-beg (or point (point))))) (get-text-property stack-pos prop))) ;; FIXME improve this nascent "message splicing" facility to include a @@ -3382,7 +3388,8 @@ erc--with-spliced-insertion (declare (indent 1)) (let ((marker (make-symbol "marker"))) `(progn - (cl-assert (= ?\n (char-before ,marker-or-pos))) + (cl-assert (or (= ,marker-or-pos (point-min)) + (= ?\n (char-before ,marker-or-pos)))) (cl-assert (null erc--insert-line-function)) (let* ((,marker (and (not (markerp ,marker-or-pos)) (copy-marker ,marker-or-pos))) @@ -3698,7 +3705,8 @@ erc--insert-before-markers-transplanting-hidden the inserted version of STRING." (let* ((after (and (not erc-legacy-invisible-bounds-p) (get-text-property (point) 'erc--hide))) - (before (and after (get-text-property (1- (point)) 'invisible))) + (before (and after (> (point) (point-min)) + (get-text-property (1- (point)) 'invisible))) (a (and after (ensure-list after))) (b (and before (ensure-list before))) (new (and before (erc--solo (cl-intersection b a))))) @@ -4470,21 +4478,37 @@ erc--unignore-user (when-let ((existing (erc--find-ignore-timer user buffer))) (cancel-timer existing))))) -(defvar erc--pre-clear-functions nil - "Abnormal hook run when truncating buffers. -Called with position indicating boundary of interval to be excised.") +(defvar erc--clear-function #'delete-region + "Function to truncate buffer. +Called with two markers, LOWER and UPPER, indicating the bounds of the +interval to be excised. LOWER <= UPPER <= `erc-insert-marker'.") + +(defun erc--skip-past-headroom-on-clear (lower _) + "Move marker LOWER past the 2 newlines added by `erc--initialize-markers'." + (when (and (not (buffer-narrowed-p)) (= lower (point-min))) + (save-excursion + (goto-char (point-min)) + (set-marker lower (1+ (skip-chars-forward "\n" 3)))))) + +(defvar erc--inhibit-clear-p nil + "When non-nil, inhbiit buffer truncation.") (defun erc-cmd-CLEAR () "Clear messages in current buffer after informing active modules. Expect modules to perform housekeeping tasks to withstand the disruption. When called from Lisp code, only clear messages up to but not including the one occupying the current line." + (when erc--inhibit-clear-p + (user-error "Truncation currently inhibited")) (with-silent-modifications - (let ((max (if (>= (point) erc-insert-marker) - (1- erc-insert-marker) - (or (erc--get-inserted-msg-beg (point)) (pos-bol))))) - (run-hook-with-args 'erc--pre-clear-functions max) - (delete-region (point-min) max))) + (let ((end (copy-marker + (cond ((>= (point) erc-insert-marker) erc-insert-marker) + ((erc--get-inserted-msg-beg (point))) + ((pos-bol))))) + (beg (point-min-marker))) + (funcall erc--clear-function beg end) + (set-marker beg nil) + (set-marker end nil))) t) (put 'erc-cmd-CLEAR 'process-not-needed t) @@ -5555,29 +5579,28 @@ erc-cmd-CLEARTOPIC (defvar-local erc-channel-banlist nil "A list of bans seen for the current channel. - -Entries are cons cells of the form (WHOSET . MASK), where WHOSET is the -channel operator who issued the ban. Modules needing such a list should -call `erc-sync-banlist' once per session in the channel before accessing -the variable. Interactive users need only issue a /BANLIST. Note that +Entries are cons cells of the form (OP . MASK), where OP is the channel +operator who issued the ban. Modules needing such a list should call +`erc-sync-banlist' once per session in the channel before accessing the +variable. Interactive users need only issue a /BANLIST. Note that older versions of ERC relied on a deprecated convention involving a property of the symbol `erc-channel-banlist' to indicate whether a ban -list had been received in full, but this was found to be unreliable.") +list had been received in full; this was found to be unreliable.") (put 'erc-channel-banlist 'received-from-server nil) (defvar-local erc--channel-banlist-synchronized-p nil - "Whether the channel banlist has been fetched since joining.") + "Whether the full channel ban list has been fetched since joining.") (defun erc-sync-banlist (&optional done-fn) "Initialize syncing of current channel's `erc-channel-banlist'. Arrange for it to remain synced for the rest of the IRC session. When -DONE-FN is non-nil, call it with no args once fully updated, and expect -it to return non-nil, if necessary, to inhibit further processing." +DONE-FN is non-nil, call it with no args once fully updated. Expect it +to return non-nil, if necessary, to inhibit further processing." (unless (erc-channel-p (current-buffer)) (error "Not a channel buffer")) (let ((channel (erc-target)) (buffer (current-buffer)) - (hook (lambda (&rest r) (always (apply #'erc-banlist-store r))))) + (hook (lambda (&rest r) (apply #'erc-banlist-store r) t))) (setq erc-channel-banlist nil) (erc-with-server-buffer (add-hook 'erc-server-367-functions hook -98 t) @@ -6673,7 +6696,7 @@ erc--banlist-update (defun erc-banlist-update (proc parsed) "Check MODE commands for bans and update the banlist appropriately." ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 - (declare (obsolete "`erc-channel-banlist' always updated on MODE" "31.1")) + (declare (obsolete "continual syncing via `erc--banlist-update'" "31.1")) (let* ((tgt (car (erc-response.command-args parsed))) (mode (erc-response.contents parsed)) (whoset (erc-response.sender parsed)) @@ -7758,8 +7781,8 @@ erc--handle-channel-mode ;; We could specialize on type A, but that may be too brittle. (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg) - ;; Add or remove a ban from `erc-channel-banlist'. - (erc--banlist-update state arg)) + "Update `erc-channel-banlist' when synchronized." + (when erc--channel-banlist-synchronized-p (erc--banlist-update state arg))) ;; We could specialize on type C, but that may be too brittle. (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 038434b3880..1d74025c5ce 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -597,6 +597,11 @@ erc--get-inserted-msg-beg/readonly #'erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) +(ert-deftest erc--get-inserted-msg-beg/truncated/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/truncated + (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg)))))) + (ert-deftest erc--get-inserted-msg-end/readonly () (erc-tests-common-assert-get-inserted-msg-readonly-with #'erc-tests-common-assert-get-inserted-msg/basic diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index 3c738822f96..76d3b74222d 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -117,10 +117,12 @@ erc-scenarios-log--clear-stamp (should (file-exists-p logfile)) (funcall expect 10 "please your lordship") (ert-info ("Buffer truncated") - (goto-char (point-min)) - (funcall expect 10 "@@STAMP@@" (point)) ; reset + (funcall expect 10 "@@STAMP@@" (goto-char (point-min))) ; reset (funcall expect -0.1 "Grows, lives") - (funcall expect 1 "For these two"))) + (funcall expect 1 "For these two") + ;; Stamp resides just before `erc-last-saved-position'. + (should (looking-back (rx "]\n alice: For these two"))) + (should (= erc-last-saved-position (1- (pos-bol)))))) (ert-info ("Current contents saved") (with-temp-buffer @@ -129,7 +131,7 @@ erc-scenarios-log--clear-stamp (funcall expect 1 "You have joined") (funcall expect 1 "Playback Complete.") (funcall expect 1 "Grows, lives") - (funcall expect -0.01 "please your lordship"))) + (funcall expect -0.001 "alice: For these two hours"))) (ert-info ("Remainder saved, timestamp printed when option non-nil") (with-current-buffer "foonet" @@ -180,7 +182,7 @@ erc-scenarios-log--truncate (should-not (file-exists-p logserv)) (should-not (file-exists-p logchan)) (funcall expect 10 "*** MAXLIST=beI:60") - (should (= (pos-bol) (point-min))) + (should (= (pos-bol) 22)) (should (file-exists-p logserv)))) (ert-info ("Log file ahead of truncation point") @@ -198,9 +200,13 @@ erc-scenarios-log--truncate (with-temp-buffer (insert-file-contents logchan) (funcall expect 1 "You have joined") - (funcall expect 1 "[07:04:37] alice: Here,") - (funcall expect 1 "loathed enemy") - (funcall expect -0.1 "please your lordship"))) + ;; No unwanted duplicates. + (funcall expect 1 " [07:04:37] alice: Here,") + (funcall expect -0.001 " [07:04:37] alice: Here,") + (funcall expect 1 " [07:04:42] bob: By my troth") + (funcall expect -0.001 " [07:04:42] bob: By my troth") + (funcall expect 1 "I will grant it") + (funcall expect -0.001 "loathed enemy"))) (erc-log-mode -1) (erc-truncate-mode -1) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 560d3bbb3d0..eddb3a5b2c8 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -929,6 +929,7 @@ erc--channel-modes (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) @@ -985,6 +986,7 @@ erc--channel-modes/graphic-p (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) @@ -1932,6 +1934,10 @@ erc--get-inserted-msg-beg/basic (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) +(ert-deftest erc--get-inserted-msg-beg/truncated () + (erc-tests-common-assert-get-inserted-msg/truncated + (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg)))))) + (ert-deftest erc--get-inserted-msg-end/basic () (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index b5bb1fb09c3..1cd54a1f715 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -184,6 +184,13 @@ erc-tests-common-assert-get-inserted-msg/basic (should (looking-back " hi")) (erc-tests-common-assert-get-inserted-msg 3 11 test-fn)) +(defun erc-tests-common-assert-get-inserted-msg/truncated (test-fn) + (erc-tests-common-get-inserted-msg-setup) + (with-silent-modifications (delete-region 1 3)) + (goto-char 9) + (should (looking-back " hi")) + (erc-tests-common-assert-get-inserted-msg 1 9 test-fn)) + ;; This is a "mixin" and requires a base assertion function, like ;; `erc-tests-common-assert-get-inserted-msg/basic', to work. (defun erc-tests-common-assert-get-inserted-msg-readonly-with -- 2.46.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6.1-Rename-internal-variable-in-erc-fill.patch >From d2224a549b3ad24e4798a827f965d2f624efb6fc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 19 Aug 2024 22:40:25 -0700 Subject: [PATCH 1/6] [5.6.1] ; Rename internal variable in erc-fill * lisp/erc/erc-fill.el (erc--fill-wrap-scrolltobottom-exempt-p): Rename to `erc-fill--wrap-scrolltobottom-exempt-p' so prefix matches library and feature. (erc-fill--wrap-ensure-dependencies): Update variable name. * lisp/erc/erc-truncate.el (erc-max-buffer-size): Don't mention `erc-insert-post-hook' in doc string because truncation now happens elsewhere. (erc-truncate-buffer-to-size): Update obsolete comment that describes pre-5.5/Emacs 29 behavior. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Update variable name. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--make-bindings): Use updated variable name. (Bug#72736) --- lisp/erc/erc-fill.el | 4 ++-- lisp/erc/erc-truncate.el | 7 ++----- test/lisp/erc/erc-fill-tests.el | 2 +- test/lisp/erc/resources/erc-scenarios-common.el | 2 +- 4 files changed, 6 insertions(+), 9 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index c863d99a339..986314822ba 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -421,7 +421,7 @@ erc-button-mode (defvar erc-scrolltobottom-mode) (defvar erc-legacy-invisible-bounds-p) -(defvar erc--fill-wrap-scrolltobottom-exempt-p nil) +(defvar erc-fill--wrap-scrolltobottom-exempt-p nil) (defun erc-fill--wrap-ensure-dependencies () (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) @@ -435,7 +435,7 @@ erc-fill--wrap-ensure-dependencies (unless erc-fill-mode (push 'fill missing-deps) (erc-fill-mode +1)) - (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p + (unless (or erc-scrolltobottom-mode erc-fill--wrap-scrolltobottom-exempt-p (memq 'scrolltobottom erc-modules)) (push 'scrolltobottom missing-deps) (erc-scrolltobottom-mode +1)) diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 4b602074ebb..711a2988302 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -38,7 +38,7 @@ erc-truncate (defcustom erc-max-buffer-size 30000 "Maximum size in chars of each ERC buffer. Used only when auto-truncation is enabled. -\(see `erc-truncate-buffer' and `erc-insert-post-hook')." +\(Also see `erc-truncate-buffer'.)" :type 'integer) ;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -92,10 +92,7 @@ erc-truncate-buffer-to-size (error "erc-truncate-buffer-to-size: %S is not a buffer" buffer))) (when (> (buffer-size buffer) (+ size 512)) (with-current-buffer buffer - ;; Note that when erc-insert-post-hook runs, the buffer is - ;; narrowed to the new message. So do this delicate widening. - ;; I am not sure, I think this was not recommended behavior in - ;; Emacs 20. + ;; Though unneeded, widen anyway to preserve pre-5.5 behavior. (save-restriction (widen) (let ((end (- erc-insert-marker size))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index f8bfc362085..b52a996f184 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -52,7 +52,7 @@ erc-fill-tests--insert-privmsg (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) - (erc--fill-wrap-scrolltobottom-exempt-p t) + (erc-fill--wrap-scrolltobottom-exempt-p t) (erc-stamp--tz t) (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 0dc82c98d5f..130b0aae109 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -150,7 +150,7 @@ erc-scenarios-common--print-trace (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) (erc-auth-source-parameters-join-function nil) - (erc--fill-wrap-scrolltobottom-exempt-p t) + (erc-fill--wrap-scrolltobottom-exempt-p t) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) -- 2.46.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6.1-Store-one-string-per-user-in-erc-spkr-msg-prop.patch >From 6d27ebb9f7a9d2786cc9ac0808c71941d2627f6e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 6 Aug 2024 19:13:51 -0700 Subject: [PATCH 2/6] [5.6.1] Store one string per user in erc--spkr msg prop * lisp/erc/erc.el (erc--msg-props): Mention that the `erc--spkr' msg-prop value is taken from the `nickname' slot of the user's `erc-server-users' entry. (erc--speakerize-nick): Avoid using the provided NICK parameter for the `erc--spkr' property. Instead, use the version from the `nickname' slot of its `erc-server-users' item, which is itself an `erc-server-user' object. These text props were originally introduced in ERC 5.6 as part of bug#67677. * test/lisp/erc/erc-tests.el (erc--refresh-prompt) (erc--check-prompt-input-functions, erc-send-current-line) (erc--check-prompt-input-for-multiline-blanks) (erc-send-whitespace-lines): Use more convenient helper utility to create fake server buffer where possible. (erc--speakerize-nick): New test. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-make-server-buf): Don't use ERT temp buffer's name for dialed server, etc., because it contains unwanted chars. (erc-tests-common-with-process-input-spy): Defer to each test to set up its own prompt, etc. (Bug#72736) --- lisp/erc/erc.el | 29 ++++----- test/lisp/erc/erc-tests.el | 71 ++++++++++++++++++--- test/lisp/erc/resources/erc-tests-common.el | 9 +-- 3 files changed, 81 insertions(+), 28 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5e8fa3051c7..8b3eef94ee4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -173,7 +173,8 @@ erc--msg-props and help text, and on outgoing messages unless echoed back by the server (assuming future support) - - `erc--spkr': a string, the nick of the person speaking + - `erc--spkr': a string, the non-case-mapped nick of the speaker as + stored in the `nickname' slot of its `erc-server-users' item - `erc--ctcp': a CTCP command, like `ACTION' @@ -6339,20 +6340,18 @@ erc--message-speaker-ctcp-action-statusmsg-input "Template for a CTCP ACTION status message from current client.") (defun erc--speakerize-nick (nick &optional disp) - "Propertize NICK with `erc--speaker' if not already present. -Do so to DISP instead if it's non-nil. In either case, assign -NICK, sans properties, as the `erc--speaker' value. As a side -effect, pair the latter string (the same `eq'-able object) with -the symbol `erc--spkr' in the \"msg prop\" environment for any -imminent `erc-display-message' invocations. While doing so, -include any overrides defined in `erc--message-speaker-catalog'." - (let ((plain-nick (substring-no-properties nick))) - (erc--ensure-spkr-prop plain-nick (get erc--message-speaker-catalog - 'erc--msg-prop-overrides)) - (if (text-property-not-all 0 (length (or disp nick)) - 'erc--speaker nil (or disp nick)) - (or disp nick) - (propertize (or disp nick) 'erc--speaker plain-nick)))) + "Return propertized NICK with canonical NICK in `erc--speaker'. +Return propertized DISP instead if given. As a side effect, pair NICK +with `erc--spkr' in the \"msg prop\" environment for any imminent +`erc-display-message' invocations, and include any overrides defined in +`erc--message-speaker-catalog'. Expect NICK (but not necessarily DISP) +to be absent of any existing text properties." + (when-let ((erc-server-process) + (cusr (erc-get-server-user nick))) + (setq nick (erc-server-user-nickname cusr))) + (erc--ensure-spkr-prop nick (get erc--message-speaker-catalog + 'erc--msg-prop-overrides)) + (propertize (or disp nick) 'erc--speaker nick)) (defun erc--determine-speaker-message-format-args (nick message queryp privmsgp inputp &optional statusmsg prefix disp-nick) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index f65c1496087..b11f994bce8 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -330,16 +330,12 @@ erc--refresh-prompt (ert-info ("Server buffer") (with-current-buffer (get-buffer-create "ServNet") - (erc-tests-common-prep-for-insertion) + (erc-tests-common-make-server-buf "ServNet") (goto-char erc-insert-marker) (should (looking-at-p "ServNet 3>")) (erc-tests-common-init-server-proc "sleep" "1") (set-process-sentinel erc-server-process #'ignore) - (setq erc-network 'ServNet - erc-server-current-nick "tester" - erc-networks--id (erc-networks--id-create nil) - erc-server-users (make-hash-table :test 'equal)) - (set-process-query-on-exit-flag erc-server-process nil) + (setq erc-server-current-nick "tester") ;; Incoming message redraws prompt (erc-display-message nil 'notice nil "Welcome") (should (looking-at-p (rx "*** Welcome"))) @@ -364,6 +360,8 @@ erc--refresh-prompt (should-not (search-forward (rx (any "3-5") ">") nil t))))) (ert-info ("Channel buffer") + ;; Create buffer manually instead of using `erc--open-target' in + ;; order to show prompt before/after network is known. (with-current-buffer (get-buffer-create "#chan") (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) @@ -1521,6 +1519,7 @@ erc--input-line-delim-regexp (ert-deftest erc--check-prompt-input-functions () (erc-tests-common-with-process-input-spy (lambda (next) + (erc-tests-common-prep-for-insertion) (ert-info ("Errors when point not in prompt area") ; actually just dings (insert "/msg #chan hi") @@ -1556,7 +1555,7 @@ erc--check-prompt-input-functions (ert-deftest erc-send-current-line () (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests-common-init-server-proc "sleep" "1") + (erc-tests-common-make-server-buf (buffer-name)) (should (= 0 erc-last-input-time)) (ert-info ("Simple command") @@ -1639,7 +1638,8 @@ erc--check-prompt-input-for-multiline-blanks (ert-with-message-capture messages (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests-common-init-server-proc "sleep" "300") + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc-send-whitespace-lines) (should erc-warn-about-blank-lines) @@ -1717,7 +1717,8 @@ erc--check-prompt-input-for-multiline-blanks/explanations (ert-deftest erc-send-whitespace-lines () (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests-common-init-server-proc "sleep" "1") + (erc-tests-common-make-server-buf (buffer-name)) + (setq-local erc-send-whitespace-lines t) (ert-info ("Multiline hunk with blank line correctly split") @@ -2653,6 +2654,58 @@ erc-tests--format-privmessage (erc--determine-speaker-message-format-args nick msg privp msgp inputp nil pfx)))) +;; This test demonstrates that ERC uses the same string for the +;; `erc--spkr' and `erc--speaker' text properties, which it gets from +;; the `nickname' shot of the speaker's server user. +(ert-deftest erc--speakerize-nick () + (erc-tests-common-make-server-buf) + (setq erc-server-current-nick "tester") + + (let ((sentinel "alice")) + (with-current-buffer (erc--open-target "#chan") + (erc-update-current-channel-member "bob" "bob" t nil nil nil nil nil + "example.org" "~u" "bob") + (erc-update-current-channel-member "alice" sentinel t nil nil nil nil nil + "fsf.org" "~u" "alice")) + + (erc-call-hooks nil (make-erc-response + :sender "alice!~u@fsf.org" + :command "PRIVMSG" + :command-args '("#chan" "one") + :contents "one" + :unparsed ":alice!~u@fsf.org PRIVMSG #chan :one")) + (erc-call-hooks nil (make-erc-response + :sender "bob!~u@example.org" + :command "PRIVMSG" + :command-args '("#chan" "hi") + :contents "hi" + :unparsed ":bob!~u@example.org PRIVMSG #chan :hi")) + (erc-call-hooks nil (make-erc-response + :sender "alice!~u@fsf.org" + :command "PRIVMSG" + :command-args '("#chan" "two") + :contents "two" + :unparsed ":alice!~u@fsf.org PRIVMSG #chan :two")) + + (with-current-buffer (get-buffer "#chan") + (should (eq sentinel + (erc-server-user-nickname (erc-get-server-user "alice")))) + (goto-char (point-min)) + + (should (search-forward " one")) + (should (eq (get-text-property (point) 'erc--speaker) sentinel)) + (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel)) + + (should (search-forward " hi" nil t)) + + (should (search-forward " two")) + (should (eq (get-text-property (point) 'erc--speaker) sentinel)) + (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel)) + + (when noninteractive (kill-buffer))))) + ;; This asserts that `erc--determine-speaker-message-format-args' ;; behaves identically to `erc-format-privmessage', the function whose ;; role it basically replaced. diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 2ec32db77cd..b5bb1fb09c3 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -103,16 +103,17 @@ erc-tests-common-with-process-input-spy (lambda (&rest r) (push r calls))) ((symbol-function 'erc-server-buffer) (lambda () (current-buffer)))) - (erc-tests-common-prep-for-insertion) (funcall test-fn (lambda () (pop calls))))) (when noninteractive (kill-buffer)))) (defun erc-tests-common-make-server-buf (&optional name) "Return a server buffer named NAME, creating it if necessary. Use NAME for the network and the session server as well." - (unless name - (cl-assert (string-prefix-p " *temp*" (setq name (buffer-name))))) - (with-current-buffer (get-buffer-create name) + (with-current-buffer (if name + (get-buffer-create name) + (and (string-search "temp" (buffer-name)) + (setq name "foonet") + (buffer-name))) (erc-tests-common-prep-for-insertion) (erc-tests-common-init-server-proc "sleep" "1") (setq erc-session-server (concat "irc." name ".org") -- 2.46.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6.1-Bind-current-erc-response-around-all-handlers.patch >From 29fbad881e33d56e76c9fb0fb8b9a07037dfcc2e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 18 Aug 2024 23:50:58 -0700 Subject: [PATCH 3/6] [5.6.1] Bind current erc-response around all handlers * lisp/erc/erc-backend.el (erc--parsed-response): New variable to be the internal version of the ancient `erc-message-parsed', which is only available during `erc-display-message', and therefore of somewhat limited utility. (erc-call-hooks): Bind `erc--parsed-response' to the parsed `erc-response' object for the duration of its handling. Bind `erc--msg-prop-overrides' around all hooks to allow response handlers to influence inserted msg props for any `erc-display-message' calls. (Bug#72736) --- lisp/erc/erc-backend.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 9aedc110067..d999cf57db8 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1534,11 +1534,15 @@ erc-get-hook (gethash (format (if (numberp command) "%03i" "%s") command) erc-server-responses)) +(defvar erc--parsed-response nil) + (defun erc-call-hooks (process message) "Call hooks associated with MESSAGE in PROCESS. Finds hooks by looking in the `erc-server-responses' hash table." - (let ((hook (or (erc-get-hook (erc-response.command message)) + (let ((erc--parsed-response message) + (erc--msg-prop-overrides erc--msg-prop-overrides) + (hook (or (erc-get-hook (erc-response.command message)) 'erc-default-server-functions))) (run-hook-with-args-until-success hook process message) ;; Some handlers, like `erc-cmd-JOIN', open new targets without -- 2.46.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.6.1-Fix-inconsistent-handling-of-ban-lists-in-ERC.patch >From 9bb1ca1f792863642e2a043822303c1f03b474e1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 18 Aug 2024 22:58:11 -0700 Subject: [PATCH 4/6] [5.6.1] Fix inconsistent handling of ban lists in ERC * etc/ERC-NEWS: Mention new function `erc-sync-banlist' in new section for ERC 5.6.1. * lisp/erc/erc-backend.el (erc-server-MODE): Don't call `erc-banlist-update'. * lisp/erc/erc-fill.el (erc--determine-fill-column-function): New method for `fill' and `fill-wrap' modules. * lisp/erc/erc-pcomplete.el (pcomplete/erc-mode/BANLIST) (pcomplete/erc-mode/BL) (pcomplete/erc-mode/MASSUNBAN, pcomplete/erc-mode/MUB): New functions. * lisp/erc/erc.el (erc-channel-banlist): Deprecate practice of using the symbol-property `received-from-server' of as a state flag because it's error-prone and bleeds into other connections. (erc--channel-banlist-synchronized-p): New variable to indicate whether the ban list has been initialized. The presence of a local binding for `erc-channel-banlist' could probably be used for the same purpose but would surely require rewriting `erc-cmd-BANLIST' and `erc-cmd-MASSUNBAN'. (erc-sync-banlist): New function, announced in ERC-NEWS. (erc--wrap-banlist): New function. (erc-banlist-fill-padding): New variable. (erc--determine-fill-column-function): New generic function. (erc-cmd-BANLIST): Move forward declaration of `erc-fill-column' from top level into function body. Always reset `received-from-server' to nil. Improve column calculations. (erc-cmd-MASSUNBAN): Always reset `received-from-server' to nil. (erc-banlist-finished): Deprecate function unused since 2003. (erc--banlist-update): New function. (erc-banlist-update): Deprecate function because its logic is faulty and it doesn't handle mixed mode letters, like "MODE #foobar +mb *@127.0.0.1". See https://modern.ircdocs.horse/#mode-message. It also depends on an obsolete convention regarding the symbol property `received-from-server' of `erc-channel-banlist'. Basically, this function used to run upon receipt of any "MODE" command from the server. However, actual updates to the variable `erc-channel-banlist' only happened if `received-from-server' was t, which could only be the case after the user issued a /MASSUNBAN. And that behavior was determined to be a bug. This mode framework stuff was introduced as part of bug#67220 for ERC 5.6. (erc--handle-channel-mode): New method. * test/lisp/erc/erc-tests.el (erc--channel-modes) (erc--channel-modes/graphic-p): Assert contents of `erc-channel-banlist' updated on "MODE". (Bug#72736) --- etc/ERC-NEWS | 9 ++ lisp/erc/erc-backend.el | 4 +- lisp/erc/erc-fill.el | 6 ++ lisp/erc/erc-pcomplete.el | 8 ++ lisp/erc/erc.el | 212 +++++++++++++++++++++---------------- test/lisp/erc/erc-tests.el | 19 +++- 6 files changed, 160 insertions(+), 98 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 9803c3ff379..0b5385f0589 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -11,6 +11,15 @@ This file is about changes in ERC, the powerful, modular, and extensible IRC (Internet Relay Chat) client distributed with GNU Emacs since Emacs version 22.1. + +* Changes in ERC 5.6.1 + +** Reliable library access for ban lists. +Say goodbye to continually running "/BANLIST" for programmatic +purposes. Modules can instead use the function 'erc-sync-banlist' to +guarantee that the variable 'erc-channel-banlist' remains synced for +the remainder of an IRC session. + * Changes in ERC 5.6 diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index d999cf57db8..16e8cae4733 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1851,8 +1851,8 @@ erc--server-determine-join-display-context ?t tgt ?m mode) (erc-display-message parsed 'notice buf 'MODE ?n nick ?u login - ?h host ?t tgt ?m mode))) - (erc-banlist-update proc parsed)))) + ?h host ?t tgt ?m mode))))) + nil) (defun erc--wrangle-query-buffers-on-nick-change (old new) "Create or reuse a query buffer for NEW nick after considering OLD nick. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 986314822ba..fa9d2071ccd 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -896,6 +896,12 @@ erc-timestamp-offset (length (format-time-string erc-timestamp-format)) 0)) +(cl-defmethod erc--determine-fill-column-function + (&context (erc-fill-mode (eql t))) + (if erc-fill-wrap-mode + (- (window-width) erc-fill--wrap-value 1) + erc-fill-column)) + (provide 'erc-fill) ;;; erc-fill.el ends here diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 05cbaf3872f..afbe3895667 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -187,6 +187,14 @@ pcomplete/erc-mode/RECONNECT (pcomplete-here '("cancel")) (pcomplete-opt "a")) +(defun pcomplete/erc-mode/BANLIST () + (pcomplete-opt "f")) +(defalias 'pcomplete/erc-mode/BL #'pcomplete/erc-mode/BANLIST) + +(defun pcomplete/erc-mode/MASSUNBAN () + (pcomplete-opt "f")) +(defalias 'pcomplete/erc-mode/MUB #'pcomplete/erc-mode/MASSUNBAN) + ;;; Functions that provide possible completions. (defun pcomplete-erc-commands () diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8b3eef94ee4..52ec4d23dd7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5555,109 +5555,117 @@ erc-cmd-CLEARTOPIC (defvar-local erc-channel-banlist nil "A list of bans seen for the current channel. - -Each ban is an alist of the form: - (WHOSET . MASK) - -The property `received-from-server' indicates whether -or not the ban list has been requested from the server.") +Entries are cons cells of the form (OP . MASK), where OP is the channel +operator who issued the ban. Modules needing such a list should call +`erc-sync-banlist' once per session in the channel before accessing the +variable. Interactive users need only issue a /BANLIST. Note that +older versions of ERC relied on a deprecated convention involving a +property of the symbol `erc-channel-banlist' to indicate whether a ban +list had been received in full; this was found to be unreliable.") (put 'erc-channel-banlist 'received-from-server nil) -(defvar erc-fill-column) - -(defun erc-cmd-BANLIST () - "Pretty-print the contents of `erc-channel-banlist'. - -The ban list is fetched from the server if necessary." - (let ((chnl (erc-default-target)) - (chnl-name (buffer-name))) - - (cond - ((not (erc-channel-p chnl)) - (erc-display-message nil 'notice 'active "You're not on a channel\n")) - - ((not (get 'erc-channel-banlist 'received-from-server)) - (let ((old-367-hook erc-server-367-functions)) - (setq erc-server-367-functions 'erc-banlist-store - erc-channel-banlist nil) - ;; fetch the ban list then callback - (erc-with-server-buffer - (erc-once-with-server-event - 368 - (lambda (_proc _parsed) - (with-current-buffer chnl-name - (put 'erc-channel-banlist 'received-from-server t) - (setq erc-server-367-functions old-367-hook) - (erc-cmd-BANLIST) - t))) - (erc-server-send (format "MODE %s b" chnl))))) - - ((null erc-channel-banlist) - (erc-display-message nil 'notice 'active - (format "No bans for channel: %s\n" chnl)) +(defvar-local erc--channel-banlist-synchronized-p nil + "Whether the full channel ban list has been fetched since joining.") + +(defun erc-sync-banlist (&optional done-fn) + "Initialize syncing of current channel's `erc-channel-banlist'. +Arrange for it to remain synced for the rest of the IRC session. When +DONE-FN is non-nil, call it with no args once fully updated. Expect it +to return non-nil, if necessary, to inhibit further processing." + (unless (erc-channel-p (current-buffer)) + (error "Not a channel buffer")) + (let ((channel (erc-target)) + (buffer (current-buffer)) + (hook (lambda (&rest r) (apply #'erc-banlist-store r) t))) + (setq erc-channel-banlist nil) + (erc-with-server-buffer + (add-hook 'erc-server-367-functions hook -98 t) + (erc-once-with-server-event + 368 (lambda (&rest _) + (remove-hook 'erc-server-367-functions hook t) + (with-current-buffer buffer + (prog1 (if done-fn (funcall done-fn) t) + (setq erc--channel-banlist-synchronized-p t))))) + (erc-server-send (format "MODE %s b" channel))))) + +(defun erc--wrap-banlist-cmd (slashcmd) + (lambda () + (put 'erc-channel-banlist 'received-from-server t) + (unwind-protect (funcall slashcmd) (put 'erc-channel-banlist 'received-from-server nil)) + t)) - (t - (let* ((erc-fill-column (or (and (boundp 'erc-fill-column) - erc-fill-column) - (and (boundp 'fill-column) - fill-column) - (1- (window-width)))) - (separator (make-string erc-fill-column ?=)) - (fmt (concat - "%-" (number-to-string (/ erc-fill-column 2)) "s" - "%" (number-to-string (/ erc-fill-column 2)) "s"))) +(defvar erc-banlist-fill-padding 1.0 + "Scaling factor from 0 to 1 of free space between entries, if any.") - (erc-display-message - nil 'notice 'active - (format "Ban list for channel: %s\n" (erc-default-target))) - - (erc-display-line separator 'active) - (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) - (erc-display-line separator 'active) - - (mapc - (lambda (x) - (erc-display-line - (format fmt - (truncate-string-to-width (cdr x) (/ erc-fill-column 2)) - (if (car x) - (truncate-string-to-width (car x) (/ erc-fill-column 2)) - "")) - 'active)) - erc-channel-banlist) - - (erc-display-message nil 'notice 'active "End of Ban list") - (put 'erc-channel-banlist 'received-from-server nil))))) +(cl-defgeneric erc--determine-fill-column-function () + fill-column) + +(defun erc-cmd-BANLIST (&rest args) + "Print the list of ban masks for the current channel. +When uninitialized or with option -f, resync `erc-channel-banlist'." + (cond + ((not (erc-channel-p (current-buffer))) + (erc-display-message nil 'notice 'active "You're not on a channel\n")) + ((or (equal args '("-f")) + (and (not erc--channel-banlist-synchronized-p) + (not (get 'erc-channel-banlist 'received-from-server)))) + (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-BANLIST))) + ((null erc-channel-banlist) + (erc-display-message nil 'notice 'active + (format "No bans for channel: %s\n" (erc-target)))) + ((let ((max-width (erc--determine-fill-column-function)) + (lw 0) (rw 0) separator fmt) + (dolist (entry erc-channel-banlist) + (setq rw (max (length (car entry)) rw) + lw (max (length (cdr entry)) lw))) + (let ((maxw (* 1.0 (min max-width (+ rw lw))))) + (when (< maxw (+ rw lw)) ; scale down when capped + (cl-psetq rw (/ (* rw maxw) (* 1.0 (+ rw lw))) + lw (/ (* lw maxw) (* 1.0 (+ rw lw))))) + (when-let ((larger (max rw lw)) ; cap ratio at 3:1 + (wavg (* maxw 0.75)) + ((> larger wavg))) + (setq rw (if (eql larger rw) wavg (- maxw wavg)) + lw (- maxw rw))) + (cl-psetq rw (+ rw (* erc-banlist-fill-padding + (- (/ (* rw max-width) maxw) rw))) + lw (+ lw (* erc-banlist-fill-padding + (- (/ (* lw max-width) maxw) lw))))) + (setq rw (truncate rw) + lw (truncate lw)) + (cl-assert (<= (+ rw lw) max-width)) + (setq separator (make-string (+ rw lw 1) ?=) + fmt (concat "%-" (number-to-string lw) "s " + "%" (number-to-string rw) "s")) + (erc-display-message + nil 'notice 'active + (format "Ban list for channel: %s%s\n" (erc-target) + (if erc--channel-banlist-synchronized-p " (cached)" ""))) + (erc-display-line separator 'active) + (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) + (erc-display-line separator 'active) + (dolist (entry erc-channel-banlist) + (erc-display-line + (format fmt (truncate-string-to-width (cdr entry) lw) + (truncate-string-to-width (car entry) rw)) + 'active)) + (erc-display-message nil 'notice 'active "End of Ban list")))) + (put 'erc-channel-banlist 'received-from-server nil) t) (defalias 'erc-cmd-BL #'erc-cmd-BANLIST) -(defun erc-cmd-MASSUNBAN () - "Mass Unban. - -Unban all currently banned users in the current channel." +(defun erc-cmd-MASSUNBAN (&rest args) + "Remove all bans in the current channel." (let ((chnl (erc-default-target))) (cond - ((not (erc-channel-p chnl)) (erc-display-message nil 'notice 'active "You're not on a channel\n")) - - ((not (get 'erc-channel-banlist 'received-from-server)) - (let ((old-367-hook erc-server-367-functions)) - (setq erc-server-367-functions 'erc-banlist-store) - ;; fetch the ban list then callback - (erc-with-server-buffer - (erc-once-with-server-event - 368 - (lambda (_proc _parsed) - (with-current-buffer chnl - (put 'erc-channel-banlist 'received-from-server t) - (setq erc-server-367-functions old-367-hook) - (erc-cmd-MASSUNBAN) - t))) - (erc-server-send (format "MODE %s b" chnl))))) - + ((or (equal args '("-f")) + (and (not erc--channel-banlist-synchronized-p) + (not (get 'erc-channel-banlist 'received-from-server)))) + (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-MASSUNBAN))) (t (let ((bans (mapcar #'cdr erc-channel-banlist))) (when bans ;; Glob the bans into groups of three, and carry out the unban. @@ -5668,8 +5676,9 @@ erc-cmd-MASSUNBAN (format "MODE %s -%s %s" (erc-default-target) (make-string (length x) ?b) (mapconcat #'identity x " ")))) - (erc-group-list bans 3)))) - t)))) + (erc-group-list bans 3)))))) + (put 'erc-channel-banlist 'received-from-server nil) + t)) (defalias 'erc-cmd-MUB #'erc-cmd-MASSUNBAN) @@ -6639,17 +6648,31 @@ erc-banlist-store erc-channel-banlist)))))) nil) +;; This was a default member of `erc-server-368-functions' (nee -hook) +;; between January and June of 2003 (but not as part of any release). (defun erc-banlist-finished (proc parsed) "Record that we have received the banlist." + (declare (obsolete "uses obsolete and likely faulty logic" "31.1")) (let* ((channel (nth 1 (erc-response.command-args parsed))) (buffer (erc-get-buffer channel proc))) (with-current-buffer buffer (put 'erc-channel-banlist 'received-from-server t))) t) ; suppress the 'end of banlist' message +(defun erc--banlist-update (statep mask) + "Add or remove a mask from `erc-channel-banlist'." + (if statep + (let ((whoset (erc-response.sender erc--parsed-response))) + (cl-pushnew (cons whoset mask) erc-channel-banlist :test #'equal)) + (let ((upcased (upcase mask))) + (setq erc-channel-banlist + (cl-delete-if (lambda (y) (equal (upcase (cdr y)) upcased)) + erc-channel-banlist))))) + (defun erc-banlist-update (proc parsed) "Check MODE commands for bans and update the banlist appropriately." ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 + (declare (obsolete "continual syncing via `erc--banlist-update'" "31.1")) (let* ((tgt (car (erc-response.command-args parsed))) (mode (erc-response.contents parsed)) (whoset (erc-response.sender parsed)) @@ -7732,6 +7755,11 @@ erc--handle-channel-mode (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal) (delete (char-to-string c) erc-channel-modes)))) +;; We could specialize on type A, but that may be too brittle. +(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg) + "Update `erc-channel-banlist' when synchronized." + (when erc--channel-banlist-synchronized-p (erc--banlist-update state arg))) + ;; We could specialize on type C, but that may be too brittle. (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg) "Update channel user limit, remembering ARG when STATE is non-nil." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b11f994bce8..72ea11aeba1 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -929,13 +929,19 @@ erc--channel-modes (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) (erc-tests-common-init-server-proc "sleep" "1") - (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) - (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) + (cl-letf ((erc--parsed-response (make-erc-response + :sender "chop!~u@gnu.org")) + ((symbol-function 'erc-update-mode-line) #'ignore)) + (should-not erc-channel-banlist) + (erc--update-channel-modes "+bbltk" "fool!*@*" "spam!*@*" "3" "h2") + (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "spam!*@*") + ("chop!~u@gnu.org" . "fool!*@*"))))) (should (equal (erc--channel-modes 'string) "klt")) (should (equal (erc--channel-modes 'strings) '("k" "l" "t"))) @@ -980,11 +986,16 @@ erc--channel-modes/graphic-p (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) - (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) - (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2")) + (cl-letf ((erc--parsed-response (make-erc-response + :sender "chop!~u@gnu.org")) + ((symbol-function 'erc-update-mode-line) #'ignore)) + (should-not erc-channel-banlist) + (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2") + (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "fool!*@*"))))) ;; Truncation cache populated and used. (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types)) -- 2.46.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-5.6.1-Fix-overlooked-case-in-erc-get-inserted-msg-be.patch >From eec711c9df63415aaeaaa3382eb2a89b1e59e53d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 27 Aug 2024 23:05:35 -0700 Subject: [PATCH 5/6] [5.6.1] Fix overlooked case in erc--get-inserted-msg-beg-at * lisp/erc/erc.el (erc--get-inserted-msg-beg-at): Account for the start of a props header being `bobp' when searching backwards. (erc--get-inserted-msg-prop): Add optional `point' parameter. * test/lisp/erc/erc-goodies-tests.el (erc--get-inserted-msg-beg/truncated/readonly): New test. * test/lisp/erc/erc-tests.el (erc--get-inserted-msg-beg/truncated): New test. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-assert-get-inserted-msg/truncated): New test helper. (Bug#72736) --- lisp/erc/erc.el | 16 ++++++++++------ test/lisp/erc/erc-goodies-tests.el | 5 +++++ test/lisp/erc/erc-tests.el | 4 ++++ test/lisp/erc/resources/erc-tests-common.el | 7 +++++++ 4 files changed, 26 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 52ec4d23dd7..7d006db69a6 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3323,10 +3323,14 @@ erc--get-inserted-msg-beg-at (macroexp-let2* nil ((point point) (at-start-p at-start-p)) `(or (and ,at-start-p ,point) - (and-let* ((p (previous-single-property-change ,point 'erc--msg))) - (if (and (= p (1- ,point)) (get-text-property p 'erc--msg)) - p - (1- p)))))) + (let ((p (previous-single-property-change ,point 'erc--msg))) + (cond + ((and p (= p (1- ,point)) (get-text-property p 'erc--msg)) p) + (p (1- p)) + ((and (null p) + (> ,point (point-min)) + (get-text-property (1- point) 'erc--msg)) + (1- point))))))) (defmacro erc--get-inserted-msg-end-at (point at-start-p) (macroexp-let2 nil point point @@ -3355,9 +3359,9 @@ erc--get-inserted-msg-bounds (and-let* ((b (erc--get-inserted-msg-beg-at point at-start-p))) (cons b (erc--get-inserted-msg-end-at point at-start-p))))) -(defun erc--get-inserted-msg-prop (prop) +(defun erc--get-inserted-msg-prop (prop &optional point) "Return the value of text property PROP for some message at point." - (and-let* ((stack-pos (erc--get-inserted-msg-beg (point)))) + (and-let* ((stack-pos (erc--get-inserted-msg-beg (or point (point))))) (get-text-property stack-pos prop))) ;; FIXME improve this nascent "message splicing" facility to include a diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 038434b3880..1d74025c5ce 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -597,6 +597,11 @@ erc--get-inserted-msg-beg/readonly #'erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) +(ert-deftest erc--get-inserted-msg-beg/truncated/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/truncated + (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg)))))) + (ert-deftest erc--get-inserted-msg-end/readonly () (erc-tests-common-assert-get-inserted-msg-readonly-with #'erc-tests-common-assert-get-inserted-msg/basic diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 72ea11aeba1..eddb3a5b2c8 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1934,6 +1934,10 @@ erc--get-inserted-msg-beg/basic (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) +(ert-deftest erc--get-inserted-msg-beg/truncated () + (erc-tests-common-assert-get-inserted-msg/truncated + (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg)))))) + (ert-deftest erc--get-inserted-msg-end/basic () (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index b5bb1fb09c3..1cd54a1f715 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -184,6 +184,13 @@ erc-tests-common-assert-get-inserted-msg/basic (should (looking-back " hi")) (erc-tests-common-assert-get-inserted-msg 3 11 test-fn)) +(defun erc-tests-common-assert-get-inserted-msg/truncated (test-fn) + (erc-tests-common-get-inserted-msg-setup) + (with-silent-modifications (delete-region 1 3)) + (goto-char 9) + (should (looking-back " hi")) + (erc-tests-common-assert-get-inserted-msg 1 9 test-fn)) + ;; This is a "mixin" and requires a base assertion function, like ;; `erc-tests-common-assert-get-inserted-msg/basic', to work. (defun erc-tests-common-assert-get-inserted-msg-readonly-with -- 2.46.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-5.6.1-Redo-ERC-truncation-and-CLEAR-hook-mechanism.patch >From 5297613ac24bfbee5ed43f01875c08c147b7f618 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 27 Aug 2024 01:00:04 -0700 Subject: [PATCH 6/6] [5.6.1] Redo ERC truncation and /CLEAR hook mechanism * lisp/erc/erc-fill.el (erc-fill-wrap-mode, erc-fill-wrap-enable): Add right-stamp rewriter to `erc--clear-function' advice stack. (erc-fill-wrap-disable): Remove right-stamp rewriter. * lisp/erc/erc-log.el (erc-log-mode, erc-log-enable): Don't add `erc-save-buffer-in-logs' to `erc--pre-clear-functions'. Use local advice instead, as noted below. (erc-log-disable): Don't remove `erc-save-buffer-in-logs' from `erc--pre-clear-functions'. (erc-log-setup-logging): Add `erc-log--save-on-clear' to `erc--clear-function'. (erc-log-disable-logging): Remove `erc-log--save-on-clear' to `erc-clear-function'. (erc-log--save-on-clear): New function, a thin wrapper around `erc-save-buffer-in-logs', adapting it to the `erc--clear-function' advice interface. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable): Don't add `erc-stamp--reset-on-clear' to `erc--pre-clear-functions'. (erc-stamp-disable): Don't remove `erc-stamp--reset-on-clear' from `erc--pre-clear-functions'. (erc-stamp--find-insertion-point): Account for initial position being `bobp'. (erc-stamp--defer-date-insertion-on-post-modify): Accommodate the rare non-list `erc-insert-post-hook' when shadowing. (erc-stamp--setup): Add and remove `erc-stamp--reset-on-clear' to and from `erc--clear-function' advice stack. (erc-stamp--redo-right-stamp-post-clear): New function. (erc-stamp--update-saved-position): Remove unused function. This was originally added along with `erc-stamp--reset-on-clear' as part of bug#60936. (erc-stamp--reset-on-clear): Expect end of truncation boundary to be at `erc-insert-marker'. Rework to use new `erc--clear-function' interface and run on `erc-timer-hook' instead of `erc-insert-done-hook'. * lisp/erc/erc-truncate.el (erc-truncate-enable, erc-truncate-disable): Add and remove `erc-truncate--setup' to and from `erc-mode-hook', and run it when needed. (erc-truncate--buffer-size): New variable. (erc-truncate--setup): New function. (erc-scenarios-log--truncate): Guard execution with `erc-truncate--buffer-size' and `erc--inhibit-clear-p'. Reflow for readability. Call hooks with marker instead of buffer position, as per the new `erc--clear-function' interface. (erc-truncate-buffer): Defer execution to `erc-timer-hook' when running post-insertion via a response handler. (erc-truncate--inhibit-when-local-and-interactive): New function. * lisp/erc/erc.el (erc-mode): Add `erc--skip-past-headroom-on-clear' to `erc--clear-function' advice stack in all ERC buffers. (erc--with-spliced-insertion): Account for marker being `bobp'. (erc--insert-before-markers-transplanting-hidden): Make more robust by accommodating initial `point' being `bobp'. (erc--clear-function): New variable, a function-valued local-advice interface to replace `erc--pre-clear-functions'. (erc--pre-clear-functions): Remove unused variable. (erc--skip-past-headroom-on-clear): New function. (erc--inhibit-clear-p): New variable. (erc-cmd-CLEAR): Call hooks with markers instead of position. When called interactively or `point' is at prompt, don't exempt the final newline in what gets truncated. * test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp) (erc-scenarios-log--truncate): Update assertions. (Bug#72736) --- lisp/erc/erc-fill.el | 4 ++ lisp/erc/erc-log.el | 10 ++- lisp/erc/erc-stamp.el | 101 ++++++++++++++++++++++------- lisp/erc/erc-truncate.el | 96 +++++++++++++++++---------- lisp/erc/erc.el | 42 ++++++++---- test/lisp/erc/erc-scenarios-log.el | 22 ++++--- 6 files changed, 196 insertions(+), 79 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index fa9d2071ccd..6f3d51f6937 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -547,6 +547,8 @@ fill-wrap (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) + (add-function :after (local 'erc--clear-function) + #'erc-stamp--redo-right-stamp-post-clear '((depth . 50))) (erc-stamp--display-margin-mode +1) (visual-line-mode +1)) ((visual-line-mode -1) @@ -557,6 +559,8 @@ fill-wrap (kill-local-variable 'erc-fill--wrap-last-msg) (kill-local-variable 'erc--inhibit-prompt-display-property-p) (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) + (remove-function (local 'erc--clear-function) + #'erc-stamp--redo-right-stamp-post-clear) (remove-hook 'erc--refresh-prompt-hook #'erc-fill--wrap-indent-prompt t) (remove-hook 'erc-button--prev-next-predicate-functions diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 66420662c23..6bb240f56d7 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -231,7 +231,7 @@ log (add-hook 'erc-part-hook #'erc-conditional-save-buffer) ;; append, so that 'erc-initialize-log-marker runs first (add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append) - (add-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs 50) + ;; FIXME use proper local "setup" function and major-mode hook. (dolist (buffer (erc-buffer-list)) (erc-log-setup-logging buffer)) (erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs)) @@ -244,7 +244,6 @@ log (remove-hook 'erc-quit-hook #'erc-conditional-save-queries) (remove-hook 'erc-part-hook #'erc-conditional-save-buffer) (remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging) - (remove-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs) (dolist (buffer (erc-buffer-list)) (erc-log-disable-logging buffer)) (erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs))) @@ -259,6 +258,8 @@ erc-log-setup-logging (auto-save-mode -1) (setq buffer-file-name nil) (add-hook 'write-file-functions #'erc-save-buffer-in-logs nil t) + (add-function :before (local 'erc--clear-function) + #'erc-log--save-on-clear '((depth . 50))) (when erc-log-insert-log-on-open (ignore-errors (save-excursion @@ -271,6 +272,7 @@ erc-log-disable-logging "Disable logging in BUFFER." (when (erc-logging-enabled buffer) (with-current-buffer buffer + (remove-function (local 'erc--clear-function) #'erc-log--save-on-clear) (setq buffer-offer-save nil erc-enable-logging nil)))) @@ -415,6 +417,7 @@ erc-save-buffer-in-logs (widen) ;; early on in the initialization, don't try and write the log out (when (and (markerp erc-last-saved-position) + (null erc--insert-marker) ; suppress when splicing (> erc-insert-marker (1+ erc-last-saved-position))) (let ((start (1+ (marker-position erc-last-saved-position))) (end (marker-position erc-insert-marker))) @@ -446,6 +449,9 @@ erc-save-buffer-in-logs (set-buffer-modified-p nil)))))) t) +(defun erc-log--save-on-clear (_ end) + (erc-save-buffer-in-logs end)) + ;; This is a kludge to avoid littering erc-truncate.el with forward ;; declarations needed only for a corner-case compatibility check. (defun erc-log--call-when-logging-enabled-sans-module (fn) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index bebc1d0be38..7d773c8f4b2 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -182,13 +182,11 @@ stamp (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) ((remove-hook 'erc-mode-hook #'erc-stamp--setup) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear) (erc-buffer-do #'erc-stamp--setup))) (defvar erc-stamp--invisible-property nil @@ -707,7 +705,8 @@ erc-stamp--find-insertion-point ;; Continue searching after encountering a message without a ;; timestamp because date stamps must be unique, and ;; "Re-establishing connection" messages should have stamps. - (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) + (while-let ((pp (max (1- p) (point-min))) + (q (previous-single-property-change pp 'erc--ts)) (qq (erc--get-inserted-msg-beg q)) (ts (get-text-property qq 'erc--ts)) ((not (time-less-p ts target-time)))) @@ -753,7 +752,7 @@ erc-stamp--defer-date-insertion-on-post-modify (set-marker marker (point-min)) (set-marker-insertion-type marker t) (erc--hide-message 'timestamp)) - ,@erc-insert-post-hook)) + ,@(ensure-list erc-insert-post-hook))) (erc-insert-timestamp-function #'erc-stamp--propertize-left-date-stamp) (pos (erc-stamp--find-insertion-point marker aligned)) @@ -980,11 +979,16 @@ erc-stamp--add-csf-on-post-modify (defun erc-stamp--setup () "Enable or disable buffer-local `erc-stamp-mode' modifications." (if erc-stamp-mode - (erc-stamp--manage-local-options-state) + (progn + (erc-stamp--manage-local-options-state) + (add-function :around (local 'erc--clear-function) + #'erc-stamp--reset-on-clear '((depth . 40)))) (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) (erc-stamp--manage-local-options-state)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' + (remove-function (local 'erc--clear-function) + #'erc-stamp--reset-on-clear) (kill-local-variable 'erc-stamp--last-stamp) (kill-local-variable 'erc-timestamp-last-inserted) (kill-local-variable 'erc-timestamp-last-inserted-right) @@ -1023,6 +1027,8 @@ erc-toggle-timestamps (defvar-local erc-stamp--last-stamp nil) +;; FIXME rename this to avoid confusion with IRC messages. +;; Something like `erc-stamp--on-clear-echo-area-message'. (defun erc-stamp--on-clear-message (&rest _) "Return `dont-clear-message' when operating inside the same stamp." (and erc-stamp--last-stamp erc-echo-timestamps @@ -1052,25 +1058,74 @@ erc-echo-timestamp (defun erc--echo-ts-csf (_window _before dir) (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc--ts))) -(defun erc-stamp--update-saved-position (&rest _) - (remove-hook 'erc-stamp--insert-date-hook - #'erc-stamp--update-saved-position t) - (move-marker erc-last-saved-position (1- (point-max)))) - -(defun erc-stamp--reset-on-clear (pos) - "Forget last-inserted stamps when POS is at insert marker. +(defun erc-stamp--redo-right-stamp-post-clear (_ end) + "Append new right stamp to first inserted message after END." + ;; During truncation, the last existing right stamp is often deleted + ;; regardless of `erc-timestamp-only-if-changed-flag'. As of ERC 5.6, + ;; recreating inserted messages from scratch isn't doable. (Although, + ;; attempting surgery like this is likely unwise.) + (when-let ((erc-stamp--date-mode) + ((< end erc-insert-marker)) + (bounds (erc--get-inserted-msg-bounds (1+ end))) + (ts (get-text-property (car bounds) 'erc--ts)) + (format (with-suppressed-warnings + ((obsolete erc-timestamp-format-right)) + (or erc-timestamp-format-right erc-timestamp-format))) + (rendered (erc-format-timestamp ts format)) + ((not (equal rendered erc-timestamp-last-inserted-right))) + (erc--msg-props (map-into `((erc--ts . ,ts)) 'hash-table))) + (save-excursion + (save-restriction + (let ((erc-timestamp-last-inserted erc-timestamp-last-inserted) + (erc-timestamp-last-inserted-right + erc-timestamp-last-inserted-right)) + (narrow-to-region (car bounds) (cdr bounds)) + (erc-add-timestamp)))))) + +(defun erc-stamp--reset-on-clear (orig beg end) + "Forget stamps older than POS. And discard stale references in `erc-stamp--date-stamps'." - (when erc-stamp--date-stamps - (setq erc-stamp--date-stamps - (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos)) - erc-stamp--date-stamps))) - (when (= pos (1- erc-insert-marker)) - (when erc-stamp--date-mode - (add-hook 'erc-stamp--insert-date-hook - #'erc-stamp--update-saved-position 0 t)) - (setq erc-timestamp-last-inserted nil - erc-timestamp-last-inserted-left nil - erc-timestamp-last-inserted-right nil))) + (let (culled) + (when erc-stamp--date-stamps + (setq erc-stamp--date-stamps + ;; This assumes `seq-filter' visits items in order. + (seq-filter (lambda (o) + (or (> (erc-stamp--date-marker o) end) + (ignore + (set-marker (erc-stamp--date-marker o) nil) + (push o culled)))) + erc-stamp--date-stamps))) + (funcall orig beg end) + (when-let ((culled) + ((not (or (erc--memq-msg-prop 'erc--skip 'stamp) + (and erc--msg-prop-overrides + (memq 'stamp + (alist-get 'erc--skip + erc--msg-prop-overrides)))))) + (ct (erc-stamp--date-ts (car culled)))) + (cl-assert erc-stamp--date-mode) + (let ((hook (make-symbol "temporary-hook")) + (rendered (erc-stamp--format-date-stamp ct)) + (want-rhs-p (= end erc-insert-marker))) + ;; Object successfully removed from model but snapshot remains. + (cl-assert (null (cl-find rendered erc-stamp--date-stamps + :test #'string= + :key #'erc-stamp--date-str))) + ;; When it's midnight, `rendered' may still be yesterday while + ;; `erc-timestamp-last-inserted-left' is already today. + (let* ((data (make-erc-stamp--date :ts ct :str rendered)) + (erc-stamp--deferred-date-stamp data) + (erc-timestamp-last-inserted-left nil)) + (erc-stamp--defer-date-insertion-on-post-modify hook) + (set-marker (erc-stamp--date-marker data) end) + (run-hooks hook) + (unless (= ?\n (char-after erc-last-saved-position)) + (cl-assert (or erc--called-as-input-p (null erc--msg-props))) + (cl-assert (= erc-last-saved-position erc-insert-marker)) + (set-marker erc-last-saved-position (1- erc-insert-marker)))) + (when want-rhs-p + (setq erc-timestamp-last-inserted-right nil + erc-timestamp-last-inserted nil)))))) (defun erc-stamp--dedupe-date-stamps (old-stamps) "Update `erc-stamp--date-stamps' from its counterpart OLD-STAMPS. diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 711a2988302..c471d7a72ad 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -49,10 +49,31 @@ truncate tracking heavy-traffic channels." ;;enable ((add-hook 'erc-insert-done-hook #'erc-truncate-buffer) - (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging)) + (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) + (add-hook 'erc-mode-hook #'erc-truncate--setup) + (unless erc--updating-modules-p (erc-buffer-do #'erc-truncate--setup))) ;; disable ((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer) - (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging))) + (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) + (remove-hook 'erc-mode-hook #'erc-truncate--setup) + (erc-buffer-do #'erc-truncate--setup))) + +(defvar-local erc-truncate--buffer-size nil + "Temporary buffer-local override for `erc-max-buffer-size'.") + +(defun erc-truncate--setup () + "Enable or disable buffer-local `erc-truncate-mode' modifications." + (if erc-truncate-mode + (progn + (when-let ((priors (or erc--server-reconnecting erc--target-priors)) + (val (alist-get 'erc-truncate--buffer-size priors))) + (setq erc-truncate--buffer-size val)) + (add-function :before (local 'erc--clear-function) + #'erc-truncate--inhibit-when-local-and-interactive + '((depth . 20)))) + (remove-function (local 'erc--clear-function) + #'erc-truncate--inhibit-when-local-and-interactive) + (kill-local-variable 'erc-truncate--buffer-size))) (defun erc-truncate--warn-about-logging (&rest _) (when (and (not erc--target) @@ -90,46 +111,51 @@ erc-truncate-buffer-to-size (setq buffer (current-buffer)) (unless (get-buffer buffer) (error "erc-truncate-buffer-to-size: %S is not a buffer" buffer))) - (when (> (buffer-size buffer) (+ size 512)) - (with-current-buffer buffer + (with-current-buffer buffer + (when (and (not erc--inhibit-clear-p) + (> (buffer-size) + (+ (if (and erc-truncate--buffer-size + (> erc-truncate--buffer-size size)) + (setq size erc-truncate--buffer-size) + size) + 512))) ;; Though unneeded, widen anyway to preserve pre-5.5 behavior. - (save-restriction - (widen) - (let ((end (- erc-insert-marker size))) - ;; Truncate at message boundary (formerly line boundary - ;; before 5.6). - (goto-char end) - (goto-char (or (erc--get-inserted-msg-beg end) - (pos-bol))) - (setq end (point)) - ;; try to save the current buffer using - ;; `erc-save-buffer-in-logs'. We use this, in case the - ;; user has both `erc-save-buffer-in-logs' and - ;; `erc-truncate-buffer' in `erc-insert-post-hook'. If - ;; this is the case, only the non-saved part of the current - ;; buffer should be saved. Rather than appending the - ;; deleted part of the buffer to the log file. - ;; - ;; Alternatively this could be made conditional on: - ;; (not (memq 'erc-save-buffer-in-logs - ;; erc-insert-post-hook)) - ;; Comments? - ;; The comments above concern pre-5.6 behavior and reflect - ;; an obsolete understanding of how `erc-logging-enabled' - ;; behaves in practice. - (run-hook-with-args 'erc--pre-clear-functions end) - ;; disable undoing for the truncating - (buffer-disable-undo) - (let ((inhibit-read-only t)) - (delete-region (point-min) end))) - (buffer-enable-undo))))) + (save-excursion + (save-restriction + (widen) + (let ((beg (point-min-marker)) + (end (goto-char (- erc-insert-marker size)))) + ;; Truncate at message boundary (formerly line boundary + ;; before 5.6). + (goto-char (or (erc--get-inserted-msg-beg end) (pos-bol))) + (setq end (point-marker)) + (with-silent-modifications + (funcall erc--clear-function beg end)) + (set-marker beg nil) + (set-marker end nil))))))) ;;;###autoload (defun erc-truncate-buffer () "Truncate current buffer to `erc-max-buffer-size'." (interactive) + ;; This `save-excursion' only exists for historical reasons because + ;; `erc-truncate-buffer-to-size' normally runs in a different buffer. (save-excursion - (erc-truncate-buffer-to-size erc-max-buffer-size))) + (if (and erc--parsed-response erc--msg-props) + (let ((symbol (make-symbol "erc-truncate--buffer-deferred")) + (buffer (current-buffer))) + (fset symbol + (lambda (&rest _) + (remove-hook 'erc-timer-hook symbol t) + (erc-truncate-buffer-to-size erc-max-buffer-size buffer))) + (erc-with-server-buffer (add-hook 'erc-timer-hook symbol -80 t))) + (erc-truncate-buffer-to-size erc-max-buffer-size)))) + +(defun erc-truncate--inhibit-when-local-and-interactive (&rest _) + "Ensure `erc-truncate--buffer-size' is nil on /CLEAR." + (when (and erc--called-as-input-p erc-truncate--buffer-size) + (message "Resetting max buffer size to %d" erc-max-buffer-size) + (setq erc-truncate--buffer-size nil))) (provide 'erc-truncate) ;;; erc-truncate.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7d006db69a6..8938db81c20 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1793,7 +1793,9 @@ erc-mode (setq-local completion-ignore-case t) (add-hook 'post-command-hook #'erc-check-text-conversion nil t) (add-hook 'kill-buffer-hook #'erc-kill-buffer-function nil t) - (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t)) + (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t) + (add-function :before (local 'erc--clear-function) + #'erc--skip-past-headroom-on-clear '((depth . 30)))) ;; activation @@ -3386,7 +3388,8 @@ erc--with-spliced-insertion (declare (indent 1)) (let ((marker (make-symbol "marker"))) `(progn - (cl-assert (= ?\n (char-before ,marker-or-pos))) + (cl-assert (or (= ,marker-or-pos (point-min)) + (= ?\n (char-before ,marker-or-pos)))) (cl-assert (null erc--insert-line-function)) (let* ((,marker (and (not (markerp ,marker-or-pos)) (copy-marker ,marker-or-pos))) @@ -3702,7 +3705,8 @@ erc--insert-before-markers-transplanting-hidden the inserted version of STRING." (let* ((after (and (not erc-legacy-invisible-bounds-p) (get-text-property (point) 'erc--hide))) - (before (and after (get-text-property (1- (point)) 'invisible))) + (before (and after (> (point) (point-min)) + (get-text-property (1- (point)) 'invisible))) (a (and after (ensure-list after))) (b (and before (ensure-list before))) (new (and before (erc--solo (cl-intersection b a))))) @@ -4474,21 +4478,37 @@ erc--unignore-user (when-let ((existing (erc--find-ignore-timer user buffer))) (cancel-timer existing))))) -(defvar erc--pre-clear-functions nil - "Abnormal hook run when truncating buffers. -Called with position indicating boundary of interval to be excised.") +(defvar erc--clear-function #'delete-region + "Function to truncate buffer. +Called with two markers, LOWER and UPPER, indicating the bounds of the +interval to be excised. LOWER <= UPPER <= `erc-insert-marker'.") + +(defun erc--skip-past-headroom-on-clear (lower _) + "Move marker LOWER past the 2 newlines added by `erc--initialize-markers'." + (when (and (not (buffer-narrowed-p)) (= lower (point-min))) + (save-excursion + (goto-char (point-min)) + (set-marker lower (1+ (skip-chars-forward "\n" 3)))))) + +(defvar erc--inhibit-clear-p nil + "When non-nil, inhbiit buffer truncation.") (defun erc-cmd-CLEAR () "Clear messages in current buffer after informing active modules. Expect modules to perform housekeeping tasks to withstand the disruption. When called from Lisp code, only clear messages up to but not including the one occupying the current line." + (when erc--inhibit-clear-p + (user-error "Truncation currently inhibited")) (with-silent-modifications - (let ((max (if (>= (point) erc-insert-marker) - (1- erc-insert-marker) - (or (erc--get-inserted-msg-beg (point)) (pos-bol))))) - (run-hook-with-args 'erc--pre-clear-functions max) - (delete-region (point-min) max))) + (let ((end (copy-marker + (cond ((>= (point) erc-insert-marker) erc-insert-marker) + ((erc--get-inserted-msg-beg (point))) + ((pos-bol))))) + (beg (point-min-marker))) + (funcall erc--clear-function beg end) + (set-marker beg nil) + (set-marker end nil))) t) (put 'erc-cmd-CLEAR 'process-not-needed t) diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index 3c738822f96..76d3b74222d 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -117,10 +117,12 @@ erc-scenarios-log--clear-stamp (should (file-exists-p logfile)) (funcall expect 10 "please your lordship") (ert-info ("Buffer truncated") - (goto-char (point-min)) - (funcall expect 10 "@@STAMP@@" (point)) ; reset + (funcall expect 10 "@@STAMP@@" (goto-char (point-min))) ; reset (funcall expect -0.1 "Grows, lives") - (funcall expect 1 "For these two"))) + (funcall expect 1 "For these two") + ;; Stamp resides just before `erc-last-saved-position'. + (should (looking-back (rx "]\n alice: For these two"))) + (should (= erc-last-saved-position (1- (pos-bol)))))) (ert-info ("Current contents saved") (with-temp-buffer @@ -129,7 +131,7 @@ erc-scenarios-log--clear-stamp (funcall expect 1 "You have joined") (funcall expect 1 "Playback Complete.") (funcall expect 1 "Grows, lives") - (funcall expect -0.01 "please your lordship"))) + (funcall expect -0.001 "alice: For these two hours"))) (ert-info ("Remainder saved, timestamp printed when option non-nil") (with-current-buffer "foonet" @@ -180,7 +182,7 @@ erc-scenarios-log--truncate (should-not (file-exists-p logserv)) (should-not (file-exists-p logchan)) (funcall expect 10 "*** MAXLIST=beI:60") - (should (= (pos-bol) (point-min))) + (should (= (pos-bol) 22)) (should (file-exists-p logserv)))) (ert-info ("Log file ahead of truncation point") @@ -198,9 +200,13 @@ erc-scenarios-log--truncate (with-temp-buffer (insert-file-contents logchan) (funcall expect 1 "You have joined") - (funcall expect 1 "[07:04:37] alice: Here,") - (funcall expect 1 "loathed enemy") - (funcall expect -0.1 "please your lordship"))) + ;; No unwanted duplicates. + (funcall expect 1 " [07:04:37] alice: Here,") + (funcall expect -0.001 " [07:04:37] alice: Here,") + (funcall expect 1 " [07:04:42] bob: By my troth") + (funcall expect -0.001 " [07:04:42] bob: By my troth") + (funcall expect 1 "I will grant it") + (funcall expect -0.001 "loathed enemy"))) (erc-log-mode -1) (erc-truncate-mode -1) -- 2.46.0 --=-=-=--