From 0c2b76532490d85a5b622e57af5aa1320278a20c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 21 Sep 2023 23:54:31 -0700 Subject: [PATCH 2/3] [5.6] Fix date-stamp invisibility in erc-fill-wrap * 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-insert-timestamp-left-and-right): Mention intervals of relevant text props in doc string. * lisp/erc/erc.el (erc--hide-message): Don't bother offsetting start of first message in a buffer. (erc--own-property-names): Add `erc-stamp-type'. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--fill-wrap-stamp-dedented-p): New function. (erc-scenarios-match--stamp-both-invisible-fill-wrap) New test. (Bug#60936) --- lisp/erc/erc-fill.el | 54 ++++++++----- lisp/erc/erc-stamp.el | 9 ++- lisp/erc/erc.el | 9 ++- test/lisp/erc/erc-scenarios-match.el | 112 ++++++++++++++++++++++++++- 4 files changed, 162 insertions(+), 22 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index f4835f71278..6d39bcb19b9 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -484,25 +484,45 @@ 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)) + (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." + (let* ((beg) ;; Insert " " to simulate gap between 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. + ;; 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 - `(space :width (- erc-fill--wrap-value ,width)))) - args) + `(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 +556,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..4e16906c550 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -609,7 +609,14 @@ erc-insert-timestamp-left-and-right 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 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'." (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) (ts-right (with-suppressed-warnings diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ec4fae548c7..e4b0cd0ddbe 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3046,7 +3046,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 +3059,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 +4776,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 diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index cd899fddb98..bf74806207d 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,6 +270,117 @@ 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--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)) + (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)))))) + + ;; Only the message right after Alice speaks contains stamps. + (when (= 1 bob-utterance-counter) + + (ert-info ("Date stamp occupying previous line is invisible") + (save-excursion + (forward-line -1) + (goto-char (pos-bol)) + (should (looking-at (rx "[Mon May 4 1992]"))) + (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 match-fools))) + (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 () (should (eq erc-insert-timestamp-function #'erc-insert-timestamp-left-and-right)) -- 2.41.0