From 27ad7325c5da13494c218d88ad3876f07b1f4554 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Mon, 27 Jul 2026 00:36:19 +0800 Subject: [PATCH] Close cross-module seams for multi-argument parameterized specs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit tp-put-layer now dispatches multi-argument layer and group specs — flat (NAME A1 .. AN) and wrapped (NAME (A1 .. AN)) — checked before the list-of-specs branch so argument values that are themselves layer names are not misread as a stack of layers. tp-remove's layer-key extraction binds every parameter with dummy args via tp-layer-props-with-args instead of passing a single dummy to the first parameter only. Five regression tests; suite 527/527, doctests 63/63, compile clean. Known pre-existing gap surfaced while testing (deliberately not fixed here, queued for the design review): parameterized layers applied via the tp-set plist forms never stamp tp-name, so tp-remove by layer name is a silent no-op for them regardless of arity. Co-Authored-By: Claude Fable 5 --- tp-ops.el | 8 ++++-- tp-stack-tests.el | 71 +++++++++++++++++++++++++++++++++++++++++++++++ tp-stack.el | 34 +++++++++++++++++++++++ 3 files changed, 111 insertions(+), 2 deletions(-) diff --git a/tp-ops.el b/tp-ops.el index 1c624ef..e7c3e9b 100644 --- a/tp-ops.el +++ b/tp-ops.el @@ -618,11 +618,15 @@ If PROPERTY is a layer name, all properties added by that layer are removed." (next-pos (or (next-single-property-change pos 'tp-name object end) end))) (when (eq tp-name-at-pos property) ;; This region has the layer applied - get the layer's property keys - ;; For parameterized layers, we pass a dummy arg (t) since we only need key names + ;; For parameterized layers, we pass dummy args (t per + ;; parameter) since we only need key names (let* ((layer-props (cond ((tp-layer-parameterized-p property) - (tp-layer-props-with-arg property t nil)) ; arg=t, include-tp-name=nil + (tp-layer-props-with-args + property + (make-list (length (tp-layer-arglist property)) t) + nil)) ((assoc property tp-layer-alist) (tp-layer-props property nil)) ; include-tp-name=nil ((assoc property tp-layer-groups) diff --git a/tp-stack-tests.el b/tp-stack-tests.el index 1d5054e..be6a209 100644 --- a/tp-stack-tests.el +++ b/tp-stack-tests.el @@ -791,5 +791,76 @@ definitions cannot leak between tests." (should (null (tp-push-layer 1 6 'undefined-x nil t))) (should (null (text-properties-at 1))))) +;;; Multi-argument parameterized specs through tp-put-layer + +(ert-deftest tp-stack-test-put-layer-multiarg-layer-flat () + "tp-put-layer accepts flat (LAYER ARG1 ARG2) for a 2-arity layer." + (tp-layer-reset) + (define-tp tp-st-colors (fg bg) + `(face (:foreground ,fg :background ,bg))) + (with-temp-buffer + (insert "Hello") + (tp-put-layer 1 5 '(tp-st-colors "red" "blue") 0) + (should (equal (tp-at 1 'face) + '(:foreground "red" :background "blue"))))) + +(ert-deftest tp-stack-test-put-layer-multiarg-layer-wrapped () + "tp-put-layer accepts wrapped (LAYER (ARG1 ARG2)) for a 2-arity layer." + (tp-layer-reset) + (define-tp tp-st-colors2 (fg bg) + `(face (:foreground ,fg :background ,bg))) + (with-temp-buffer + (insert "Hello") + (tp-put-layer 1 5 '(tp-st-colors2 ("green" "black")) 0) + (should (equal (tp-at 1 'face) + '(:foreground "green" :background "black"))))) + +(ert-deftest tp-stack-test-put-layer-multiarg-layer-symbol-args () + "Multi-arg specs are not misread as a list of layer names. +Arguments that are themselves defined layer names used to be +intercepted by the list-of-specs branch." + (tp-layer-reset) + (define-tp tp-st-a () '(help-echo "a")) + (define-tp tp-st-b () '(help-echo "b")) + (define-tp tp-st-pair (x y) + `(display (,x . ,y))) + (with-temp-buffer + (insert "Hello") + (tp-put-layer 1 5 '(tp-st-pair tp-st-a tp-st-b) 0) + (should (equal (tp-at 1 'display) '(tp-st-a . tp-st-b))) + (should (null (tp-at 1 'help-echo))))) + +(ert-deftest tp-stack-test-put-layer-multiarg-group () + "tp-put-layer accepts (GROUP ARG1 ARG2) for a 2-arity group." + (tp-layer-reset) + (define-tps tp-st-duo (fg bg) + `(face (:foreground ,fg)) + `(face (:background ,bg))) + (with-temp-buffer + (insert "Hello") + (tp-put-layer 1 5 '(tp-st-duo "red" "blue") 0) + (should (equal (tp-at 1 'face) '(:foreground "red"))) + (should (= (tp-layer-count 1 5) 2)))) + +(ert-deftest tp-stack-test-remove-multiarg-layer-by-name () + "tp-remove removes a multi-arg parameterized layer's props by name. +Applied via `tp-put-layer' so the region carries the layer's +`tp-name' (the `tp-set' plist forms do not stamp `tp-name' for +parameterized layers, so name-based removal cannot see those). +The key-extraction path must bind all parameters (dummy args), +not just the first." + (tp-layer-reset) + (define-tp tp-st-colors3 (fg bg) + `(face (:foreground ,fg :background ,bg))) + (with-temp-buffer + (insert "Hello") + (tp-put-layer 1 5 '(tp-st-colors3 "red" "blue") 0) + (put-text-property 1 5 'help-echo "tip") + (should (tp-at 1 'face)) + (should (eq (tp-at 1 'tp-name) 'tp-st-colors3)) + (tp-remove 1 5 'tp-st-colors3) + (should (null (tp-at 1 'face))) + (should (equal (tp-at 1 'help-echo) "tip")))) + (provide 'tp-stack-tests) ;;; tp-stack-tests.el ends here diff --git a/tp-stack.el b/tp-stack.el index e047f04..783b1c5 100644 --- a/tp-stack.el +++ b/tp-stack.el @@ -240,6 +240,40 @@ defined layer or group name); a named inline layer has odd length ;; Any other symbol: a single layer name. ((symbolp layer-spec) (list (tp--normalize-layer-spec layer-spec))) + ;; (GROUP-NAME ARG1 ... ARGN) or (GROUP-NAME (ARG1 ... ARGN)): + ;; multi-argument parameterized group (arity >= 2). Checked before + ;; the single-arg forms so the wrapped variant is not mistaken for + ;; one list-valued argument. + ((and (consp layer-spec) + (symbolp (car layer-spec)) + (proper-list-p layer-spec) + (let ((arity (length (tp--group-arglist (car layer-spec))))) + (and (>= arity 2) + (or (= (length (cdr layer-spec)) arity) + (and (= (length (cdr layer-spec)) 1) + (proper-list-p (cadr layer-spec)) + (= (length (cadr layer-spec)) arity)))))) + (let* ((arity (length (tp--group-arglist (car layer-spec)))) + (args (if (= (length (cdr layer-spec)) arity) + (cdr layer-spec) + (cadr layer-spec)))) + (tp--group-props-with-args (car layer-spec) args t))) + ;; (LAYER-NAME ARG1 ... ARGN) or (LAYER-NAME (ARG1 ... ARGN)): + ;; multi-argument parameterized layer (arity >= 2). + ((and (consp layer-spec) + (symbolp (car layer-spec)) + (proper-list-p layer-spec) + (let ((arity (length (tp-layer-arglist (car layer-spec))))) + (and (>= arity 2) + (or (= (length (cdr layer-spec)) arity) + (and (= (length (cdr layer-spec)) 1) + (proper-list-p (cadr layer-spec)) + (= (length (cadr layer-spec)) arity)))))) + (let* ((arity (length (tp-layer-arglist (car layer-spec)))) + (args (if (= (length (cdr layer-spec)) arity) + (cdr layer-spec) + (cadr layer-spec)))) + (list (tp--normalize-layer-spec (cons (car layer-spec) args))))) ;; (GROUP-NAME ARG): parameterized group. ((and (consp layer-spec) (symbolp (car layer-spec))