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)
This commit is contained in:
F. Jason Park 2024-03-07 21:53:23 -08:00
parent 7b4ca9e609
commit e2620fd734
3 changed files with 88 additions and 1 deletions

View 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.

View 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

View file

@ -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