From: "J.P." <jp@neverwas.me>
To: 60936@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
Date: Wed, 27 Sep 2023 06:59:48 -0700 [thread overview]
Message-ID: <87pm23yawb.fsf__39845.6469339848$1695823286$gmane$org@neverwas.me> (raw)
In-Reply-To: <87a5te47sz.fsf@neverwas.me> (J. P.'s message of "Fri, 22 Sep 2023 07:11:08 -0700")
[-- Attachment #1: Type: text/plain, Size: 343 bytes --]
v2. Move massaging of `invisible' date-stamp intervals from `erc-fill'
to `erc-stamp'. Ensure `erc-timestamp-format-left' has a trailing
newline. Add helper for easily removing `invisible' prop members. Ensure
`erc-fill' extends the `erc-command' text prop to cover prepended
whitespace. Don't add inherited `invisible' props to date stamps.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 33668 bytes --]
From d8870a3dede52045518dc24a53143295df899943 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 27 Sep 2023 06:33:06 -0700
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
[5.6] Prefer ticks/hz pairs for some ERC timestamps on 29+
[5.6] Fix date-stamp invisibility in erc-fill-wrap
[5.6] Add command to refill buffer with erc-fill-wrap-mode
etc/ERC-NEWS | 12 +-
lisp/erc/erc-compat.el | 15 +++
lisp/erc/erc-fill.el | 96 +++++++++++----
lisp/erc/erc-stamp.el | 119 ++++++++++++++++---
lisp/erc/erc.el | 61 ++++++++--
test/lisp/erc/erc-scenarios-log.el | 1 +
test/lisp/erc/erc-scenarios-match.el | 163 ++++++++++++++++++++++++--
test/lisp/erc/erc-tests.el | 169 +++++++++++++++++++++++++++
8 files changed, 574 insertions(+), 62 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 05e933930e2..6743e49cfec 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -149,13 +149,17 @@ minor-mode maps, and new third-party modules should do the same.
** Option 'erc-timestamp-format-right' deprecated.
Having to account for this option prevented other ERC modules from
-easily determining what right-hand stamps would look like before
+easily determining what right-sided stamps would look like before
insertion, which is knowledge needed for certain UI decisions. The
way ERC has chosen to address this is imperfect and boils down to
asking users who've customized this option to switch to
-'erc-timestamp-format' instead. If you're affected by this and feel
-that some other solution, like automatic migration, is justified,
-please make that known on the bug list.
+'erc-timestamp-format' instead. Somewhat relatedly, the companion
+option 'erc-timestamp-format-left', which determines the look of date
+stamps, must now end in a newline. Although this has long been the
+case in practice, it's now been made official. As always, if you're
+affected by these changes and feel that other solutions, like
+automatic migration, are justified, please make that known on the bug
+list.
** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
It's no secret that the 'buttons' module treats potential nicknames
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 4dae578de67..4c376cfbc22 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -444,11 +444,20 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; We can't store (TICKS . HZ) style timestamps on 27 and 28 because
+;; `time-less-p' and friends do
+;;
+;; message("obsolete timestamp with cdr ...", ...)
+;; decode_lisp_time(_, WARN_OBSOLETE_TIMESTAMPS, ...)
+;; lisp_time_struct(...)
+;; time_cmp(...)
+;;
+;; which spams *Messages* (and stderr when running the test suite).
(defmacro erc-compat--current-lisp-time ()
- "Return `current-time' as a frequency pair."
+ "Return `current-time' as a (TICKS . HZ) pair on 29+."
(if (>= emacs-major-version 29)
'(let (current-time-list) (current-time))
- '(time-convert nil t)))
+ '(current-time)))
(provide 'erc-compat)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 78b29b51cf7..b419fb57bd4 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -488,20 +488,19 @@ erc-fill--wrap-measure
"Return display spec width for inserted region between BEG and END.
Ignore any `invisible' props that may be present when figuring."
(if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
- (save-restriction
- (narrow-to-region beg end)
- (let (buffer-invisibility-spec)
- (list (car (buffer-text-pixel-size)))))
+ ;; `buffer-text-pixel-size' can move point!
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (let (buffer-invisibility-spec)
+ (list (car (buffer-text-pixel-size))))))
(- end beg)))
(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest _)
"Apply `line-prefix' property to args.
-Expect a multi-line \"date\" stamp, similar to that provided by
-the default value of `erc-timestamp-format-left'. Add
-`erc-stamp-type' property with the symbol `date-left' as its
-value. Possibly adjust invisibility interval to begin at the
-previous newline and extend until the end of the last line of the
-stamp, not including its line ending."
+Expect a multiline \"date\" stamp ending in a newline, similar to
+the default value of `erc-timestamp-format-left'. Omit the
+`line-prefix' from any trailing newlines."
(let* ((beg)
;; Insert " " to simulate gap between <speaker> and msg beg.
(end (save-excursion (skip-chars-backward "\n")
@@ -510,18 +509,8 @@ erc-fill--wrap-stamp-insert-prefixed-date
(point)))
(width (erc-fill--wrap-measure beg end)))
(delete-region (1- end) end)
- ;; Offset existing invisibility bounds by decrementing. See
- ;; `erc-legacy-invisible-bounds-p'.
- (when-let ((invisible (get-text-property (point) 'invisible))
- (min (point-min)))
- (save-restriction
- (widen)
- (remove-text-properties (max 1 (1- min)) (1+ (point)) '(invisible nil))
- (narrow-to-region min (1+ (point)))
- (erc--hide-message invisible)))
- (put-text-property (point-min) (point) 'erc-stamp-type 'date-left)
;; Use `point-min' instead of `beg' to cover leading newilnes.
- (put-text-property (point-min) (point) 'line-prefix
+ (put-text-property (point-min) (1- end) 'line-prefix
`(space :width (- erc-fill--wrap-value ,width)))))
;; An escape hatch for third-party code expecting speakers of ACTION
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 4e16906c550..68dd1f287cf 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,21 +55,35 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
-;; FIXME remove surrounding whitespace from default value and have
-;; `erc-insert-timestamp-left-and-right' add it before insertion.
+(defun erc-stamp--custom-trailing-newline-p (_ value)
+ "Return non-nil if VALUE ends in a newline."
+ (string-suffix-p "\n" value))
-(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
- "If set to a string, messages will be timestamped.
-This string is processed using `format-time-string'.
-Good examples are \"%T\" and \"%H:%M\".
-
-This timestamp is used for timestamps on the left side of the
-screen when `erc-insert-timestamp-function' is set to
-`erc-insert-timestamp-left-and-right'.
+(defun erc-stamp--custom-validate-date-stamp (widget)
+ "Fail unless WIDGET's value ends in a newline."
+ (unless (string-suffix-p "\n" (widget-value widget))
+ (widget-put widget :error "Value lacks a trailing newline")
+ widget))
-If nil, timestamping is turned off."
- :type '(choice (const nil)
- (string)))
+(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
+ "Format recognized by `format-time-string' for date stamps.
+Only considered when `erc-insert-timestamp-function' is set to
+`erc-insert-timestamp-left-and-right'. Used for displaying date
+stamps on their own line, between messages. As of ERC 5.6, this
+module appends a trailing newline on insertion if needed. Any
+extra newlines, leading or trailing, become empty lines. For
+example, the default value results in an empty line after the
+previous message, followed by the timestamp on its own line,
+followed immediately by the next message on the next line. ERC
+expects to display these stamps less frequently, so the
+formatting specifiers should reflect that. To omit these stamps
+entirely, use a different `erc-insert-timestamp-function', such
+as `erc-timestamp-format-right'."
+ :type '(string :validate erc-stamp--custom-validate-date-stamp
+ :match erc-stamp--custom-trailing-newline-p)
+ :set (lambda (sym val)
+ (set-default sym
+ (if (string-suffix-p "\n" val) val (concat val "\n")))))
(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
@@ -374,7 +388,15 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+;; These are currently extended manually, but we could also bind
+;; `text-property-default-nonsticky' and call `insert-and-inherit'
+;; instead of `insert', but we'd have to pair the props with differing
+;; boolean values for left and right stamps. Also, since this hook
+;; runs last, we can't expect overriding sticky props to be absent,
+;; even though, as of 5.6, `front-sticky' is only added by the
+;; `readonly' module after hooks run.
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
+ "Extant properties at the start of a message inherited by the stamp.")
(declare-function erc--remove-text-properties "erc" (string))
@@ -604,21 +626,69 @@ erc-stamp--insert-date-function
A local module might use this to modify text properties,
`insert-before-markers' or renarrow the region after insertion.")
+(defun erc-stamp--decrement-date-invisibility-bounds ()
+ "Extend `invisible' prop to previous newline before date stamp.
+And apply original prop value from message body to any trailing
+newlines after date."
+ (let ((beg (point-min)))
+ (save-restriction
+ (widen)
+ (when (and (> beg 4) (= (char-before beg) ?\n))
+ (when-let ((this (get-text-property (point) 'invisible))
+ (prev (get-text-property (1- beg) 'invisible))
+ ((not (equal this prev))))
+ (put-text-property (1- beg) beg 'invisible
+ (seq-difference (ensure-list prev)
+ (ensure-list this))))
+ (put-text-property (1- beg) beg 'invisible 'timestamp)))
+ (cl-assert (= ?\n (char-before (point))))
+ ;; Only decrement bounds by one. Additional newlines in the
+ ;; timestamp must be hidden.
+ (if-let ((existing (remq 'timestamp
+ (ensure-list erc-stamp--invisible-property))))
+ (put-text-property (1- (point)) (point) 'invisible
+ (if (cdr existing) existing (car existing)))
+ (erc--remove-from-prop-value-list
+ (1- (point)) (point) 'invisible 'timestamp))))
+
+(defvar-local erc-stamp--checked-date-string-p nil
+ "Non-nil if date string has been validated for current buffer.")
+
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
When the deprecated option `erc-timestamp-format-right' is nil,
use STRING, which originates from `erc-timestamp-format', for the
right-hand stamp. Use `erc-timestamp-format-left' for the
left-hand stamp and expect it to change less frequently. Include
-line endings present in `erc-timestamp-format-left' as part of
-the `erc-timestamp' field, which extends to the start of the
-message proper. Do this so other code knows the stamp is part of
-the subsequent IRC message even though it may appear on its own
-line. However, allow the stamp's `invisible' property to span a
-different interval, in order to satisfy newer folding
-requirements related to `erc-legacy-invisible-bounds-p'."
+line endings found in `erc-timestamp-format-left' (or affixed by
+ERC) as part of the `erc-timestamp' field, which extends to the
+start of the message proper. Do this so other code knows the
+stamp is part of the subsequent IRC message even though it may
+appear on its own line. However, allow the stamp's `invisible'
+property to span a different interval, in order to satisfy newer
+folding requirements related to `erc-legacy-invisible-bounds-p'.
+Additionally, ensure every date stamp formatted with the option
+`erc-timestamp-format-left' has the property `erc-stamp-type' set
+to the symbol `date-left' so that modules can easily distinguish
+between other left-sided stamps and date stamps inserted by this
+function."
+ (unless erc-stamp--checked-date-string-p
+ (setq erc-stamp--checked-date-string-p t)
+ (unless (string-suffix-p "\n" erc-timestamp-format-left)
+ (setq erc-timestamp-format-left
+ (concat erc-timestamp-format-left "\n"))
+ (unless erc--target
+ (erc-button--display-error-notice-with-keys
+ (current-buffer)
+ "ERC only supports values of `%s' that end in a ?\\n."
+ " Changing value for current session to: %s."
+ " Update your config accordingly to silence this message."
+ 'erc-timestamp-format-left
+ (let ((print-escape-newlines t))
+ (prin1-to-string erc-timestamp-format-left))))))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-left (let ((erc-stamp--invisible-property 'timestamp))
+ (erc-format-timestamp ct erc-timestamp-format-left)))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
@@ -627,8 +697,14 @@ erc-insert-timestamp-left-and-right
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
- (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
+ (add-text-properties 0 (length ts-left)
+ '(field erc-timestamp erc-stamp-type date-left)
+ ts-left)
(funcall erc-stamp--insert-date-function ts-left)
+ (unless (with-suppressed-warnings
+ ((obsolete erc-legacy-invisible-bounds-p))
+ erc-legacy-invisible-bounds-p)
+ (erc-stamp--decrement-date-invisibility-bounds))
(setq erc-timestamp-last-inserted-left ts-left))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e4b0cd0ddbe..db2e20c800e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1128,9 +1128,13 @@ erc-insert-modify-hook
"Insertion hook for functions that will change the text's appearance.
This hook is called just after `erc-insert-pre-hook' when the value
of `erc-insert-this' is t.
-While this hook is run, narrowing is in effect and `current-buffer' is
-the buffer where the text got inserted. One possible value to add here
-is `erc-fill'."
+
+ERC runs this hook with the buffer narrowed to the bounds of the
+inserted message plus a trailing newline. Built-in modules place
+their hook members at depths between 20 and 80, with those from
+the stamp module always running last. Use the functions
+`erc-find-parsed-property' and `erc-get-parsed-vector' to locate
+and extract the `erc-response' object for the inserted message."
:group 'erc-hooks
:type 'hook)
@@ -3037,6 +3041,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
@@ -8078,13 +8106,21 @@ erc-find-parsed-property
"Find the next occurrence of the `erc-parsed' text property."
(text-property-not-all (point-min) (point-max) 'erc-parsed nil))
+(defvar erc--persistent-message-properties '(erc-command))
+
(defun erc-restore-text-properties ()
- "Restore the property `erc-parsed' for the region."
- (when-let* ((parsed-posn (erc-find-parsed-property))
- (found (erc-get-parsed-vector parsed-posn)))
+ "Ensure the `erc-parsed' property covers the narrowed buffer.
+Do this for other properties added by `erc-display-message' and
+for those named in `erc--persistent-message-properties'."
+ (when-let ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
(put-text-property (point-min) (point-max) 'erc-parsed found)
(when-let ((tags (get-text-property parsed-posn 'tags)))
- (put-text-property (point-min) (point-max) 'tags tags))))
+ (put-text-property (point-min) (point-max) 'tags tags))
+ (let ((to (max (point-min) (1- (point-max)))))
+ (dolist (prop erc--persistent-message-properties)
+ (when-let ((val (get-text-property parsed-posn prop)))
+ (put-text-property (point-min) to prop val))))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -8109,7 +8145,7 @@ erc--get-eq-comparable-cmd
See also `erc-message-type'."
;; IRC numerics are three-digit numbers, possibly with leading 0s.
;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
- (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+ (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n))
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index fd030d90c2f..f7e7d61c92e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -81,6 +81,7 @@ erc-scenarios-log--kill-hook
(ert-deftest erc-scenarios-log--clear-stamp ()
:tags '(:expensive-test)
+ (require 'erc-stamp)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index bf74806207d..bc06d58c3e9 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -328,20 +328,25 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap
;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
- (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
- (if erc-legacy-invisible-bounds-p
- (should (eq (get-text-property mend 'invisible) 'match-fools))
- (should (eq (get-text-property mbeg 'invisible) 'match-fools))
- (should-not (get-text-property mend 'invisible))))))
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))
;; Only the message right after Alice speaks contains stamps.
(when (= 1 bob-utterance-counter)
(ert-info ("Date stamp occupying previous line is invisible")
+ (should (eq 'match-fools (get-text-property (point) 'invisible)))
(save-excursion
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
+ (ert-info ("Stamp's NL `invisible' as fool, not timestamp")
+ (let ((end (match-end 0)))
+ (should (eq (char-after end) ?\n))
+ (should (eq 'timestamp
+ (get-text-property (1- end) 'invisible)))
+ (should (eq 'match-fools
+ (get-text-property end 'invisible)))))
(should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point)))
;; Date stamp has a combined `invisible' property value
;; that starts at the previous message's trailing newline
@@ -349,7 +354,7 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap
(should (equal ?\n (char-before (point))))
(should (equal ?\n (char-before (1- (point)))))
(let ((val (get-text-property (- (point) 2) 'invisible)))
- (should (equal val '(timestamp match-fools)))
+ (should (equal val 'timestamp))
(should (= (text-property-not-all (- (point) 2) (point-max)
'invisible val)
(pos-eol))))))
@@ -381,7 +386,7 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(should-not (next-single-property-change (pos-bol) 'invisible))))))
-(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
+(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds)
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
@@ -405,7 +410,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `match-fools'.
(should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
+ (let* ((mbeg (and (get-text-property (pos-bol) 'erc-command)
+ (pos-bol)))
(mend (next-single-property-change mbeg 'erc-command)))
(if (/= 1 bob-utterance-counter)
@@ -437,12 +443,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
- ;; Date stamp has a combined `invisible' property value
- ;; that extends until the start of the message proper.
- (should (equal (get-text-property (point) 'invisible)
- '(timestamp match-fools)))
- (should (= (next-single-property-change (point) 'invisible)
- (1+ (pos-eol))))))
+ (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n
+ (funcall assert-ds))) ; "assert date stamp"
(ert-info ("Folding preserved despite invisibility")
;; Message has a trailing time stamp, but it's been folded
@@ -475,13 +477,42 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
:tags '(:expensive-test)
- (erc-scenarios-match--stamp-both-invisible-fill-static))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that starts from the
+ ;; newline delimiting the current and previous messages and
+ ;; extends until the stamp's final newline. It is not combined
+ ;; with the old value, `match-fools'.
+ (let ((delim-pos (- (point) 2)))
+ (should (equal 'timestamp (get-text-property delim-pos 'invisible)))
+ ;; Stamp-only invisibility ends before its last newline.
+ (should (= (text-property-not-all delim-pos (point-max)
+ 'invisible 'timestamp)
+ (match-end 0))))))) ; pos-eol
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
:tags '(:expensive-test)
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(should-not erc-legacy-invisible-bounds-p)
+
(let ((erc-legacy-invisible-bounds-p t))
- (erc-scenarios-match--stamp-both-invisible-fill-static))))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that covers its
+ ;; format string exactly. It is not combined with the old
+ ;; value, `match-fools'.
+ (let ((delim-prev (- (point) 2)))
+ (should-not (get-text-property delim-prev 'invisible))
+ (should (eq 'erc-timestamp (field-at-pos (point))))
+ (should (= (next-single-property-change delim-prev 'invisible)
+ (field-beginning (point))))
+ (should (equal 'timestamp
+ (get-text-property (1- (point)) 'invisible)))
+ ;; Stamp-only invisibility includes last newline.
+ (should (= (text-property-not-all (1- (point)) (point-max)
+ 'invisible 'timestamp)
+ (field-end (point))))))))))
;;; erc-scenarios-match.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 05d45b2d027..3fb96ae64d3 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1385,6 +1385,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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Prefer-ticks-hz-pairs-for-some-ERC-timestamps-on.patch --]
[-- Type: text/x-patch, Size: 2172 bytes --]
From b56f6410aa1d6bc94b74671cabdcaf17b38b2574 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 18 Sep 2023 22:50:28 -0700
Subject: [PATCH 1/3] [5.6] Prefer ticks/hz pairs for some ERC timestamps on
29+
* lisp/erc/erc-compat.el (erc-compat--current-lisp-time): New macro to
prefer ticks/hz pairs on newer Emacs versions without producing a
compiler warning on 27 and 28. Stamps of this form are easier to
compare at a glance when used as values for text properties.
* lisp/erc/erc-stamp.el (erc-stamp--current-time): Use compat macro.
(Bug#60936)
---
lisp/erc/erc-compat.el | 15 +++++++++++++++
lisp/erc/erc-stamp.el | 2 +-
2 files changed, 16 insertions(+), 1 deletion(-)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 109b5d245ab..4c376cfbc22 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -444,6 +444,21 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; We can't store (TICKS . HZ) style timestamps on 27 and 28 because
+;; `time-less-p' and friends do
+;;
+;; message("obsolete timestamp with cdr ...", ...)
+;; decode_lisp_time(_, WARN_OBSOLETE_TIMESTAMPS, ...)
+;; lisp_time_struct(...)
+;; time_cmp(...)
+;;
+;; which spams *Messages* (and stderr when running the test suite).
+(defmacro erc-compat--current-lisp-time ()
+ "Return `current-time' as a (TICKS . HZ) pair on 29+."
+ (if (>= emacs-major-version 29)
+ '(let (current-time-list) (current-time))
+ '(current-time)))
+
(provide 'erc-compat)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index f159b6d226f..0f3163bf68d 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -215,7 +215,7 @@ erc-stamp--current-time
(cl-defgeneric erc-stamp--current-time ()
"Return a lisp time object to associate with an IRC message.
This becomes the message's `erc-timestamp' text property."
- (let (current-time-list) (current-time)))
+ (erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
(or erc-stamp--current-time (cl-call-next-method)))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Fix-date-stamp-invisibility-in-erc-fill-wrap.patch --]
[-- Type: text/x-patch, Size: 41674 bytes --]
From 4b16614f2e3ec9f9a376de54efa8f9ffe8dea7af Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 21 Sep 2023 23:54:31 -0700
Subject: [PATCH 2/3] [5.6] Fix date-stamp invisibility in erc-fill-wrap
* etc/ERC-NEWS: Mention that `erc-timestamp-format-left' now
officially requires a trailing newline to work correctly.
* lisp/erc/erc-fill.el (erc-fill--wrap-measure): New helper function,
factored out from common code shared by `erc-fill-wrap' and
`erc-fill--wrap-stamp-insert-prefixed-date'.
(erc-fill--wrap-stamp-insert-prefixed-date): Refactor for more general
use and decrement `invisible' bounds, when applicable.
(erc-fill-wrap): Use helper `erc-fill--wrap-measure'.
* lisp/erc/erc-stamp.el (erc-stamp--custom-trailing-newline-p,
erc-stamp--custom-validate-date-stamp): New Custom type validation
functions to avoid difficult-to-read closures appearing in `setopt'
warnings.
(erc-timestamp-format-left): Mention that value should contain a
trailing newline, and drop `nil' from Custom :type spec because
users who don't want date stamps should use
`erc-timestamp-format-right' instead.
(erc-stamp--inherited-props): Add doc string.
(erc-stamp--decrement-date-invisibility-bounds): New function
to implement expected `invisible' interval adjustments needed by
the flag `erc-legacy-invisible-bounds-p' when nil.
(erc-stamp--checked-date-string-p): New internal flag variable to
track whether users whose `erc-timestamp-format-left' value lacks a
trailing newline have been warned in the current session.
(erc-insert-timestamp-left-and-right): Mention intervals of relevant
text props in doc string. Add text property `erc-stamp-type' to
inserted date stamps to help folks distinguish between them and other
left-sided stamps. Shadow `erc-stamp--invisible-property' when
calling `erc-format-timestamp' in order to prevent date stamps from
inheriting other `invisible' props. These stamps are special in that
they have no business being hidden along with the current message.
Also, appeal to `erc-stamp--decrement-date-invisibility-bounds' in
offset the invisibility interval when `erc-legacy-invisible-bounds-p'
is nil.
* lisp/erc/erc.el (erc-insert-modify-hook): Mention reserved depth
ranges for built-in members in doc string.
(erc--remove-from-prop-value-list): New function for removing
`invisible' and `face' prop members cleanly.
(erc--hide-message): Don't bother offsetting start of first message in
a buffer.
(erc--own-property-names): Add `erc-stamp-type'.
(erc--persistent-message-properties): New variable.
(erc-restore-text-properties): Extend role to cover persistent as well
as ephemeral props that only exist during message insertion for the
benefit of hooks.
(erc--get-eq-comparable-cmd): Use `if-let' instead of `if-let*'.
* test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp):
Ensure `erc-stamp' is loaded.
* test/lisp/erc/erc-scenarios-match.el
(erc-scenarios-match--stamp-right-fools-invisible): Remove misplaced
ERT tag from function.
(erc-scenarios-match--fill-wrap-stamp-dedented-p): New assertion
utility function.
(erc-scenarios-match--stamp-both-invisible-fill-wrap) New test.
(erc-scenarios-match--stamp-both-invisible-fill-static): Expect
`erc-command' at beginning of inserted message's filled line, even if
it starts with whitespace. This is a consequence of the change above
to `erc-restore-text-properties'. Also, add new function parameter
`assert-ds', a callback to run when visiting the second date stamp,
which is followed by a hidden message. In the test of the same name,
expect the date stamp's invisibility interval to begin at the newline
after the previous message and to not contain any existing
invisibility props, namely, those belonging to the subsequent hidden
"fools" message.
(erc-scenarios-match--stamp-both-invisible-fill-static--nooffset):
Expect the date stamp's invisibility interval to match its field's
instead of starting and ending sooner.
* test/lisp/erc/erc-tests.el (erc--remove-from-prop-value-list,
erc--remove-from-prop-value-list/many): New tests. (Bug#60936)
---
etc/ERC-NEWS | 12 +-
lisp/erc/erc-fill.el | 45 +++----
lisp/erc/erc-stamp.el | 117 ++++++++++++++++---
lisp/erc/erc.el | 61 ++++++++--
test/lisp/erc/erc-scenarios-log.el | 1 +
test/lisp/erc/erc-scenarios-match.el | 163 ++++++++++++++++++++++++--
test/lisp/erc/erc-tests.el | 169 +++++++++++++++++++++++++++
7 files changed, 507 insertions(+), 61 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 05e933930e2..6743e49cfec 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -149,13 +149,17 @@ minor-mode maps, and new third-party modules should do the same.
** Option 'erc-timestamp-format-right' deprecated.
Having to account for this option prevented other ERC modules from
-easily determining what right-hand stamps would look like before
+easily determining what right-sided stamps would look like before
insertion, which is knowledge needed for certain UI decisions. The
way ERC has chosen to address this is imperfect and boils down to
asking users who've customized this option to switch to
-'erc-timestamp-format' instead. If you're affected by this and feel
-that some other solution, like automatic migration, is justified,
-please make that known on the bug list.
+'erc-timestamp-format' instead. Somewhat relatedly, the companion
+option 'erc-timestamp-format-left', which determines the look of date
+stamps, must now end in a newline. Although this has long been the
+case in practice, it's now been made official. As always, if you're
+affected by these changes and feel that other solutions, like
+automatic migration, are justified, please make that known on the bug
+list.
** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
It's no secret that the 'buttons' module treats potential nicknames
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index f4835f71278..d323682476d 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -484,25 +484,34 @@ erc-fill--wrap-continued-message-p
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
-(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
- "Apply `line-prefix' property to args."
- (let* ((ts-left (car args))
- (start)
+(defun erc-fill--wrap-measure (beg end)
+ "Return display spec width for inserted region between BEG and END.
+Ignore any `invisible' props that may be present when figuring."
+ (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
+ ;; `buffer-text-pixel-size' can move point!
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (let (buffer-invisibility-spec)
+ (list (car (buffer-text-pixel-size))))))
+ (- end beg)))
+
+(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest _)
+ "Apply `line-prefix' property to args.
+Expect a multiline \"date\" stamp ending in a newline, similar to
+the default value of `erc-timestamp-format-left'. Omit the
+`line-prefix' from any trailing newlines."
+ (let* ((beg)
;; Insert " " to simulate gap between <speaker> and msg beg.
(end (save-excursion (skip-chars-backward "\n")
- (setq start (pos-bol))
+ (setq beg (pos-bol))
(insert " ")
(point)))
- (width (if (and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction (narrow-to-region start end)
- (list (car (buffer-text-pixel-size))))
- (length (string-trim-left ts-left)))))
+ (width (erc-fill--wrap-measure beg end)))
(delete-region (1- end) end)
- ;; Use `point-min' instead of `start' to cover leading newilnes.
- (put-text-property (point-min) (point) 'line-prefix
- `(space :width (- erc-fill--wrap-value ,width))))
- args)
+ ;; Use `point-min' instead of `beg' to cover leading newilnes.
+ (put-text-property (point-min) (1- end) 'line-prefix
+ `(space :width (- erc-fill--wrap-value ,width)))))
;; An escape hatch for third-party code expecting speakers of ACTION
;; messages to be exempt from `line-prefix'. This could be converted
@@ -536,12 +545,8 @@ erc-fill-wrap
(put-text-property (point-min) (point)
'display "")
0)
- ((and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (list (car (buffer-text-pixel-size)))))
- (t (- (point) (point-min))))))))
+ (t
+ (erc-fill--wrap-measure (point-min) (point))))))))
(erc-put-text-properties (point-min) (1- (point-max)) ; exclude "\n"
'(line-prefix wrap-prefix) nil
`((space :width (- erc-fill--wrap-value ,len))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0f3163bf68d..68dd1f287cf 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,21 +55,35 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
-;; FIXME remove surrounding whitespace from default value and have
-;; `erc-insert-timestamp-left-and-right' add it before insertion.
+(defun erc-stamp--custom-trailing-newline-p (_ value)
+ "Return non-nil if VALUE ends in a newline."
+ (string-suffix-p "\n" value))
-(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
- "If set to a string, messages will be timestamped.
-This string is processed using `format-time-string'.
-Good examples are \"%T\" and \"%H:%M\".
-
-This timestamp is used for timestamps on the left side of the
-screen when `erc-insert-timestamp-function' is set to
-`erc-insert-timestamp-left-and-right'.
+(defun erc-stamp--custom-validate-date-stamp (widget)
+ "Fail unless WIDGET's value ends in a newline."
+ (unless (string-suffix-p "\n" (widget-value widget))
+ (widget-put widget :error "Value lacks a trailing newline")
+ widget))
-If nil, timestamping is turned off."
- :type '(choice (const nil)
- (string)))
+(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
+ "Format recognized by `format-time-string' for date stamps.
+Only considered when `erc-insert-timestamp-function' is set to
+`erc-insert-timestamp-left-and-right'. Used for displaying date
+stamps on their own line, between messages. As of ERC 5.6, this
+module appends a trailing newline on insertion if needed. Any
+extra newlines, leading or trailing, become empty lines. For
+example, the default value results in an empty line after the
+previous message, followed by the timestamp on its own line,
+followed immediately by the next message on the next line. ERC
+expects to display these stamps less frequently, so the
+formatting specifiers should reflect that. To omit these stamps
+entirely, use a different `erc-insert-timestamp-function', such
+as `erc-timestamp-format-right'."
+ :type '(string :validate erc-stamp--custom-validate-date-stamp
+ :match erc-stamp--custom-trailing-newline-p)
+ :set (lambda (sym val)
+ (set-default sym
+ (if (string-suffix-p "\n" val) val (concat val "\n")))))
(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
@@ -374,7 +388,15 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+;; These are currently extended manually, but we could also bind
+;; `text-property-default-nonsticky' and call `insert-and-inherit'
+;; instead of `insert', but we'd have to pair the props with differing
+;; boolean values for left and right stamps. Also, since this hook
+;; runs last, we can't expect overriding sticky props to be absent,
+;; even though, as of 5.6, `front-sticky' is only added by the
+;; `readonly' module after hooks run.
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
+ "Extant properties at the start of a message inherited by the stamp.")
(declare-function erc--remove-text-properties "erc" (string))
@@ -604,14 +626,69 @@ erc-stamp--insert-date-function
A local module might use this to modify text properties,
`insert-before-markers' or renarrow the region after insertion.")
+(defun erc-stamp--decrement-date-invisibility-bounds ()
+ "Extend `invisible' prop to previous newline before date stamp.
+And apply original prop value from message body to any trailing
+newlines after date."
+ (let ((beg (point-min)))
+ (save-restriction
+ (widen)
+ (when (and (> beg 4) (= (char-before beg) ?\n))
+ (when-let ((this (get-text-property (point) 'invisible))
+ (prev (get-text-property (1- beg) 'invisible))
+ ((not (equal this prev))))
+ (put-text-property (1- beg) beg 'invisible
+ (seq-difference (ensure-list prev)
+ (ensure-list this))))
+ (put-text-property (1- beg) beg 'invisible 'timestamp)))
+ (cl-assert (= ?\n (char-before (point))))
+ ;; Only decrement bounds by one. Additional newlines in the
+ ;; timestamp must be hidden.
+ (if-let ((existing (remq 'timestamp
+ (ensure-list erc-stamp--invisible-property))))
+ (put-text-property (1- (point)) (point) 'invisible
+ (if (cdr existing) existing (car existing)))
+ (erc--remove-from-prop-value-list
+ (1- (point)) (point) 'invisible 'timestamp))))
+
+(defvar-local erc-stamp--checked-date-string-p nil
+ "Non-nil if date string has been validated for current buffer.")
+
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
When the deprecated option `erc-timestamp-format-right' is nil,
use STRING, which originates from `erc-timestamp-format', for the
right-hand stamp. Use `erc-timestamp-format-left' for the
-left-hand stamp and expect it to change less frequently."
+left-hand stamp and expect it to change less frequently. Include
+line endings found in `erc-timestamp-format-left' (or affixed by
+ERC) as part of the `erc-timestamp' field, which extends to the
+start of the message proper. Do this so other code knows the
+stamp is part of the subsequent IRC message even though it may
+appear on its own line. However, allow the stamp's `invisible'
+property to span a different interval, in order to satisfy newer
+folding requirements related to `erc-legacy-invisible-bounds-p'.
+Additionally, ensure every date stamp formatted with the option
+`erc-timestamp-format-left' has the property `erc-stamp-type' set
+to the symbol `date-left' so that modules can easily distinguish
+between other left-sided stamps and date stamps inserted by this
+function."
+ (unless erc-stamp--checked-date-string-p
+ (setq erc-stamp--checked-date-string-p t)
+ (unless (string-suffix-p "\n" erc-timestamp-format-left)
+ (setq erc-timestamp-format-left
+ (concat erc-timestamp-format-left "\n"))
+ (unless erc--target
+ (erc-button--display-error-notice-with-keys
+ (current-buffer)
+ "ERC only supports values of `%s' that end in a ?\\n."
+ " Changing value for current session to: %s."
+ " Update your config accordingly to silence this message."
+ 'erc-timestamp-format-left
+ (let ((print-escape-newlines t))
+ (prin1-to-string erc-timestamp-format-left))))))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-left (let ((erc-stamp--invisible-property 'timestamp))
+ (erc-format-timestamp ct erc-timestamp-format-left)))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
@@ -620,8 +697,14 @@ erc-insert-timestamp-left-and-right
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
- (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
+ (add-text-properties 0 (length ts-left)
+ '(field erc-timestamp erc-stamp-type date-left)
+ ts-left)
(funcall erc-stamp--insert-date-function ts-left)
+ (unless (with-suppressed-warnings
+ ((obsolete erc-legacy-invisible-bounds-p))
+ erc-legacy-invisible-bounds-p)
+ (erc-stamp--decrement-date-invisibility-bounds))
(setq erc-timestamp-last-inserted-left ts-left))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ec4fae548c7..db2e20c800e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1128,9 +1128,13 @@ erc-insert-modify-hook
"Insertion hook for functions that will change the text's appearance.
This hook is called just after `erc-insert-pre-hook' when the value
of `erc-insert-this' is t.
-While this hook is run, narrowing is in effect and `current-buffer' is
-the buffer where the text got inserted. One possible value to add here
-is `erc-fill'."
+
+ERC runs this hook with the buffer narrowed to the bounds of the
+inserted message plus a trailing newline. Built-in modules place
+their hook members at depths between 20 and 80, with those from
+the stamp module always running last. Use the functions
+`erc-find-parsed-property' and `erc-get-parsed-vector' to locate
+and extract the `erc-response' object for the inserted message."
:group 'erc-hooks
:type 'hook)
@@ -3037,6 +3041,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
@@ -3046,7 +3074,11 @@ erc-legacy-invisible-bounds-p
(defun erc--hide-message (value)
"Apply `invisible' text-property with VALUE to current message.
-Expect to run in a narrowed buffer during message insertion."
+Expect to run in a narrowed buffer during message insertion.
+Begin the invisible interval at the previous message's trailing
+newline and end before the current message's. If the preceding
+message ends in a double newline or there is no previous message,
+don't bother including the preceding newline."
(if erc-legacy-invisible-bounds-p
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
@@ -3055,6 +3087,8 @@ erc--hide-message
(end (point-max)))
(save-restriction
(widen)
+ (when (or (<= beg 4) (= ?\n (char-before (- beg 2))))
+ (cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
(defun erc-display-message-highlight (type string)
@@ -4770,6 +4804,7 @@ erc--own-property-names
rear-nonsticky erc-prompt field front-sticky read-only
;; stamp
cursor-intangible cursor-sensor-functions isearch-open-invisible
+ erc-stamp-type
;; match
invisible intangible
;; button
@@ -8071,13 +8106,21 @@ erc-find-parsed-property
"Find the next occurrence of the `erc-parsed' text property."
(text-property-not-all (point-min) (point-max) 'erc-parsed nil))
+(defvar erc--persistent-message-properties '(erc-command))
+
(defun erc-restore-text-properties ()
- "Restore the property `erc-parsed' for the region."
- (when-let* ((parsed-posn (erc-find-parsed-property))
- (found (erc-get-parsed-vector parsed-posn)))
+ "Ensure the `erc-parsed' property covers the narrowed buffer.
+Do this for other properties added by `erc-display-message' and
+for those named in `erc--persistent-message-properties'."
+ (when-let ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
(put-text-property (point-min) (point-max) 'erc-parsed found)
(when-let ((tags (get-text-property parsed-posn 'tags)))
- (put-text-property (point-min) (point-max) 'tags tags))))
+ (put-text-property (point-min) (point-max) 'tags tags))
+ (let ((to (max (point-min) (1- (point-max)))))
+ (dolist (prop erc--persistent-message-properties)
+ (when-let ((val (get-text-property parsed-posn prop)))
+ (put-text-property (point-min) to prop val))))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -8102,7 +8145,7 @@ erc--get-eq-comparable-cmd
See also `erc-message-type'."
;; IRC numerics are three-digit numbers, possibly with leading 0s.
;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
- (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+ (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n))
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index fd030d90c2f..f7e7d61c92e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -81,6 +81,7 @@ erc-scenarios-log--kill-hook
(ert-deftest erc-scenarios-log--clear-stamp ()
:tags '(:expensive-test)
+ (require 'erc-stamp)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index cd899fddb98..bc06d58c3e9 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -167,7 +167,6 @@ erc-scenarios-match--find-eol
;; In most cases, `erc-hide-fools' makes line endings invisible.
(defun erc-scenarios-match--stamp-right-fools-invisible ()
- :tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
(erc-scenarios-match--invisible-stamp
@@ -271,7 +270,123 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap
(let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
-(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
+(defun erc-scenarios-match--fill-wrap-stamp-dedented-p (point)
+ (pcase (get-text-property point 'line-prefix)
+ (`(space :width (- erc-fill--wrap-value (,n)))
+ (if (display-graphic-p) (< 100 n 200) (< 10 n 30)))
+ (`(space :width (- erc-fill--wrap-value ,n))
+ (< 10 n 30))))
+
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-wrap ()
+
+ ;; Rewind the clock to known date artificially.
+ (let ((erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-fill-function #'erc-fill-wrap)
+ (bob-utterance-counter 0))
+
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (ert-info ("Baseline check")
+ ;; False date printed initially before anyone speaks.
+ (when (zerop bob-utterance-counter)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "[Wed Apr 29 1992]")
+ ;; First stamp in a buffer is not invisible from previous
+ ;; newline (before stamp's own leading newline).
+ (should (= 4 (match-beginning 0)))
+ (should (get-text-property 3 'invisible))
+ (should-not (get-text-property 2 'invisible))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p 4))
+ (search-forward "[23:59]"))))
+
+ (ert-info ("Line endings in Bob's messages are invisible")
+ ;; The message proper has the `invisible' property `match-fools'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
+ (let* ((mbeg (or (and (get-text-property (pos-bol) 'erc-command)
+ (pos-bol))
+ (next-single-property-change (pos-bol)
+ 'erc-command)))
+ (mend (text-property-not-all
+ mbeg (point-max) 'erc-command
+ (get-text-property mbeg 'erc-command))))
+
+ (if (/= 1 bob-utterance-counter)
+ (should-not (field-at-pos mend))
+ ;; For Bob's stamped message, check newline after stamp.
+ (should (eq (field-at-pos mend) 'erc-timestamp))
+ (setq mend (field-end mend)))
+
+ ;; The `erc-timestamp' property spans entire messages,
+ ;; including stamps and filled text, which makes for
+ ;; convenient traversal when `erc-stamp-mode' is enabled.
+ (should (get-text-property (pos-bol) 'erc-timestamp))
+ (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
+ mend))
+
+ ;; Line ending has the `invisible' property `match-fools'.
+ (should (= (char-after mend) ?\n))
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))
+
+ ;; Only the message right after Alice speaks contains stamps.
+ (when (= 1 bob-utterance-counter)
+
+ (ert-info ("Date stamp occupying previous line is invisible")
+ (should (eq 'match-fools (get-text-property (point) 'invisible)))
+ (save-excursion
+ (forward-line -1)
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[Mon May 4 1992]")))
+ (ert-info ("Stamp's NL `invisible' as fool, not timestamp")
+ (let ((end (match-end 0)))
+ (should (eq (char-after end) ?\n))
+ (should (eq 'timestamp
+ (get-text-property (1- end) 'invisible)))
+ (should (eq 'match-fools
+ (get-text-property end 'invisible)))))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point)))
+ ;; Date stamp has a combined `invisible' property value
+ ;; that starts at the previous message's trailing newline
+ ;; and extends until the start of the message proper.
+ (should (equal ?\n (char-before (point))))
+ (should (equal ?\n (char-before (1- (point)))))
+ (let ((val (get-text-property (- (point) 2) 'invisible)))
+ (should (equal val 'timestamp))
+ (should (= (text-property-not-all (- (point) 2) (point-max)
+ 'invisible val)
+ (pos-eol))))))
+
+ (ert-info ("Current message's RHS stamp is hidden")
+ ;; Right stamp has `match-fools' property.
+ (save-excursion
+ (should-not (field-at-pos (point)))
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
+
+ ;; Stamp invisibility starts where message's ends.
+ (let ((msgend (next-single-property-change (pos-bol) 'invisible)))
+ ;; Stamp has a combined `invisible' property value.
+ (should (equal (get-text-property msgend 'invisible)
+ '(timestamp match-fools)))
+
+ ;; Combined `invisible' property spans entire timestamp.
+ (should (= (next-single-property-change msgend 'invisible)
+ (pos-eol))))))
+
+ (cl-incf bob-utterance-counter))
+
+ ;; Alice.
+ (lambda ()
+ ;; Set clock ahead a week or so.
+ (setq erc-stamp--current-time 704962800)
+
+ ;; This message has no time stamp and is completely visible.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (should-not (next-single-property-change (pos-bol) 'invisible))))))
+
+(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds)
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
@@ -295,7 +410,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `match-fools'.
(should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
+ (let* ((mbeg (and (get-text-property (pos-bol) 'erc-command)
+ (pos-bol)))
(mend (next-single-property-change mbeg 'erc-command)))
(if (/= 1 bob-utterance-counter)
@@ -327,12 +443,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
- ;; Date stamp has a combined `invisible' property value
- ;; that extends until the start of the message proper.
- (should (equal (get-text-property (point) 'invisible)
- '(timestamp match-fools)))
- (should (= (next-single-property-change (point) 'invisible)
- (1+ (pos-eol))))))
+ (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n
+ (funcall assert-ds))) ; "assert date stamp"
(ert-info ("Folding preserved despite invisibility")
;; Message has a trailing time stamp, but it's been folded
@@ -365,13 +477,42 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
:tags '(:expensive-test)
- (erc-scenarios-match--stamp-both-invisible-fill-static))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that starts from the
+ ;; newline delimiting the current and previous messages and
+ ;; extends until the stamp's final newline. It is not combined
+ ;; with the old value, `match-fools'.
+ (let ((delim-pos (- (point) 2)))
+ (should (equal 'timestamp (get-text-property delim-pos 'invisible)))
+ ;; Stamp-only invisibility ends before its last newline.
+ (should (= (text-property-not-all delim-pos (point-max)
+ 'invisible 'timestamp)
+ (match-end 0))))))) ; pos-eol
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
:tags '(:expensive-test)
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(should-not erc-legacy-invisible-bounds-p)
+
(let ((erc-legacy-invisible-bounds-p t))
- (erc-scenarios-match--stamp-both-invisible-fill-static))))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that covers its
+ ;; format string exactly. It is not combined with the old
+ ;; value, `match-fools'.
+ (let ((delim-prev (- (point) 2)))
+ (should-not (get-text-property delim-prev 'invisible))
+ (should (eq 'erc-timestamp (field-at-pos (point))))
+ (should (= (next-single-property-change delim-prev 'invisible)
+ (field-beginning (point))))
+ (should (equal 'timestamp
+ (get-text-property (1- (point)) 'invisible)))
+ ;; Stamp-only invisibility includes last newline.
+ (should (= (text-property-not-all (1- (point)) (point-max)
+ 'invisible 'timestamp)
+ (field-end (point))))))))))
;;; erc-scenarios-match.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 05d45b2d027..3fb96ae64d3 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1385,6 +1385,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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Add-command-to-refill-buffer-with-erc-fill-wrap-.patch --]
[-- Type: text/x-patch, Size: 3381 bytes --]
From d8870a3dede52045518dc24a53143295df899943 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 21 Sep 2023 06:54:27 -0700
Subject: [PATCH 3/3] [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.
(Bug#60936)
---
lisp/erc/erc-fill.el | 51 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 51 insertions(+)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index d323682476d..b419fb57bd4 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -552,6 +552,57 @@ 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)
+ "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."
+ (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))
+ (save-restriction
+ (narrow-to-region beg (1+ end))
+ (if-let (((eq 'erc-timestamp (field-at-pos beg)))
+ ((eq 'date-left (get-text-property beg 'erc-stamp-type))))
+ (progn
+ (goto-char (field-end beg))
+ (erc-fill--wrap-stamp-insert-prefixed-date))
+ (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))
+ (goto-char end))))
+
+(defun erc-fill-wrap-refill-buffer ()
+ "Recalculate all `fill-wrap' prefixes in the current buffer."
+ (interactive)
+ (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)
+ (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)))
--
2.41.0
next prev parent reply other threads:[~2023-09-27 13:59 UTC|newest]
Thread overview: 56+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
2023-01-18 15:01 ` J.P.
2023-01-25 14:11 ` J.P.
2023-01-27 14:31 ` J.P.
2023-01-31 15:28 ` J.P.
2023-02-01 14:27 ` J.P.
2023-02-07 15:23 ` J.P.
2023-02-19 15:05 ` J.P.
2023-02-20 15:31 ` J.P.
2023-03-09 14:42 ` J.P.
[not found] ` <87edpykmud.fsf@neverwas.me>
2023-04-10 20:49 ` J.P.
2023-05-09 20:46 ` J.P.
2023-05-22 4:20 ` J.P.
[not found] ` <87fs7p3sk6.fsf@neverwas.me>
2023-05-30 14:14 ` J.P.
2023-06-28 21:02 ` J.P.
[not found] ` <87jzvny7ez.fsf@neverwas.me>
2023-07-03 13:14 ` J.P.
2023-07-18 13:33 ` J.P.
[not found] ` <87msztl4xu.fsf@neverwas.me>
2023-07-18 13:55 ` J.P.
2023-07-19 13:15 ` J.P.
[not found] ` <87a5vsjb3q.fsf@neverwas.me>
2023-07-20 13:28 ` J.P.
[not found] ` <87351iiueu.fsf@neverwas.me>
2023-07-23 14:00 ` J.P.
[not found] ` <87h6pug23c.fsf@neverwas.me>
2023-07-28 23:59 ` J.P.
2023-08-09 14:53 ` J.P.
2023-08-09 16:50 ` Michael Albinus
[not found] ` <87jzu4upl9.fsf@gmx.de>
2023-08-15 14:01 ` J.P.
[not found] ` <87v8dgh0af.fsf@neverwas.me>
2023-08-15 16:12 ` Michael Albinus
[not found] ` <87sf8kuvxr.fsf@gmx.de>
2023-08-15 16:37 ` Michael Albinus
[not found] ` <87leecuuqu.fsf@gmx.de>
2023-08-16 14:28 ` J.P.
2023-08-16 17:38 ` Michael Albinus
2023-08-31 13:31 ` J.P.
[not found] ` <87il8vxrr1.fsf@neverwas.me>
2023-09-13 14:06 ` J.P.
2023-09-13 15:56 ` Stefan Kangas
[not found] ` <CADwFkmm3bfkXaOvDYXwKr+RsXird-X47rK=QW6M_cuD6YEm=zA@mail.gmail.com>
2023-09-13 23:11 ` J.P.
[not found] ` <87pm2lzn1i.fsf@neverwas.me>
2023-09-13 23:40 ` Stefan Kangas
2023-09-22 14:11 ` J.P.
[not found] ` <87a5te47sz.fsf@neverwas.me>
2023-09-27 13:59 ` J.P. [this message]
[not found] ` <87pm23yawb.fsf@neverwas.me>
2023-10-06 15:17 ` J.P.
[not found] ` <874jj3ok58.fsf@neverwas.me>
2023-10-14 0:24 ` J.P.
[not found] ` <87cyxi9hlc.fsf@neverwas.me>
2023-10-14 17:04 ` J.P.
[not found] ` <87h6mt87al.fsf@neverwas.me>
2023-10-16 14:07 ` J.P.
[not found] ` <8734yak6dr.fsf@neverwas.me>
2023-10-17 13:48 ` J.P.
2023-10-19 14:02 ` J.P.
[not found] ` <877cniaewr.fsf@neverwas.me>
2023-10-24 2:19 ` J.P.
[not found] ` <877cncg3ss.fsf@neverwas.me>
2023-10-24 14:29 ` J.P.
[not found] ` <87jzrcccw3.fsf@neverwas.me>
2023-10-24 17:10 ` Corwin Brust
2023-10-25 2:17 ` J.P.
[not found] ` <87lebra1io.fsf@neverwas.me>
2023-10-30 13:48 ` J.P.
[not found] ` <87bkcguspb.fsf@neverwas.me>
2023-11-01 0:28 ` J.P.
[not found] ` <874ji6tiyn.fsf@neverwas.me>
2023-11-06 2:30 ` J.P.
2024-04-09 18:19 ` J.P.
2023-11-13 21:01 ` J.P.
2023-12-07 7:14 ` J.P.
2024-02-15 12:01 ` tzakmagiel via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-21 1:12 ` J.P.
2024-04-09 20:48 ` bug#60936: (no subject) Alcor
2024-04-23 22:37 ` bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87pm23yawb.fsf__39845.6469339848$1695823286$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=60936@debbugs.gnu.org \
--cc=emacs-erc@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).