From e4729668ed154127b7301e897c9d4328e37e2052 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 28 Dec 2025 17:11:34 +0000 Subject: [PATCH] Fix: support mixing layer properties with native text properties Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com> --- tp-tests.el | 48 +++++++++++++++++++++++++++++++++++++ tp.el | 68 ++++++++++++++++++++++++++++++++++------------------- 2 files changed, 92 insertions(+), 24 deletions(-) diff --git a/tp-tests.el b/tp-tests.el index 68016c6..bb80474 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -3210,5 +3210,53 @@ the inserted text should be that string, not the source text." (tp-layer-reset) (should-not tp-layer-params))) +(ert-deftest tp-test-layer-with-extra-props-string () + "Test layer with extra native properties on string." + (tp-test-with-temp-buffer + (define-tp tp-bold () + '(face bold)) + ;; Non-parameterized layer with extra props + (let ((result (tp-set "emacs" 'tp-bold t 'face '(:foreground "green")))) + (should (eq (get-text-property 0 'tp-name result) 'tp-bold)) + ;; Should have both face values in the plist + (let ((props (text-properties-at 0 result))) + (should (member 'face props)) + (should (eq (plist-get props 'tp-name) 'tp-bold)))))) + +(ert-deftest tp-test-parameterized-layer-with-extra-props-string () + "Test parameterized layer with extra native properties on string." + (tp-test-with-temp-buffer + (define-tp tp-space (pixel) + `(display (space :width (,pixel)))) + ;; Parameterized layer with extra props + (let ((result (tp-set "emacs" 'tp-space 6 'face '(:foreground "green")))) + (should (eq (get-text-property 0 'tp-name result) 'tp-space)) + (should (equal (get-text-property 0 'display result) '(space :width (6)))) + (should (equal (get-text-property 0 'face result) '(:foreground "green")))))) + +(ert-deftest tp-test-layer-with-extra-props-region () + "Test layer with extra native properties on region." + (tp-test-with-temp-buffer + (define-tp tp-bold () + '(face bold)) + ;; Region form with extra props + (let ((result (tp-set 0 5 '(tp-bold t face (:foreground "green")) "emacs"))) + (should (eq (get-text-property 0 'tp-name result) 'tp-bold)) + ;; Should have both face values in the plist + (let ((props (text-properties-at 0 result))) + (should (member 'face props)) + (should (eq (plist-get props 'tp-name) 'tp-bold)))))) + +(ert-deftest tp-test-parameterized-layer-with-extra-props-region () + "Test parameterized layer with extra native properties on region." + (tp-test-with-temp-buffer + (define-tp tp-space (pixel) + `(display (space :width (,pixel)))) + ;; Region form with extra props + (let ((result (tp-set 0 5 '(tp-space 6 face (:foreground "green")) "emacs"))) + (should (eq (get-text-property 0 'tp-name result) 'tp-space)) + (should (equal (get-text-property 0 'display result) '(space :width (6)))) + (should (equal (get-text-property 0 'face result) '(:foreground "green")))))) + (provide 'tp-ert-tests) ;;; tp-ert-tests.el ends here diff --git a/tp.el b/tp.el index f09ee6a..4e7bdc9 100644 --- a/tp.el +++ b/tp.el @@ -737,7 +737,8 @@ Supports multiple calling conventions: 2. Buffer region with object: (START END PROPS OBJECT) 3. String region: (START END PROPS STRING) 4. Entire string with plist: (STRING PROP VAL ...) -5. Entire string with layer: (STRING LAYER-NAME ARG)" +5. Entire string with layer: (STRING LAYER-NAME ARG) +6. Entire string with layer and extra props: (STRING LAYER-NAME ARG PROP VAL ...)" (let (object start finish props) (cond ;; First arg is a string - apply to entire string @@ -747,14 +748,14 @@ Supports multiple calling conventions: finish (length start-or-string)) ;; Check if second arg is a layer/group name or parameterized layer (cond - ;; (tp-set "str" 'layer-name arg) - layer with argument + ;; (tp-set "str" 'layer-name arg ...) - layer with argument and optional extra props ((and (symbolp end-or-prop) (or (assoc end-or-prop tp-layer-alist) (assoc end-or-prop tp-layer-groups) (assoc end-or-prop tp-layer-params)) - props-or-val - (null rest)) - (setq props (list end-or-prop props-or-val))) + props-or-val) + ;; Build props: (layer-name arg extra-prop1 val1 ...) + (setq props (cons end-or-prop (cons props-or-val rest)))) ;; (tp-set "str" 'layer-name) - layer without argument (legacy) ((and (symbolp end-or-prop) (or (assoc end-or-prop tp-layer-alist) @@ -810,9 +811,18 @@ Returns modified string or (START . END) cons for buffer." (setq props new-props finish new-finish object new-object) (when (and (stringp object) (plist-member props 'tp-text)) (setq start 0))) - ;; Apply properties individually - (cl-loop for (key val) on props by #'cddr - do (put-text-property start finish key val object)) + ;; Check if we have any existing properties in the range + (let ((has-existing-props (text-properties-at start object))) + (if (and (not has-existing-props) + ;; Also check if this is a uniform range (no intervals) + (or (stringp object) + (= start (or (next-single-property-change start nil object finish) finish)))) + ;; No existing properties - can use set-text-properties to preserve duplicate keys + (set-text-properties start finish props object) + ;; Has existing properties - use put-text-property for proper interval handling + ;; This may lose duplicate keys but correctly handles overlapping regions + (cl-loop for (key val) on props by #'cddr + do (put-text-property start finish key val object)))) (if (stringp object) object (cons start finish)))) (defun tp-reset (start-or-string &optional end-or-prop props-or-val &rest rest) @@ -2449,15 +2459,18 @@ PROPS can be: - A two-element list (LAYER-NAME ARG) where LAYER-NAME is a defined layer and ARG is either `t' for non-parameterized layers or the argument value for parameterized layers +- A list starting with (LAYER-NAME ARG EXTRA-PROPS...) where extra properties + are merged with the layer properties - A plist (handles anonymous layers with reactive variables) If PROPS is a symbol: - First checks `tp-layer-alist' and returns the layer properties WITH `tp-name' - Then checks `tp-layer-groups' and returns properties WITH `tp-layers' -If PROPS is (LAYER-NAME ARG): +If PROPS is (LAYER-NAME ARG) or (LAYER-NAME ARG EXTRA-PROPS...): - For non-parameterized layers: if ARG is t, returns the layer properties - For parameterized layers: evaluates the body with ARG and returns the result +- Extra properties after ARG are appended to the layer properties If PROPS is a plist: - If it contains reactive variables ($...), generates a UUID for `tp-name', @@ -2473,26 +2486,33 @@ For group names, includes `tp-layers' property with the full layer stack." ;; Already a plist - check for reactive variables and add tp-name ((listp props) (let ((first-elem (car-safe props)) - (second-elem (cadr props))) + (second-elem (cadr props)) + (extra-props (cddr props))) (cond - ;; Handle (layer-name arg) format for defined layers - ((and (= (length props) 2) + ;; Handle (layer-name arg ...) format for defined layers + ;; This includes both (layer-name arg) and (layer-name arg extra-prop val ...) + ((and (>= (length props) 2) (symbolp first-elem) (or (assoc first-elem tp-layer-alist) (assoc first-elem tp-layer-params) (assoc first-elem tp-layer-groups))) - (cond - ;; Parameterized layer - evaluate with the argument - ((tp-layer-parameterized-p first-elem) - (tp-layer-props-with-arg first-elem second-elem)) - ;; Non-parameterized layer - arg should be t, return the layer props - ;; (silently ignore non-t values for flexibility) - ((assoc first-elem tp-layer-alist) - (tp-layer-props first-elem)) - ;; Layer group - ((assoc first-elem tp-layer-groups) - (when-let ((layer-props-list (tp-group-props first-elem))) - (tp--build-layer-props layer-props-list))))) + (let ((layer-props + (cond + ;; Parameterized layer - evaluate with the argument + ((tp-layer-parameterized-p first-elem) + (tp-layer-props-with-arg first-elem second-elem)) + ;; Non-parameterized layer - arg should be t, return the layer props + ;; (silently ignore non-t values for flexibility) + ((assoc first-elem tp-layer-alist) + (tp-layer-props first-elem)) + ;; Layer group + ((assoc first-elem tp-layer-groups) + (when-let ((layer-props-list (tp-group-props first-elem))) + (tp--build-layer-props layer-props-list)))))) + ;; Append extra properties if any + (if (and layer-props extra-props) + (append layer-props extra-props) + layer-props))) ;; Handle single-element list containing a layer/group name symbol. ;; This can happen when tp-set is called with string form: (tp-set str 'layer-name)