This commit is contained in:
Kinneyzhang 2026-01-06 04:08:26 +08:00
parent 3e5773c2a2
commit e6a14e124f

48
tp.el
View File

@ -1015,11 +1015,20 @@ it will be applied to the text before updating."
(save-excursion (save-excursion
(tp--replace-reactive-text-in-buffer layer-name new-text props))))))))))) (tp--replace-reactive-text-in-buffer layer-name new-text props)))))))))))
(defvar tp-preserve-external-properties '(keymap mouse-face cursor pointer help-echo)
"List of text properties to preserve during reactive text updates.
These properties are typically set by external libraries (like twidget's event
system) and should not be overwritten when tp.el updates reactive text.
Properties in this list will be preserved from the buffer during updates,
while other properties will be replaced with the new values.")
(defun tp--replace-reactive-text-in-buffer (layer-name new-text props) (defun tp--replace-reactive-text-in-buffer (layer-name new-text props)
"Replace text in current buffer for reactive text with LAYER-NAME. "Replace text in current buffer for reactive text with LAYER-NAME.
NEW-TEXT is the new text to replace with. NEW-TEXT is the new text to replace with.
PROPS are the properties to apply to the new text. PROPS are the properties to apply to the new text.
Text properties embedded in NEW-TEXT are merged with PROPS." +Text properties embedded in NEW-TEXT are merged with PROPS.
+Properties listed in `tp-preserve-external-properties' that were applied
+by other libraries are preserved during the update."
(goto-char (point-min)) (goto-char (point-min))
(let ((match (text-property-search-forward 'tp-name layer-name t)) (let ((match (text-property-search-forward 'tp-name layer-name t))
;; Merge embedded text properties from new-text into props ;; Merge embedded text properties from new-text into props
@ -1027,18 +1036,29 @@ Text properties embedded in NEW-TEXT are merged with PROPS."
(while match (while match
(let* ((m-start (prop-match-beginning match)) (let* ((m-start (prop-match-beginning match))
(m-end (prop-match-end match)) (m-end (prop-match-end match))
(old-text (buffer-substring-no-properties m-start m-end))) (old-text (buffer-substring-no-properties m-start m-end))
(if (equal old-text (substring-no-properties new-text)) ;; Preserve only specific external properties
;; Text content is the same, but properties may differ (existing-props (text-properties-at m-start))
;; Use set-text-properties to replace with merged properties (preserved-props nil))
(set-text-properties m-start m-end merged-props) ;; Extract only the explicitly listed external properties to preserve
;; Text content is different - delete old text and insert new (dolist (prop-name tp-preserve-external-properties)
(delete-region m-start m-end) (let ((val (plist-get existing-props prop-name)))
(goto-char m-start) (when (and val (not (plist-member merged-props prop-name)))
(insert (substring-no-properties new-text)) (setq preserved-props
;; Apply merged properties (plist-put preserved-props prop-name val)))))
(let ((new-end (+ m-start (length new-text)))) ;; Combine merged-props with preserved external props
(set-text-properties m-start new-end merged-props)))) (let ((final-props (append merged-props preserved-props)))
(if (equal old-text (substring-no-properties new-text))
;; Text content is the same, but properties may differ
;; Use set-text-properties to replace with final properties
(set-text-properties m-start m-end final-props)
;; Text content is different - delete old text and insert new
(delete-region m-start m-end)
(goto-char m-start)
(insert (substring-no-properties new-text))
;; Apply final properties
(let ((new-end (+ m-start (length new-text))))
(set-text-properties m-start new-end final-props)))))
;; Search for next match ;; Search for next match
(setq match (text-property-search-forward 'tp-name layer-name t))))) (setq match (text-property-search-forward 'tp-name layer-name t)))))
@ -3008,7 +3028,7 @@ Recursively expands any nested layer names in the returned plist."
(when-let ((entry (cdr (assoc layer-name tp-layer-alist)))) (when-let ((entry (cdr (assoc layer-name tp-layer-alist))))
;; Auto-include tp-name for layers with reactive deps ;; Auto-include tp-name for layers with reactive deps
(let ((needs-tp-name (or include-tp-name (let ((needs-tp-name (or include-tp-name
(tp--layer-has-reactive-deps-p layer-name)))) (tp--layer-has-reactive-deps-p layer-name))))
(cond (cond
;; Unified format: entry is (ARGLIST BODY-FORM) where first elem is nil or a list ;; Unified format: entry is (ARGLIST BODY-FORM) where first elem is nil or a list
;; Check: exactly 2 elements and first is nil or a list of symbols ;; Check: exactly 2 elements and first is nil or a list of symbols