Easily excise list-valued text prop members in ERC

* lisp/erc/erc.el (erc--remove-from-prop-value-list): New function for
removing `invisible' and `face' prop members cleanly.
* test/lisp/erc/erc-tests.el (erc--remove-from-prop-value-list,
erc--remove-from-prop-value-list/many): New tests.  (Bug#60936)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 3a0337eae9afa034576ed16e768c64923e38d8bf..c3312000ffdb16d607b35b26a23839e263db01bb 100644 (file)
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3079,6 +3079,30 @@ value.  See also `erc-button-add-face'."
             old (get-text-property pos prop object)
             end (next-single-property-change pos prop object to)))))
 
+(defun erc--remove-from-prop-value-list (from to prop val &optional object)
+  "Remove VAL from text prop value between FROM and TO.
+If current value is VAL itself, remove the property entirely.
+When VAL is a list, act as if this function were called
+repeatedly with VAL set to each of VAL's members."
+  (let ((old (get-text-property from prop object))
+        (pos from)
+        (end (next-single-property-change from prop object to))
+        new)
+    (while (< pos to)
+      (when old
+        (if (setq new (and (consp old) (if (consp val)
+                                           (seq-difference old val)
+                                         (remq val old))))
+            (put-text-property pos end prop
+                               (if (cdr new) new (car new)) object)
+          (when (pcase val
+                  ((pred consp) (or (consp old) (memq old val)))
+                  (_ (if (consp old) (memq val old) (eq old val))))
+            (remove-text-properties pos end (list prop nil) object))))
+      (setq pos end
+            old (get-text-property pos prop object)
+            end (next-single-property-change pos prop object to)))))
+
 (defvar erc-legacy-invisible-bounds-p nil
   "Whether to hide trailing rather than preceding newlines.
 Beginning in ERC 5.6, invisibility extends from a message's

diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 0b88ad9cfa956bd21ab7c45e64236d90248a05ba..ed89fd01d931bf2ccf0461836ed7b8a132549a98 100644 (file)
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1475,6 +1475,175 @@
     (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