Re: bug#69597: 29.2; ERC 5.6-git: Add a new customizable variable controlling how Erc displays spoilers

From acc9d0c4c1394a6e52bf34c59318888d91d249a6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Fri, 8 Mar 2024 17:45:54 -0800
Subject: [PATCH 0/3] *** NOT A PATCH ***

. Rename the test.

. Add `object' parameter to `erc--reserve-important-text-props'.

. Subject `erc--reserve-important-text-props' call site to the same guard
  condition as `add-text-properties', so messages that don't include spoilers
  aren't marked as having important props (thus allowing healing logic to
  ignore those messages instead of scan them unnecessarily).

F. Jason Park (2):
  [5.6] Fix misleading test in erc-goodies
  [5.6] Make important text props more resilient in ERC

F. Moukayed (1):
  [5.6] Redefine erc-spoilers-face to indicate revealed text

 lisp/erc/erc-button.el             |  3 +-
 lisp/erc/erc-goodies.el            | 21 +++++-----
 lisp/erc/erc.el                    | 34 ++++++++++++++++
 test/lisp/erc/erc-goodies-tests.el | 62 +++++++++++++++---------------
 test/lisp/erc/erc-tests.el         | 52 +++++++++++++++++++++++++
 5 files changed, 129 insertions(+), 43 deletions(-)

Interdiff:
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 611fdbedf7b..212cdbfa9ef 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -967,16 +967,13 @@ erc-controls-propertize
 If optional argument STR is provided, apply to STR, otherwise prepend properties
 to a region in the current buffer."
   (when (and fg bg (equal fg bg))
-    (add-text-properties from to '(mouse-face
-                                   erc-spoiler-face
-                                   cursor-face
-                                   erc-spoiler-face)
-                         str))
-  (erc--reserve-important-text-props from to
-                                     '(mouse-face
-                                       erc-spoiler-face
-                                       cursor-face
-                                       erc-spoiler-face))
+    (add-text-properties from to '( mouse-face erc-spoiler-face
+                                    cursor-face erc-spoiler-face)
+                         str)
+    (erc--reserve-important-text-props from to
+                                       '( mouse-face erc-spoiler-face
+                                          cursor-face erc-spoiler-face)
+                                       str))
   (when fg (setq fg (erc-get-fg-color-face fg)))
   (when bg (setq bg (erc-get-bg-color-face bg)))
   (font-lock-prepend-text-property
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 49b51c5d74c..08bc9939b9a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3532,37 +3532,39 @@ erc--remove-from-prop-value-list
             old (get-text-property pos prop object)
             end (next-single-property-change pos prop object to)))))
 
