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:
parent
f6032a891e
commit
8c28361640
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
61
tp-layer.el
61
tp-layer.el
@ -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
|
||||
|
||||
@ -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"))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user