geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

Close cross-module seams for multi-argument parameterized specs

Browse Source 
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 <noreply@anthropic.com>
This commit is contained in:
Kinneyzhang 2026-07-27 00:36:19 +08:00
parent 507ccf798c
commit 27ad7325c5
3 changed files with 111 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
tp-ops.el
View File

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

71
tp-stack-tests.el
View File

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

34
tp-stack.el
View File

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