]> git.eshelyaron.com Git - emacs.git/commitdiff
Make important text props more resilient in ERC
authorF. Jason Park <jp@neverwas.me>
Fri, 8 Mar 2024 05:53:23 +0000 (21:53 -0800)
committerEshel Yaron <me@eshelyaron.com>
Mon, 11 Mar 2024 09:25:49 +0000 (10:25 +0100)
* 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)

(cherry picked from commit e2620fd73441af19d478f7a9262de8c08a47ee2f)

lisp/erc/erc-button.el
lisp/erc/erc.el
test/lisp/erc/erc-tests.el

index 6b78e451b545223a32cbc5a07bc90b68f85f3a98..4b4930e5bff6faa1edc1dc38bdc4928ec797b315 100644 (file)
@@ -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.
index cce3b2508fb2b03f87bb3c5c182be63e9fc9de10..3cc9bd5422802255dedc460b0a5e3ab42a1f9125 100644 (file)
@@ -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
index 085b063bdb2b7f703407c04b7078aac52e99dc31..6809d9db41deeff7a772638808d72dcd6f95b8ed 100644 (file)
     (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