-(defun erc--reserve-important-text-props (beg end plist)
+(defun erc--reserve-important-text-props (beg end plist &optional object)
   "Record text-property pairs in PLIST as important between BEG and END.
 Also mark the message being inserted as containing these important props
 so modules performing destructive modifications can later restore them.
 Expect to run in a narrowed buffer at message-insertion time."
   (when erc--msg-props
     (let ((existing (erc--check-msg-prop 'erc--important-prop-names)))
-      (puthash 'erc--important-prop-names
-               (seq-union existing (cl-loop for (key _) on plist by #'cddr
-                                            collect key))
+      (puthash 'erc--important-prop-names (seq-union existing (map-keys plist))
                erc--msg-props)))
-  (erc--merge-prop beg end 'erc--important-props plist))
+  (erc--merge-prop beg end 'erc--important-props plist object))
 
-;; FIXME use a region instead of point-min/max.
-(defun erc--restore-important-text-props (props)
+(defun erc--restore-important-text-props (props &optional beg end)
   "Restore PROPS where recorded in the accessible portion of the buffer.
-Expect to run in a narrowed buffer at message-insertion time."
+Expect to run in a narrowed buffer at message-insertion time.  Limit the
+effect to the region between buffer positions BEG and END, when non-nil.
+
+Callers should be aware that this function fails if the property
+`erc--important-props' has an empty value almost anywhere along the
+affected region.  Use the function `erc--remove-from-prop-value-list' to
+ensure that props with empty values are excised completely."
   (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names))
              (present (seq-intersection props registered))
-             (p (point-min))
-             (end (point-max)))
-    (while-let (((setq p (text-property-not-all p end
-                                                'erc--important-props nil)))
-                (val (get-text-property p 'erc--important-props))
-                (q (next-single-property-change p 'erc--important-props
-                                                nil end)))
+             (b (or beg (point-min)))
+             (e (or end (point-max))))
+    (while-let
+        (((setq b (text-property-not-all b e 'erc--important-props nil)))
+         (val (get-text-property b 'erc--important-props))
+         (q (next-single-property-change b 'erc--important-props nil e)))
       (while-let ((k (pop val))
                   (v (pop val)))
         (when (memq k present)
-          (put-text-property p q k v)))
-      (setq p q))))
+          (put-text-property b q k v)))
+      (setq b q))))
 
 (defvar erc-legacy-invisible-bounds-p nil
   "Whether to hide trailing rather than preceding newlines.
diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el
index ddc29acff1e..0ab40808a4a 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -129,7 +129,7 @@ erc-controls-highlight--examples
 ;; Hovering over the redacted area should reveal its underlying text
 ;; in a high-contrast face.
 
-(ert-deftest erc-controls-highlight--inverse ()
+(ert-deftest erc-controls-highlight--spoilers ()
   (should (eq t erc-interpret-controls-p))
   (erc-tests-common-make-server-buf)
   (with-current-buffer (erc--open-target "#chan")
-- 
2.44.0

From 5ceebcb6718c8140ea58f659a3b295a12d9e9a4f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Thu, 7 Mar 2024 21:53:11 -0800
Subject: [PATCH 1/3] [5.6] Fix misleading test in erc-goodies

* test/lisp/erc/erc-goodies-tests.el
(erc-controls-highlight--inverse, erc-controls-highlight--spoilers):
Rename former to latter, and don't shadow `erc-insert-modify-hook'
with an unrealistic subset of members, in this case a lone member:
`erc-controls-highlight'.  Adjust expected buffer state to reflect new
role of `erc-spoiler-face'.  (Bug#69597)
---
 test/lisp/erc/erc-goodies-tests.el | 62 +++++++++++++++---------------
 1 file changed, 30 insertions(+), 32 deletions(-)

diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el
index 7013ce0c8fc..0ab40808a4a 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -129,39 +129,37 @@ erc-controls-highlight--examples
 ;; Hovering over the redacted area should reveal its underlying text
 ;; in a high-contrast face.
 
-(ert-deftest erc-controls-highlight--inverse ()
+(ert-deftest erc-controls-highlight--spoilers ()
   (should (eq t erc-interpret-controls-p))
-  (let ((erc-insert-modify-hook '(erc-controls-highlight))
-        erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-    (with-current-buffer (get-buffer-create "#chan")
-      (erc-mode)
-      (setq-local erc-interpret-mirc-color t)
-      (erc--initialize-markers (point) nil)
-
-      (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!")
-             (msg (erc-format-privmessage "bob" m nil t)))
-        (erc-display-message nil nil (current-buffer) msg))
-      (forward-line -1)
-      (should (search-forward "<bob> " nil t))
-      (save-restriction
-        (narrow-to-region (point) (pos-eol))
-        (should (eq (get-text-property (+ 9 (point)) 'mouse-face)
-                    'erc-inverse-face))
-        (should (eq (get-text-property (1- (pos-eol)) 'mouse-face)
-                    'erc-inverse-face))
-        (erc-goodies-tests--assert-face
-         0 "Spoiler: " 'erc-default-face
-         '(fg:erc-color-face0 bg:erc-color-face0))
-        (erc-goodies-tests--assert-face
-         9 "Hello" '(erc-spoiler-face)
-         '( fg:erc-color-face0 bg:erc-color-face0
-            fg:erc-color-face1 bg:erc-color-face1))
-        (erc-goodies-tests--assert-face
-         18 " World" '(erc-spoiler-face)
-         '( fg:erc-color-face0 bg:erc-color-face0
-            fg:erc-color-face1 bg:erc-color-face1 )))
-      (when noninteractive
-        (kill-buffer)))))
+  (erc-tests-common-make-server-buf)
+  (with-current-buffer (erc--open-target "#chan")
+    (setq-local erc-interpret-mirc-color t)
+    (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!")
+           (msg (erc-format-privmessage "bob" m nil t)))
+      (erc-display-message nil nil (current-buffer) msg))
+    (forward-line -1)
+    (should (search-forward "<bob> " nil t))
+    (save-restriction
+      ;; Narrow to EOL or start of right-side stamp.
+      (narrow-to-region (point) (line-end-position))
+      (should (eq (get-text-property (+ 9 (point)) 'mouse-face)
+                  'erc-spoiler-face))
+      (should (eq (get-text-property (1- (pos-eol)) 'mouse-face)
+                  'erc-spoiler-face))
+      ;; "Spoiler" appears in ERC default face.
+      (erc-goodies-tests--assert-face
+       0 "Spoiler: " 'erc-default-face
+       '(fg:erc-color-face0 bg:erc-color-face0))
+      ;; "Hello" is masked in all white.
+      (erc-goodies-tests--assert-face
+       9 "Hello" '(fg:erc-color-face0 bg:erc-color-face0)
+       '(fg:erc-color-face1 bg:erc-color-face1))
+      ;; "World" is masked in all black.
+      (erc-goodies-tests--assert-face
+       18 " World" '(fg:erc-color-face1 bg:erc-color-face1 )
+       '(fg:erc-color-face0 bg:erc-color-face0))))
+  (when noninteractive
+    (erc-tests-common-kill-buffers)))
 
 (defvar erc-goodies-tests--motd
   ;; This is from ergo's MOTD
-- 
2.44.0

From 9b5f8e0a85866ae9245a2b480183f6a36d23a413 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Thu, 7 Mar 2024 21:53:23 -0800
Subject: [PATCH 2/3] [5.6] Make important text props more resilient in ERC

* lisp/erc/erc-button.el (erc-button-remove-old-buttons): Restore
original `mouse-face' values in areas marked as important after
clobbering.
* lisp/erc/erc.el (erc--reserve-important-text-props): New function.
(erc--restore-important-text-props): New function.
* test/lisp/erc/erc-tests.el
(erc--restore-important-text-props): New test.
(Bug#69597)
---
 lisp/erc/erc-button.el     |  3 ++-
 lisp/erc/erc.el            | 34 +++++++++++++++++++++++++
 test/lisp/erc/erc-tests.el | 52 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 88 insertions(+), 1 deletion(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 6b78e451b54..4b4930e5bff 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -528,7 +528,8 @@ erc-button-remove-old-buttons
    '(erc-callback nil
                   erc-data nil
                   mouse-face nil
-                  keymap nil)))
+                  keymap nil))
+  (erc--restore-important-text-props '(mouse-face)))
 
 (defun erc-button-add-button (from to fun nick-p &optional data regexp)
   "Create a button between FROM and TO with callback FUN and data DATA.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index cce3b2508fb..08bc9939b9a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3532,6 +3532,40 @@ erc--remove-from-prop-value-list
             old (get-text-property pos prop object)
             end (next-single-property-change pos prop object to)))))
 
+(defun erc--reserve-important-text-props (beg end plist &optional object)
+  "Record text-property pairs in PLIST as important between BEG and END.
+Also mark the message being inserted as containing these important props
+so modules performing destructive modifications can later restore them.
+Expect to run in a narrowed buffer at message-insertion time."
+  (when erc--msg-props
+    (let ((existing (erc--check-msg-prop 'erc--important-prop-names)))
+      (puthash 'erc--important-prop-names (seq-union existing (map-keys plist))
+               erc--msg-props)))
+  (erc--merge-prop beg end 'erc--important-props plist object))
+
+(defun erc--restore-important-text-props (props &optional beg end)
+  "Restore PROPS where recorded in the accessible portion of the buffer.
+Expect to run in a narrowed buffer at message-insertion time.  Limit the
+effect to the region between buffer positions BEG and END, when non-nil.
+
+Callers should be aware that this function fails if the property
+`erc--important-props' has an empty value almost anywhere along the
+affected region.  Use the function `erc--remove-from-prop-value-list' to
+ensure that props with empty values are excised completely."
+  (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names))
+             (present (seq-intersection props registered))
+             (b (or beg (point-min)))
+             (e (or end (point-max))))
+    (while-let
+        (((setq b (text-property-not-all b e 'erc--important-props nil)))
+         (val (get-text-property b 'erc--important-props))
+         (q (next-single-property-change b 'erc--important-props nil e)))
+      (while-let ((k (pop val))
+                  (v (pop val)))
+        (when (memq k present)
+          (put-text-property b q k v)))
+      (setq b q))))
+
 (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 085b063bdb2..6809d9db41d 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -2232,6 +2232,58 @@ erc--remove-from-prop-value-list/many
     (when noninteractive
       (kill-buffer))))
 
+(ert-deftest erc--restore-important-text-props ()
+  (erc-mode)
+  (let ((erc--msg-props (map-into '((erc--important-prop-names a))
+                                  'hash-table)))
+    (insert (propertize "foo" 'a 'A 'b 'B 'erc--important-props '(a A))
+            " "
+            (propertize "bar" 'c 'C 'a 'A 'b 'B
+                        'erc--important-props '(a A c C)))
+
+    ;; Attempt to restore a and c when only a is registered.
+    (remove-list-of-text-properties (point-min) (point-max) '(a c))
+    (erc--restore-important-text-props '(a c))
+    (should (erc-tests-common-equal-with-props
+             (buffer-string)
+             #("foo bar"
+               0 3 (a A b B erc--important-props (a A))
+               4 7 (a A b B erc--important-props (a A c C)))))
+
+    ;; Add d between 3 and 6.
+    (erc--reserve-important-text-props 3 6 '(d D))
+    (put-text-property 3 6 'd 'D)
+    (should (erc-tests-common-equal-with-props
+             (buffer-string)
+             #("foo bar" ; #1
+               0 2 (a A b B erc--important-props (a A))
+               2 3 (d D a A b B erc--important-props (d D a A))
+               3 4 (d D erc--important-props (d D))
+               4 5 (d D a A b B erc--important-props (d D a A c C))
+               5 7 (a A b B erc--important-props (a A c C)))))
+    ;; Remove a and d, and attempt to restore d.
+    (remove-list-of-text-properties (point-min) (point-max) '(a d))
+    (erc--restore-important-text-props '(d))
+    (should (erc-tests-common-equal-with-props
+             (buffer-string)
+             #("foo bar"
+               0 2 (b B erc--important-props (a A))
+               2 3 (d D b B erc--important-props (d D a A))
+               3 4 (d D erc--important-props (d D))
+               4 5 (d D b B erc--important-props (d D a A c C))
+               5 7 (b B erc--important-props (a A c C)))))
+
+    ;; Restore a only.
+    (erc--restore-important-text-props '(a))
+    (should (erc-tests-common-equal-with-props
+             (buffer-string)
+             #("foo bar" ; same as #1 above
+               0 2 (a A b B erc--important-props (a A))
+               2 3 (d D a A b B erc--important-props (d D a A))
+               3 4 (d D erc--important-props (d D))
+               4 5 (d D a A b B erc--important-props (d D a A c C))
+               5 7 (a A b B erc--important-props (a A c C)))))))
+
 (ert-deftest erc--split-string-shell-cmd ()
 
   ;; Leading and trailing space
-- 
2.44.0

From acc9d0c4c1394a6e52bf34c59318888d91d249a6 Mon Sep 17 00:00:00 2001
From: "F. Moukayed" <[email protected]>
Date: Fri, 8 Mar 2024 08:39:03 +0000
Subject: [PATCH 3/3] [5.6] Redefine erc-spoilers-face to indicate revealed
 text

* lisp/erc/erc-goodies.el (erc-spoilers-face): Redefine role and
rework definition to inherit from `erc-inverse-face'.
(Bug#69597)

Copyright-paperwork-exempt: yes
---
 lisp/erc/erc-goodies.el | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 7e30b1060fd..212cdbfa9ef 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -665,9 +665,7 @@ erc-inverse-face
   "ERC inverse face."
   :group 'erc-faces)
 
-(defface erc-spoiler-face
-  '((((background light)) :foreground "DimGray" :background "DimGray")
-    (((background dark)) :foreground "LightGray" :background "LightGray"))
+(defface erc-spoiler-face '((t :inherit erc-inverse-face))
   "ERC spoiler face."
   :group 'erc-faces)
 
@@ -968,13 +966,16 @@ erc-controls-propertize
   "Prepend properties from IRC control characters between FROM and TO.
 If optional argument STR is provided, apply to STR, otherwise prepend properties
 to a region in the current buffer."
-  (if (and fg bg (equal fg bg))
-      (progn
-        (setq fg 'erc-spoiler-face
-              bg nil)
-        (put-text-property from to 'mouse-face 'erc-inverse-face str))
-    (when fg (setq fg (erc-get-fg-color-face fg)))
-    (when bg (setq bg (erc-get-bg-color-face bg))))
+  (when (and fg bg (equal fg bg))
+    (add-text-properties from to '( mouse-face erc-spoiler-face
+                                    cursor-face erc-spoiler-face)
+                         str)
+    (erc--reserve-important-text-props from to
+                                       '( mouse-face erc-spoiler-face
+                                          cursor-face erc-spoiler-face)
+                                       str))
+  (when fg (setq fg (erc-get-fg-color-face fg)))
+  (when bg (setq bg (erc-get-bg-color-face bg)))
   (font-lock-prepend-text-property
    from
    to
-- 
2.44.0