Add prefix-conforming define aliases and export the group props plural

API-NAME-02: tp-define-layer, tp-define-group and tp-define-palette
are new permanent aliases of define-tp, define-tps and
define-tp-palette, each with a real docstring and the defun indent
spec, so C-h f tp-TAB finds the library's definition macros and
package-prefix review passes.  The historical names stay forever;
zero callers change.

API-SYM-01: tp-group-props-with-args is now public, delegating to
the private implementation, mirroring tp-layer-props-with-args -
multi-argument parameterized groups are a public feature (reachable
via tp-put-layer specs) and previously had no public introspection
path.  All four -with-arg/-with-args docstrings now cross-reference
their singular/plural sibling (calling out the one-character name
difference) and their layer/group counterpart.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Kinneyzhang 2026-07-27 02:34:31 +08:00
parent f6032a891e
commit 8c28361640
4 changed files with 130 additions and 7 deletions

View File

@ -234,5 +234,23 @@ tp-builtins restores the shipped layer definitions."
(should-not (tp-parse-color nil))
(should-error (tp-parse-color 42)))
;;; API-NAME-02: prefix-conforming tp-define-palette alias
(ert-deftest tp-builtins-test-define-palette-alias ()
"tp-define-palette is a working macro alias of define-tp-palette."
(unwind-protect
(progn
(tp-define-palette tp-test-alias-palette
:fg ("#111111" . "#eeeeee"))
(should (tp-palette-p 'tp-test-alias-palette))
(tp-builtins-test--with-background-mode 'light
(should (equal (tp-palette-fg-color 'tp-test-alias-palette)
"#111111")))
(tp-builtins-test--with-background-mode 'dark
(should (equal (tp-palette-fg-color 'tp-test-alias-palette)
"#eeeeee"))))
(setq tp-palette-alist
(assq-delete-all 'tp-test-alias-palette tp-palette-alist))))
(provide 'tp-builtins-tests)
;;; tp-builtins-tests.el ends here

View File

@ -657,5 +657,54 @@ text property list\"."
'(face (:foreground "red" :background "blue")
tp-name tp-lt-colors))))))
;;; API-SYM-01: public tp-group-props-with-args mirrors the layer pair
(ert-deftest tp-layer-test-group-props-with-args-public ()
"The public plural group accessor matches the private path."
(tp-layer-tests--with-clean
(define-tps tp-layer-test-pgrp (fg w)
`((face (:foreground ,fg)))
`((face (:weight ,w))))
(should (equal (tp-group-props-with-args 'tp-layer-test-pgrp
'("red" bold))
'((face (:foreground "red")) (face (:weight bold)))))
(should (equal (tp-group-props-with-args 'tp-layer-test-pgrp
'("red" bold))
(tp--group-props-with-args 'tp-layer-test-pgrp
'("red" bold))))
(should (equal (tp-group-props-with-args 'tp-layer-test-pgrp
'("red" bold) t)
(tp--group-props-with-args 'tp-layer-test-pgrp
'("red" bold) t)))
;; Non-parameterized or undefined groups return nil, like the
;; layer counterpart.
(should-not (tp-group-props-with-args 'tp-layer-test-nope '("x")))))
;;; API-NAME-02: prefix-conforming tp-define-* aliases
(ert-deftest tp-layer-test-define-layer-alias ()
"tp-define-layer is a working macro alias of define-tp."
(tp-layer-tests--with-clean
(tp-define-layer tp-layer-test-alias-l ()
'(face bold))
(should (equal (tp-layer-props 'tp-layer-test-alias-l) '(face bold)))
;; Parameterized definitions work through the alias too.
(tp-define-layer tp-layer-test-alias-p (color)
`(face (:foreground ,color)))
(should (equal (tp-layer-props-with-arg 'tp-layer-test-alias-p "red")
'(face (:foreground "red"))))))
(ert-deftest tp-layer-test-define-group-alias ()
"tp-define-group is a working macro alias of define-tps."
(tp-layer-tests--with-clean
(tp-define-layer tp-layer-test-alias-m ()
'(face italic))
(tp-define-group tp-layer-test-alias-g ()
'tp-layer-test-alias-m
'(face bold))
(should (assoc 'tp-layer-test-alias-g tp-layer-groups))
(should (equal (tp-group-props 'tp-layer-test-alias-g)
'((face italic) (face bold))))))
(provide 'tp-layer-tests)
;;; tp-layer-tests.el ends here

View File

@ -397,6 +397,16 @@ complete list of reserved names."
(t
(error "define-tp ARGLIST must be empty or a list of symbols"))))))))
;;;###autoload
(defalias 'tp-define-layer 'define-tp
"Define a text property layer named NAME; alias of `define-tp'.
This is the package-prefix-conforming name for the layer definition
macro, so it is discoverable via the tp- prefix; `define-tp' is the
historical name and both are permanent - neither will be removed.
See `define-tp' for the full documentation of NAME, ARGLIST and
BODY.")
(function-put 'tp-define-layer 'lisp-indent-function 'defun)
(defun tp--define-layer-unified (name arglist body)
"Define a layer NAME with ARGLIST and BODY using unified structure.
For non-parameterized layers, ARGLIST is nil and BODY is the evaluated plist.
@ -731,6 +741,16 @@ complete list of reserved names."
(defalias 'define-tp-group 'define-tps
"Alias for `define-tps' for backward compatibility.")
;;;###autoload
(defalias 'tp-define-group 'define-tps
"Define a text property group named NAME; alias of `define-tps'.
This is the package-prefix-conforming name for the group definition
macro, so it is discoverable via the tp- prefix; `define-tps' and
`define-tp-group' are the historical names and all three are
permanent - none will be removed. See `define-tps' for the full
documentation of NAME, ARGLIST and BODY.")
(function-put 'tp-define-group 'lisp-indent-function 'defun)
(defun tp--set-layer-props (layer-name properties)
"Set PROPERTIES for layer LAYER-NAME in `tp-layer-alist'.
If the layer already exists, updates its properties; otherwise creates it.
@ -841,7 +861,11 @@ reactive dependencies (parameterized layers cannot be reactive).
Signals an error naming the cycle if layer references are cyclic.
The returned plist is a fresh copy: mutating it does not affect the
stored layer definition.
Returns nil when LAYER-NAME is not a parameterized layer."
Returns nil when LAYER-NAME is not a parameterized layer.
See also `tp-layer-props-with-arg' - note the one-character name
difference - for the single-argument convenience, and
`tp-group-props-with-args' for the group counterpart."
(when (tp-layer-parameterized-p layer-name)
(let* ((entry (cdr (assoc layer-name tp-layer-alist)))
(arglist (car entry))
@ -873,7 +897,8 @@ Returns nil when LAYER-NAME is not a parameterized layer."
"Return properties for parameterized layer LAYER-NAME with ARG.
Evaluates the body form with the argument bound to the parameter.
This is the single-argument convenience over
`tp-layer-props-with-args', equivalent to calling it with (list ARG).
`tp-layer-props-with-args' - note the one-character name difference -
equivalent to calling it with (list ARG).
If INCLUDE-TP-NAME is non-nil, appends `tp-name' property to identify
the layer.
Recursively expands any nested layer names in the returned plist.
@ -882,7 +907,9 @@ values of their variables at evaluation time; they do not create
reactive dependencies (parameterized layers cannot be reactive).
Signals an error naming the cycle if layer references are cyclic.
The returned plist is a fresh copy: mutating it does not affect the
stored layer definition."
stored layer definition.
See also `tp-group-props-with-arg' for the group counterpart."
(tp-layer-props-with-args layer-name (list arg) include-tp-name))
(defun tp--layer-props-for-arg-value (layer-name value &optional include-tp-name)
@ -999,7 +1026,8 @@ so dynamically) to the group's parameters while the stored body form
is evaluated. Each evaluated element is converted like
`tp-group-props-with-arg' documents. If INCLUDE-TP-NAME is non-nil,
named layer references include tp-name.
Returns nil when GROUP-NAME is not a parameterized group."
Returns nil when GROUP-NAME is not a parameterized group.
The public entry point delegating here is `tp-group-props-with-args'."
(when (tp-group-parameterized-p group-name)
(let* ((entry (cdr (assoc group-name tp-layer-groups)))
(arglist (car entry))
@ -1015,15 +1043,34 @@ Returns nil when GROUP-NAME is not a parameterized group."
(defun tp-group-props-with-arg (group-name arg &optional include-tp-name)
"Return list of properties for parameterized group GROUP-NAME with ARG.
Evaluates the body form with the argument bound to the parameter.
This is the single-argument convenience over the multi-argument path
\(`tp--group-props-with-args'), equivalent to passing (list ARG).
This is the single-argument convenience over
`tp-group-props-with-args' - note the one-character name difference -
equivalent to calling it with (list ARG).
Each evaluated element may be a layer name symbol, a (LAYER-NAME ARG)
reference, a named element (\"NAME\" . PLIST) / (\"NAME\" :props PLIST),
or a raw property list (anonymous layer) as documented in `define-tps'.
If INCLUDE-TP-NAME is non-nil, named layer references include tp-name.
Returns a list of property lists for each layer in the group."
Returns a list of property lists for each layer in the group.
See also `tp-layer-props-with-arg' for the single-layer counterpart."
(tp--group-props-with-args group-name (list arg) include-tp-name))
(defun tp-group-props-with-args (group-name args &optional include-tp-name)
"Return list of properties for parameterized group GROUP-NAME with ARGS.
ARGS is a list of argument values bound positionally to the group's
parameters while the stored body form is evaluated - the public
multi-argument introspection path for groups defined by `define-tps'
with two or more parameters (which `tp-put-layer' specs like
\(GROUP-NAME ARG1 ARG2) consume). Each evaluated element is
converted exactly as `tp-group-props-with-arg' documents. If
INCLUDE-TP-NAME is non-nil, named layer references include tp-name.
Returns nil when GROUP-NAME is not a parameterized group.
This mirrors `tp-layer-props-with-args' for layers. See also
`tp-group-props-with-arg' - note the one-character name difference -
for the single-argument convenience."
(tp--group-props-with-args group-name args include-tp-name))
(defun tp--group-props-for-arg-value (group-name value &optional include-tp-name)
"Return props list for parameterized GROUP-NAME given a stored VALUE.
When GROUP-NAME takes more than one parameter and VALUE is a proper

View File

@ -42,6 +42,15 @@ definition updates the stored palette in place."
(declare (indent defun))
`(setf (alist-get ',name tp-palette-alist) '(,@plist)))
(defalias 'tp-define-palette 'define-tp-palette
"Register a color palette named NAME; alias of `define-tp-palette'.
This is the package-prefix-conforming name for the palette
definition macro, so it is discoverable via the tp- prefix;
`define-tp-palette' is the historical name and both are permanent -
neither will be removed. See `define-tp-palette' for the full
documentation of NAME and PLIST.")
(function-put 'tp-define-palette 'lisp-indent-function 'defun)
(define-tp-palette button-primary
:fg ("#ffffff" . "#ffffff") :bg ("#007bff" . "#007bff"))