Re: bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
v3. Move new meta-data related text properties to a single-character
interval at the head of every message. Add facility for managing such
props on behalf of modification hooks. Add utilities for retrieving data
from message-delimiting props and for traversing inserted messages.
In an attempt to tamp down on the growing mound of complications
involved in wrangling text properties across modules, I'm proposing a
general facility for managing certain props going forward. It works as
follows:
1. confine meta-data related props to a one-char interval that, along
with a preceding newline, delimit all message boundaries [1]
2. apply nonessential message-spanning props, like
`cursor-sensor-functions', lazily and only as needed by their
controlling options [2]
3. offer a means of passing state between hook stages, optionally to
end up as properties in the meta-data interval
4. keep this mechanism internal for the time being, but have it manage
most props introduced in 5.6
In some ways, this amounts to a major reworking of how ERC handles
messages during and after insertion. Initially, I wanted to defer such
an endeavor to 5.7, but it's become clear to me that doing this now will
immensely fortify the implementation of various features shipping with
this release. If you're a module author or would-be contributor, it's in
your interest to keep an eye on how this unfolds. Happy to answer
questions or concerns, as always. Thanks.
[1] In an ideal world, a message's properties would live on its
preceding newline. However, ERC's hooks have always visited messages
along with their trailing newline. Obviously, having hooks see
properties for the message to follow (or having the current
message's props live on its trailing newline) would never work.
[2] Props whose intervals inform their role, such as buttons, faces, and
display/formatting attributes, can't easily conform to this system.
But, we can still benefit from formally declaring the hook stage
(and maybe specific depth range) at which such props should be
added. For example, message-spanning props ought to be applied no
earlier than post-modification (e.g., `erc-send-post-hook' and
`erc-insert-post-hook').
0000-v2-v3.diff
(text/x-patch, 129.3 KB) - not displayed
0001-5.6-Allow-spoofing-process-marker-in-erc-display-lin.patch
(text/x-patch, 8 KB)
From 69aa1ebcac9044efc78c922dcb7805144cc237a7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 2 Oct 2023 22:59:22 -0700 Subject: [PATCH 1/7] [5.6] Allow spoofing process marker in erc-display-line-1 * lisp/erc/erc.el (erc--insert-marker): New internal variable for overriding `erc-insert-marker' when displaying messages at a non-default location in the buffer. (erc-display-line-1): Favor `erc--insert-marker' over `erc-insert-marker' when non-nil. * test/lisp/erc/resources/base/assoc/multi-net/barnet.eld: Timeouts. * test/lisp/erc/resources/base/assoc/multi-net/foonet.eld: Timeouts. * test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld: Timeouts. * test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld: Timeouts. --- lisp/erc/erc.el | 7 ++++++- .../erc/resources/base/assoc/multi-net/barnet.eld | 12 ++++++------ .../erc/resources/base/assoc/multi-net/foonet.eld | 12 ++++++------ .../erc/resources/base/netid/bouncer/barnet-drop.eld | 4 ++-- .../erc/resources/base/netid/bouncer/foonet-drop.eld | 4 ++-- 5 files changed, 22 insertions(+), 17 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fb236f1f189..b78f8bc6210 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2909,6 +2909,8 @@ erc--refresh-prompt (delete-region (point) (1- erc-input-marker)))) (run-hooks 'erc--refresh-prompt-hook))) +(defvar erc--insert-marker nil) + (defun erc-display-line-1 (string buffer) "Display STRING in `erc-mode' BUFFER. Auxiliary function used in `erc-display-line'. The line gets filtered to @@ -2932,6 +2934,8 @@ erc-display-line-1 (format "%s" buffer))) (setq erc-insert-this t) (run-hook-with-args 'erc-insert-pre-hook string) + (setq insert-position (marker-position (or erc--insert-marker + erc-insert-marker))) (if (null erc-insert-this) ;; Leave erc-insert-this set to t as much as possible. Fran ;; Litterio <franl> has seen erc-insert-this set to nil while @@ -2954,7 +2958,8 @@ erc-display-line-1 '(erc-parsed nil)))) (erc--refresh-prompt))))) (run-hooks 'erc-insert-done-hook) - (erc-update-undo-list (- (or (marker-position erc-insert-marker) + (erc-update-undo-list (- (or (marker-position (or erc--insert-marker + erc-insert-marker)) (point-max)) insert-position)))))) diff --git a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld index c62a22a11c7..4c2b1d61e24 100644 --- a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld +++ b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld @@ -1,7 +1,7 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((pass 10 "PASS :changeme")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16") (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC") @@ -18,16 +18,16 @@ (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3") (0 ":irc.barnet.org 422 tester :MOTD File is missing")) -((mode-user 8 "MODE tester +i") +((mode-user 10 "MODE tester +i") (0 ":irc.barnet.org 221 tester +i") (0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) -((join 2 "JOIN #chan") +((join 10 "JOIN #chan") (0 ":[email protected] JOIN #chan") (0 ":irc.barnet.org 353 tester = #chan :@mike joe tester") (0 ":irc.barnet.org 366 tester #chan :End of NAMES list")) -((mode 2 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1620104779") (0.1 ":[email protected] PRIVMSG #chan :tester, welcome!") diff --git a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld index f30b7deca11..bfa324642ce 100644 --- a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld +++ b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld @@ -1,7 +1,7 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((pass 10 "PASS :changeme")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC") @@ -18,16 +18,16 @@ (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") (0 ":irc.foonet.org 422 tester :MOTD File is missing")) -((mode-user 8 "MODE tester +i") +((mode-user 10 "MODE tester +i") (0 ":irc.foonet.org 221 tester +i") (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) -((join 2 "JOIN #chan") +((join 10 "JOIN #chan") (0 ":[email protected] JOIN #chan") (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob") (0 ":irc.foonet.org 366 tester #chan :End of NAMES list")) -((mode 2 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 329 tester #chan 1620104779") (0.1 ":[email protected] PRIVMSG #chan :tester, welcome!") diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld index 686a47f68a3..04959954c4f 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld @@ -22,14 +22,14 @@ (0 ":irc.znc.in 306 tester :You have been marked as being away") (0 ":irc.barnet.org 305 tester :You are no longer marked as being away")) -((join 1 "JOIN #chan") +((join 10 "JOIN #chan") (0 ":[email protected] JOIN #chan") (0 ":irc.barnet.org 353 tester = #chan :@joe mike tester") (0 ":irc.barnet.org 366 tester #chan :End of NAMES list") (0.1 ":[email protected] PRIVMSG #chan :tester, welcome!") (0 ":[email protected] PRIVMSG #chan :tester, welcome!")) -((mode 1 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1620805269") (0.1 ":[email protected] PRIVMSG #chan :joe: But you have outfaced them all.") diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld index b99621cc311..7b9b3bdee6c 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld @@ -22,14 +22,14 @@ (0 ":irc.znc.in 306 tester :You have been marked as being away") (0 ":irc.foonet.org 305 tester :You are no longer marked as being away")) -((join 1 "JOIN #chan") +((join 10 "JOIN #chan") (0 ":[email protected] JOIN #chan") (0 ":irc.foonet.org 353 tester = #chan :@alice bob tester") (0 ":irc.foonet.org 366 tester #chan :End of NAMES list") (0.1 ":[email protected] PRIVMSG #chan :tester, welcome!") (0 ":[email protected] PRIVMSG #chan :tester, welcome!")) -((mode 1 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 329 tester #chan 1620805271") (0.1 ":[email protected] PRIVMSG #chan :bob: He cannot be heard of. Out of doubt he is transported.") -- 2.41.0
0002-5.6-Honor-nil-values-in-erc-restore-initialize-prior.patch
(text/x-patch, 3.3 KB)
From ffcc811bdc69f089059ff907c4a265c406c965fc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 5 Oct 2023 00:16:46 -0700 Subject: [PATCH 2/7] [5.6] Honor nil values in erc--restore-initialize-priors * lisp/erc/erc.el (erc--restore-initialize-priors): Don't produce invalid empty `setq' when given VARS that initialize to nil. * test/lisp/erc/erc-tests.el (erc--restore-initialize-priors): Fix expected expansion. --- lisp/erc/erc.el | 17 ++++++++--------- test/lisp/erc/erc-tests.el | 17 +++++++---------- 2 files changed, 15 insertions(+), 19 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b78f8bc6210..a3ba1548084 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1366,16 +1366,15 @@ erc--target-priors (defmacro erc--restore-initialize-priors (mode &rest vars) "Restore local VARS for MODE from a previous session." (declare (indent 1)) - (let ((existing (make-symbol "existing")) + (let ((priors (make-symbol "priors")) + (initp (make-symbol "initp")) ;; - restore initialize) - (while-let ((k (pop vars)) (v (pop vars))) - (push `(,k (alist-get ',k ,existing)) restore) - (push `(,k ,v) initialize)) - `(if-let* ((,existing (or erc--server-reconnecting erc--target-priors)) - ((alist-get ',mode ,existing))) - (setq ,@(mapcan #'identity (nreverse restore))) - (setq ,@(mapcan #'identity (nreverse initialize)))))) + forms) + (while-let ((k (pop vars))) + (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms)) + `(let* ((,priors (or erc--server-reconnecting erc--target-priors)) + (,initp (and ,priors (alist-get ',mode ,priors)))) + (setq ,@(mapcan #'identity (nreverse forms)))))) (defun erc--target-from-string (string) "Construct an `erc--target' variant from STRING." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8a68eca6196..64b503832f3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -796,18 +796,15 @@ erc--valid-local-channel-p (should (erc--valid-local-channel-p "&local"))))) (ert-deftest erc--restore-initialize-priors () - ;; This `pcase' expands to 100+k. Guess we could do something like - ;; (and `(,_ ((,e . ,_) . ,_) . ,_) v) first and then return a - ;; (equal `(if-let* ((,e ...)...)...) v) to cut it down to < 1k. (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode foo (ignore 1 2 3) - bar #'spam)) - (`(if-let* ((,e (or erc--server-reconnecting erc--target-priors)) - ((alist-get 'erc-my-mode ,e))) - (setq foo (alist-get 'foo ,e) - bar (alist-get 'bar ,e)) - (setq foo (ignore 1 2 3) - bar #'spam)) + bar #'spam + baz nil)) + (`(let* ((,p (or erc--server-reconnecting erc--target-priors)) + (,q (and ,p (alist-get 'erc-my-mode ,p)))) + (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3)) + bar (if ,q (alist-get 'bar ,p) #'spam) + baz (if ,q (alist-get 'baz ,p) nil))) t)))) (ert-deftest erc--target-from-string () -- 2.41.0
0003-5.6-Preserve-format-spec-args-in-erc-server-JOIN.patch
(text/x-patch, 2.4 KB)
From 62c6585251a1d0a604499f103f87884a1b33de3b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 4 Oct 2023 20:39:03 -0700 Subject: [PATCH 3/7] [5.6] Preserve format-spec args in erc-server-JOIN * lisp/erc/erc-backend.el (erc-server-JOIN): Let `erc-display-message' handle formatting instead of baking out a string. The text ultimately inserted remains unchanged, but forwarding the original `format-spec' arguments now has the side effect of influencing text properties, which conveys richer meaning for modules to act upon when doing things like deciding whether to hide a message. --- lisp/erc/erc-backend.el | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index fb10ee31c78..bc42917375a 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1718,7 +1718,7 @@ erc--server-determine-join-display-context (if (string-match "^\\(.*\\)\^g.*$" chnl) (setq chnl (match-string 1 chnl))) (save-excursion - (let* ((str (cond + (let ((args (cond ;; If I have joined a channel ((erc-current-nick-p nick) (let ((erc--display-context @@ -1735,18 +1735,15 @@ erc--server-determine-join-display-context (erc-channel-begin-receiving-names)) (erc-update-mode-line) (run-hooks 'erc-join-hook) - (erc-make-notice - (erc-format-message 'JOIN-you ?c chnl))) + (list 'JOIN-you ?c chnl)) (t (setq buffer (erc-get-buffer chnl proc)) - (erc-make-notice - (erc-format-message - 'JOIN ?n nick ?u login ?h host ?c chnl)))))) + (list 'JOIN ?n nick ?u login ?h host ?c chnl))))) (when buffer (set-buffer buffer)) (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login) ;; on join, we want to stay in the new channel buffer ;;(set-buffer ob) - (erc-display-message parsed nil buffer str)))))) + (apply #'erc-display-message parsed 'notice buffer args)))))) (define-erc-response-handler (KICK) "Handle kick messages received from the server." nil -- 2.41.0
0004-5.6-Deprecate-option-erc-remove-parsed-property.patch
(text/x-patch, 3 KB)
From 866a2681dacc4307d9f6b177dbab5beccc740f4c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Tue, 3 Oct 2023 00:00:19 -0700 Subject: [PATCH 4/7] [5.6] Deprecate option erc-remove-parsed-property * etc/ERC-NEWS: Add entry for `erc-remove-parsed-property'. * lisp/erc/erc.el (erc-remove-parsed-property): Deprecate option because the potential for inadvertent self harm outweighs the potential benefits. Additionally, replicating this functionality via hooks is trivial. (erc-display-line-1): Remove quasi-deprecated `tags' property. --- etc/ERC-NEWS | 8 ++++++++ lisp/erc/erc.el | 13 +++++++++++-- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index fadd97b65df..284b91bb41f 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -221,6 +221,14 @@ atop any message. The new companion option 'erc-echo-timestamp-zone' determines the default timezone when not specified with a prefix argument. +** Option 'erc-remove-parsed-property' deprecated. +This option's nil behavior serves no practical purpose yet has the +potential to degrade the user experience by competing for space with +forthcoming features powered by next generation extensions. Anyone +with a legitimate use for this option likely also possesses the +knowledge to rig up a suitable analog with minimal effort. That said, +the road to removal is long. + ** Option 'erc-warn-about-blank-lines' is more informative. Enabled by default, this option now produces more useful feedback whenever ERC rejects prompt input containing whitespace-only lines. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a3ba1548084..aedec60321b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2876,9 +2876,18 @@ erc-remove-parsed-property The default is to remove it, since it causes ERC to take up extra memory. If you have code that relies on this property, then set -this option to nil." +this option to nil. + +Note that this option is deprecated because a value of nil is +impractical in prolonged sessions with more than a few channels. +Use `erc-insert-post-hook' or similar and the helper function +`erc-find-parsed-property' and friends to stash the current +`erc-response' object as needed. And instead of using this for +debugging purposes, try `erc-debug-irc-protocol'." :type 'boolean :group 'erc) +(make-obsolete-variable 'erc-remove-parsed-property + "impractical when non-nil" "30.1") (define-inline erc--assert-input-bounds () (inline-quote @@ -2954,7 +2963,7 @@ erc-display-line-1 (run-hooks 'erc-insert-post-hook) (when erc-remove-parsed-property (remove-text-properties (point-min) (point-max) - '(erc-parsed nil)))) + '(erc-parsed nil tags nil)))) (erc--refresh-prompt))))) (run-hooks 'erc-insert-done-hook) (erc-update-undo-list (- (or (marker-position (or erc--insert-marker -- 2.41.0
0005-5.6-Add-helper-for-removing-list-valued-text-props-i.patch
(text/x-patch, 10.1 KB)
From a9638d22c67ffed2fd25f4ecf10f0d3a2aac5ea9 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Tue, 3 Oct 2023 23:15:40 -0700 Subject: [PATCH 5/7] [5.6] Add helper for removing list-valued text props in ERC * lisp/erc/erc.el (erc--remove-from-prop-value-list): New function for removing `invisible' and `face' prop members cleanly. * test/lisp/erc/erc-tests.el (erc--remove-from-prop-value-list, erc--remove-from-prop-value-list/many): New tests. (Bug#60936) --- lisp/erc/erc.el | 24 ++++++ test/lisp/erc/erc-tests.el | 169 +++++++++++++++++++++++++++++++++++++ 2 files changed, 193 insertions(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index aedec60321b..f3c480f918b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3061,6 +3061,30 @@ erc--merge-prop old (get-text-property pos prop object) end (next-single-property-change pos prop object to))))) +(defun erc--remove-from-prop-value-list (from to prop val &optional object) + "Remove VAL from text prop value between FROM and TO. +If current value is VAL itself, remove the property entirely. +When VAL is a list, act as if this function were called +repeatedly with VAL set to each of VAL's members." + (let ((old (get-text-property from prop object)) + (pos from) + (end (next-single-property-change from prop object to)) + new) + (while (< pos to) + (when old + (if (setq new (and (consp old) (if (consp val) + (seq-difference old val) + (remq val old)))) + (put-text-property pos end prop + (if (cdr new) new (car new)) object) + (when (pcase val + ((pred consp) (or (consp old) (memq old val))) + (_ (if (consp old) (memq val old) (eq old val)))) + (remove-text-properties pos end (list prop nil) object)))) + (setq pos end + old (get-text-property pos prop object) + end (next-single-property-change pos prop object to))))) + (defvar erc-legacy-invisible-bounds-p nil "Whether to hide trailing rather than preceding newlines. Beginning in ERC 5.6, invisibility extends from a message's diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 64b503832f3..11717217eb2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1475,6 +1475,175 @@ erc--merge-prop (when noninteractive (kill-buffer)))) +(ert-deftest erc--remove-from-prop-value-list () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Non-list match. + (insert "abc\n") + (put-text-property 1 2 'erc-test 'a) + (put-text-property 2 3 'erc-test 'b) + (put-text-property 3 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 1 2 (erc-test b) + 2 3 (erc-test c)))) + + (erc--remove-from-prop-value-list 1 4 'erc-test 'b) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'a) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "abc")) + + ;; List match. + (goto-char (point-min)) + (insert "def\n") + (put-text-property 1 2 'erc-test '(d x)) + (put-text-property 2 3 'erc-test '(e y)) + (put-text-property 3 4 'erc-test '(f z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x)) + 1 2 (erc-test (e y)) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x)) + 1 2 (erc-test e) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'd) + (erc--remove-from-prop-value-list 1 4 'erc-test 'f) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test x) + 1 2 (erc-test e) + 2 3 (erc-test z)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'e) + (erc--remove-from-prop-value-list 1 4 'erc-test 'z) + (erc--remove-from-prop-value-list 1 4 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "def")) + + ;; List match. + (goto-char (point-min)) + (insert "ghi\n") + (put-text-property 1 2 'erc-test '(g x)) + (put-text-property 2 3 'erc-test '(h x)) + (put-text-property 3 4 'erc-test '(i y)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test (g x)) + 1 2 (erc-test (h x)) + 2 3 (erc-test (i y))))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test g) + 1 2 (erc-test h) + 2 3 (erc-test (i y))))) + (erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed + (erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 1 2 (erc-test h) + 2 3 (erc-test y)))) + + ;; Pathological (,c) case (hopefully not created by ERC) + (goto-char (point-min)) + (insert "jkl\n") + (put-text-property 1 2 'erc-test '(j x)) + (put-text-property 2 3 'erc-test '(k)) + (put-text-property 3 4 'erc-test '(k)) + (erc--remove-from-prop-value-list 1 4 'erc-test 'k) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x))))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc--remove-from-prop-value-list/many () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Non-list match. + (insert "abc\n") + (put-text-property 1 2 'erc-test 'a) + (put-text-property 2 3 'erc-test 'b) + (put-text-property 3 4 'erc-test 'c) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" + 0 1 (erc-test a) + 1 2 (erc-test b) + 2 3 (erc-test c)))) + + (erc--remove-from-prop-value-list 1 4 'erc-test '(a b)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test 'a) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 2 3 (erc-test c)))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(c)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "abc")) + + ;; List match. + (goto-char (point-min)) + (insert "def\n") + (put-text-property 1 2 'erc-test '(d x y)) + (put-text-property 2 3 'erc-test '(e y)) + (put-text-property 3 4 'erc-test '(f z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test (d x y)) + 1 2 (erc-test (e y)) + 2 3 (erc-test (f z))))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(d y f)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("def" + 0 1 (erc-test x) + 1 2 (erc-test e) + 2 3 (erc-test z)))) + (erc--remove-from-prop-value-list 1 4 'erc-test '(e z x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) "def")) + + ;; Narrowed beg. + (goto-char (point-min)) + (insert "ghi\n") + (put-text-property 1 2 'erc-test '(g x)) + (put-text-property 2 3 'erc-test '(h x)) + (put-text-property 3 4 'erc-test '(i x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 0 1 (erc-test (g x)) + 1 2 (erc-test (h x)) + 2 3 (erc-test (i x))))) + (erc--remove-from-prop-value-list 1 3 'erc-test '(x g i)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" + 1 2 (erc-test h) + 2 3 (erc-test (i x))))) + + ;; Narrowed middle. + (goto-char (point-min)) + (insert "jkl\n") + (put-text-property 1 2 'erc-test '(j x)) + (put-text-property 2 3 'erc-test '(k)) + (put-text-property 3 4 'erc-test '(l y z)) + (erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("jkl" + 0 1 (erc-test (j x)) + 1 2 (erc-test (k)) + 2 3 (erc-test l)))) + + (when noninteractive + (kill-buffer)))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space -- 2.41.0
0006-5.6-Manage-meta-data-text-props-for-ERC-hook-members.patch
(text/x-patch, 126.5 KB) - not displayed
0007-5.6-Add-command-to-refill-buffer-with-erc-fill-wrap-.patch
(text/x-patch, 6.5 KB)
From fcb34a45afd872361b0dbc8e6bd92ba53b910faa Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 21 Sep 2023 06:54:27 -0700 Subject: [PATCH 7/7] [5.6] Add command to refill buffer with erc-fill-wrap-mode * lisp/erc/erc-fill.el (erc-fill--wrap-rejigger-last-message): New internal variable. (erc-fill--wrap-rejigger-region, erc-fill-wrap-refill-buffer): New command and helper function. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--simulate-refill): New function for approximating `erc-fill-wrap-refill-buffer' without pauses to accept process output. (erc-fill-wrap--merge): Assert refilling is idempotent. (Bug#60936) --- lisp/erc/erc-fill.el | 70 +++++++++++++++++++++++++++++++++ test/lisp/erc/erc-fill-tests.el | 18 ++++++++- 2 files changed, 86 insertions(+), 2 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 62a9597d481..8b86cf30bf4 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -543,6 +543,76 @@ erc-fill-wrap `((space :width (- erc-fill--wrap-value ,len)) (space :width erc-fill--wrap-value)))))) +(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 +stash and restore `erc-fill--wrap-last-msg' before doing so, in +case this module's insert hooks run by way of the process filter. +With REPAIRP, destructively fill gaps and re-merge speakers." + (goto-char start) + (cl-assert (null erc-fill--wrap-rejigger-last-message)) + (let (erc-fill--wrap-rejigger-last-message) + (while-let + (((< (point) finish)) + (beg (if (get-text-property (point) 'line-prefix) + (point) + (next-single-property-change (point) 'line-prefix))) + (val (get-text-property beg 'line-prefix)) + (end (text-property-not-all beg finish 'line-prefix val))) + ;; If this is a left-side stamp on its own line. + (remove-text-properties beg (1+ end) '(line-prefix nil wrap-prefix nil)) + (when-let ((repairp) + (dbeg (text-property-not-all beg end 'display nil)) + ((get-text-property (1+ dbeg) 'erc-speaker)) + (dval (get-text-property dbeg 'display)) + ((equal "" dval))) + (remove-text-properties + dbeg (text-property-not-all dbeg end 'display dval) '(display))) + (let* ((pos (if (eq 'date-left (get-text-property beg 'erc-stamp-type)) + (field-beginning beg) + beg)) + (erc--msg-props (map-into (text-properties-at pos) 'hash-table)) + (erc-stamp--current-time (gethash 'erc-ts erc--msg-props))) + (save-restriction + (narrow-to-region beg (1+ end)) + (let ((erc-fill--wrap-last-msg erc-fill--wrap-rejigger-last-message)) + (erc-fill-wrap) + (setq erc-fill--wrap-rejigger-last-message + erc-fill--wrap-last-msg)))) + (when on-next + (funcall on-next)) + ;; Skip to end of message upon encountering accidental gaps + ;; introduced by third parties (or bugs). + (if-let (((/= ?\n (char-after end))) + (next (erc--get-inserted-msg-bounds 'end beg))) + (progn + (cl-assert (= ?\n (char-after next))) + (when repairp ; eol <= next + (put-text-property end (pos-eol) 'line-prefix val)) + (goto-char next)) + (goto-char end))))) + +(defun erc-fill-wrap-refill-buffer (repair) + "Recalculate all `fill-wrap' prefixes in the current buffer. +With REPAIR, attempt to destructively fix merged properties." + (interactive "P") + (unless erc-fill-wrap-mode + (user-error "Module `fill-wrap' not active in current buffer.")) + (save-excursion + (with-silent-modifications + (let* ((rep (make-progress-reporter + "Rewrap" 0 (line-number-at-pos erc-insert-marker) 1)) + (seen 0) + (callback (lambda () + (progress-reporter-update rep (cl-incf seen)) + (accept-process-output nil 0.000001)))) + (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker + callback repair) + (progress-reporter-done rep))))) + ;; FIXME use own text property to avoid false positives. (defun erc-fill--wrap-merged-button-p (point) (equal "" (get-text-property point 'display))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 8f0c8f9ccf4..f6c4c268017 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -234,6 +234,13 @@ erc-fill-wrap--monospace (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ") (erc-fill-tests--compare "monospace-04-reset"))))) +(defun erc-fill-tests--simulate-refill () + ;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without + ;; a progress reporter. + (save-excursion + (with-silent-modifications + (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker nil nil)))) + (ert-deftest erc-fill-wrap--merge () :tags '(:unstable) (unless (>= emacs-major-version 29) @@ -245,7 +252,9 @@ erc-fill-wrap--merge (erc-update-channel-member "#chan" "Dummy" "Dummy" t nil nil nil nil nil "fake" "~u" nil nil t) - ;; Set this here so that the first few messages are from 1970 + ;; Set this here so that the first few messages are from 1970. + ;; Following the current date stamp, the speaker isn't merged + ;; even though it's continued: "<bob> zero." (let ((erc-fill-tests--time-vals (lambda () 1680332400))) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "alice" "one.") @@ -267,7 +276,12 @@ erc-fill-wrap--merge (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> " "<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ") - (erc-fill-tests--compare "merge-02-right"))))) + (erc-fill-tests--compare "merge-02-right") + + (ert-info ("Command `erc-fill-wrap-refill-buffer' is idempotent") + (kill-buffer (pop erc-fill-tests--buffers)) + (erc-fill-tests--simulate-refill) ; idempotent + (erc-fill-tests--compare "merge-02-right")))))) (ert-deftest erc-fill-wrap--merge-action () :tags '(:unstable) -- 2.41.0