[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master e2620fd7344 2/4: Make important text props more resilient in ERC
From: |
F. Jason Park |
Subject: |
master e2620fd7344 2/4: Make important text props more resilient in ERC |
Date: |
Sun, 10 Mar 2024 09:15:55 -0400 (EDT) |
branch: master
commit e2620fd73441af19d478f7a9262de8c08a47ee2f
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>
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 @@ that `erc-button-add-button' adds, except for the face."
'(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..3cc9bd54228 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3532,6 +3532,40 @@ repeatedly with VAL set to each of VAL's members."
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 (cl-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 @@
(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