From: F. Jason Park Date: Fri, 9 Feb 2024 04:28:56 +0000 (-0800) Subject: Fix date-stamp regression in erc-fill-wrap X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5a81ed13ea86c1c1da8283dbf5d9c6d3342a297d;p=emacs.git Fix date-stamp regression in erc-fill-wrap * lisp/erc/erc-fill.el (erc-fill-wrap, erc-fill-wrap-enable) (erc-fill-wrap-disable): Add and remove `erc-stamp--insert-date-hook' member. (erc-fill--wrap-continued-predicate): Add function-valued variable for modules to influence `erc-fill--wrap-continued-message-p', which was originally introduced as part of bug#60936. (erc-fill--wrap-rejigger-last-message): Move toward beginning of file. (erc-fill--wrap-unmerge-on-date-stamp): New function. (erc-fill-wrap): Use `erc-fill--wrap-continued-predicate'. Restore recently deleted hunk that reset the wrap marker upon seeing a date stamp. * test/lisp/erc/erc-scenarios-fill-wrap.el: New file. * test/lisp/erc/resources/fill/wrap/merge-datestamp.eld: New file. (cherry picked from commit 7aa91b299e9dd9f416a22658afed1a8edf323b30) --- diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index b2c8c991c96..9d969b39ad2 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -543,6 +543,8 @@ via `erc-fill-wrap-mode-hook'." (if erc-fill-wrap-align-prompt (setq erc-stamp--skip-left-margin-prompt-p t) (setq erc--inhibit-prompt-display-property-p t))) + (add-hook 'erc-stamp--insert-date-hook + #'erc-fill--wrap-unmerge-on-date-stamp 20 t) (setq erc-fill--function #'erc-fill-wrap) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions @@ -558,9 +560,11 @@ via `erc-fill-wrap-mode-hook'." (kill-local-variable 'erc--inhibit-prompt-display-property-p) (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) (remove-hook 'erc--refresh-prompt-hook - #'erc-fill--wrap-indent-prompt) + #'erc-fill--wrap-indent-prompt t) (remove-hook 'erc-button--prev-next-predicate-functions - #'erc-fill--wrap-merged-button-p t)) + #'erc-fill--wrap-merged-button-p t) + (remove-hook 'erc-stamp--insert-date-hook + #'erc-fill--wrap-unmerge-on-date-stamp t)) 'local) (defvar-local erc-fill--wrap-length-function nil @@ -654,6 +658,24 @@ Also cover region with text prop `erc-fill--wrap-merge' set to t." (cdr (setq erc-fill--wrap-merge-indicator-pre (cons s (erc-fill--wrap-measure (point-min) (point)))))))) +(defvar erc-fill--wrap-continued-predicate #'erc-fill--wrap-continued-message-p + "Function called with no args to detect a continued speaker.") + +(defvar erc-fill--wrap-rejigger-last-message nil + "Temporary working instance of `erc-fill--wrap-last-msg'.") + +(defun erc-fill--wrap-unmerge-on-date-stamp () + "Re-wrap message on date-stamp insertion." + (when (and erc-fill-wrap-merge (null erc-fill--wrap-rejigger-last-message)) + (let ((next-beg (point-max))) + (save-restriction + (widen) + (when-let (((get-text-property next-beg 'erc-fill--wrap-merge)) + (end (erc--get-inserted-msg-bounds next-beg)) + (beg (pop end)) + (erc-fill--wrap-continued-predicate #'ignore)) + (erc-fill--wrap-rejigger-region (1- beg) (1+ end) nil 'repairp)))))) + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." @@ -674,6 +696,8 @@ See `erc-fill-wrap-mode' for details." (skip-syntax-forward "^-") (forward-char) (cond ((eq msg-prop 'datestamp) + (when erc-fill--wrap-rejigger-last-message + (set-marker erc-fill--wrap-last-msg (point-min))) (save-excursion (goto-char (point-max)) (skip-chars-backward "\n") @@ -682,7 +706,7 @@ See `erc-fill-wrap-mode' for details." (prog1 (erc-fill--wrap-measure beg (point)) (delete-region (1- (point)) (point)))))) ((and erc-fill-wrap-merge - (erc-fill--wrap-continued-message-p)) + (funcall erc-fill--wrap-continued-predicate)) (add-text-properties (point-min) (point) '(display "" erc-fill--wrap-merge "")) @@ -713,9 +737,6 @@ See `erc-fill-wrap-mode' for details." 'line-prefix `(space :width (- erc-fill--wrap-value ,len))))) -(defvar erc-fill--wrap-rejigger-last-message nil - "Temporary working instance of `erc-fill--wrap-last-msg'.") - (defun erc-fill--wrap-rejigger-region (start finish on-next repairp) "Recalculate `line-prefix' from START to FINISH. After refilling each message, call ON-NEXT with no args. But @@ -770,6 +791,7 @@ With REPAIRP, destructively fill gaps and re-merge speakers." (goto-char next)) (goto-char end))))) +;; FIXME restore rough window position after finishing. (defun erc-fill-wrap-refill-buffer (repair) "Recalculate all `fill-wrap' prefixes in the current buffer. With REPAIR, attempt to refresh \"speaker merges\", which may be diff --git a/test/lisp/erc/erc-scenarios-fill-wrap.el b/test/lisp/erc/erc-scenarios-fill-wrap.el new file mode 100644 index 00000000000..4ebbc6bba73 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-fill-wrap.el @@ -0,0 +1,94 @@ +;;; erc-scenarios-fill-wrap.el --- Fill-wrap module -*- lexical-binding: t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(defun erc-scenarios-fill-wrap--merged-p () + (get-text-property (pos-bol) 'erc-fill--wrap-merge)) + +;; This asserts that an intervening date stamp between two messages +;; from the same speaker will trigger a break in merge detection, so +;; the second message's speaker tag won't be hidden. +(ert-deftest erc-scenarios-fill-wrap/merge-datestamp () + :tags '(:expensive-test) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "fill/wrap") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'merge-datestamp)) + (erc-stamp--tz t) + ;; Start at 2023-10-22T06:16:43.445Z + (erc-stamp--current-time (if (< emacs-major-version 29) + '(25908 23515 445000 0) + '(1697930203445 . 1000))) + (erc-timer-hook (cons (lambda (&rest _) + (setq erc-stamp--current-time + (time-add erc-stamp--current-time 15))) + erc-timer-hook)) + (expect (erc-d-t-make-expecter)) + (erc-autojoin-channels-alist '((foonet "#chan" "#control"))) + (erc-modules `(nicks fill-wrap scrolltobottom ,@erc-modules)) + (port (process-contact dumb-server :service))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "This server is in debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "dummy")) + (funcall expect 10 " hi") + (funcall expect 10 " there")) + + (with-current-buffer "#chan" + (funcall expect 10 " tester, welcome") + + ;; Force date change. + (setq erc-stamp--current-time + (time-add erc-stamp--current-time (* 60 60)))) + + (with-current-buffer "#control" + (erc-send-message "1")) + + (with-current-buffer "#chan" + (funcall expect 10 "[Sun Oct 22 2023]") + (funcall expect 10 " one") + (should-not (erc-scenarios-fill-wrap--merged-p))) + + (with-current-buffer "#control" + (erc-send-message "2")) + + (with-current-buffer "dummy" + (funcall expect 10 "[Sun Oct 22 2023]") + (funcall expect 10 " again") + (should-not (erc-scenarios-fill-wrap--merged-p))) + + (with-current-buffer "#chan" + (funcall expect 10 " bob: He was famous")) + + (erc-scrolltobottom-mode -1))) + +;;; erc-scenarios-fill-wrap.el ends here diff --git a/test/lisp/erc/resources/fill/wrap/merge-datestamp.eld b/test/lisp/erc/resources/fill/wrap/merge-datestamp.eld new file mode 100644 index 00000000000..e8dcbe2b350 --- /dev/null +++ b/test/lisp/erc/resources/fill/wrap/merge-datestamp.eld @@ -0,0 +1,55 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 26 May 2024 09:32:55 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server") + (0.02 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 2 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.03 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.00 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +Zi") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode-user 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +Zi")) + +((join 10 "JOIN #chan") + (0.02 ":tester!~u@psu3bp52z9f34.irc JOIN #chan") + (0.06 ":irc.foonet.org 353 tester = #chan :bob dummy tester @fsbot alice") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")) + +((join 10 "JOIN #control") + (0.02 ":tester!~u@psu3bp52z9f34.irc JOIN #control") + (0.06 ":irc.foonet.org 353 tester = #control :@tester") + (0.01 ":irc.foonet.org 366 tester #control :End of NAMES list")) + +((mode-chan 10 "MODE #chan") + (0.02 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1716715981") + (0.00 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!") + (0.00 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #control") + (0.02 ":irc.foonet.org 324 tester #control +Cnt") + (0.01 ":irc.foonet.org 329 tester #control 1716715981") + + (0.02 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :hi") + (0.03 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :there")) + +;; Date changes here. +((privmsg-chan-a 10 "PRIVMSG #control :1") + (0.07 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :one")) + +((privmsg-chan-a 10 "PRIVMSG #control :2") + (0.00 ":bob!~u@zmmipd3xfii2w.irc PRIVMSG #chan :two") + (0.02 ":dummy!~u@psu3bp52z9f34.irc PRIVMSG tester :again") + (0.04 ":alice!~u@zmmipd3xfii2w.irc PRIVMSG #chan :bob: He was famous, sir, in his profession, and it was his great right to be so: Gerard de Narbon."))