tp/tp-layer.el
Kinneyzhang 972b6d4e4c Complete text-property facade and managed lifecycle
Add canonical query semantics, managed metadata and transactions, overlay-aware lookup, reproducible benchmarks, and synchronized API documentation.
2026-07-28 22:42:55 +08:00

1805 lines
83 KiB
EmacsLisp

;;; tp-layer.el --- Layer definition and registry for tp -*- lexical-binding: t -*-
;; Copyright (C) 2024-2026 Geekinney
;; Author: Geekinney (kinneyzhang666@gmail.com)
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3 of
;; the License, or (at your option) any later version.
;;; Commentary:
;; The layer registry: `define-tp' / `define-tps' and all machinery to
;; define, store, resolve and expand named property layers and groups,
;; plus the layer-stack representation helpers shared with tp-stack.el.
;;; Code:
(require 'cl-lib)
(require 'dash)
(require 'tp-core)
(require 'tp-reactive)
(define-error 'tp-unresolved-layer "Unresolved tp layer or group")
(define-error 'tp-layer-conflict "Conflicting edit in a managed tp range")
(defvar tp--layer-refresh-function nil
"Function re-rendering regions that carry a given layer, or nil.
Installed by tp-render.el. Called with
\(LAYER-NAME nil nil OLD-PROPS) after a non-parameterized layer is
redefined, so text that already uses the layer can replace the old
owned properties with the new definition. When nil, redefinition
only updates the registry.")
(defun tp--layer-refresh (layer-name &optional old-props)
"Re-render regions carrying LAYER-NAME via `tp--layer-refresh-function'."
(when tp--layer-refresh-function
(funcall tp--layer-refresh-function layer-name nil nil old-props)))
(defvar tp-layer-alist nil
"Alist of layer definitions: (LAYER-NAME . PROPERTIES).")
(defvar tp--layer-definition-counter 0
"Monotonic counter used for layer definition versions.")
(defvar tp--layer-definition-versions nil
"Alist of layer definition versions: (LAYER-NAME . VERSION).")
(defvar tp--managed-entry-counter 0
"Monotonic counter used for managed stack entry ids.")
(defun tp--layer-definition-version (layer-name)
"Return LAYER-NAME's current definition version, or 0."
(or (cdr (assq layer-name tp--layer-definition-versions)) 0))
(defun tp--bump-layer-definition-version (layer-name)
"Increment and return LAYER-NAME's definition version."
(setq tp--layer-definition-counter (1+ tp--layer-definition-counter))
(setf (alist-get layer-name tp--layer-definition-versions)
tp--layer-definition-counter)
tp--layer-definition-counter)
(defun tp--store-layer-entry (layer-name entry &optional bump-version)
"Store LAYER-NAME registry ENTRY, optionally bumping its version."
(if (assoc layer-name tp-layer-alist)
(setf (cdr (assoc layer-name tp-layer-alist)) entry)
(push (cons layer-name entry) tp-layer-alist))
(when bump-version
(tp--bump-layer-definition-version layer-name))
(assoc layer-name tp-layer-alist))
(defun tp--next-managed-entry-id ()
"Return a fresh managed entry id symbol."
(setq tp--managed-entry-counter (1+ tp--managed-entry-counter))
(intern (format "tp-entry-%d" tp--managed-entry-counter)))
(defvar tp-layer-groups nil
"Alist of layer groups: (GROUP-NAME . (LAYER-NAME1 LAYER-NAME2 ...)).")
(defvar tp-layer-transforms nil
"Alist of layer transforms: (LAYER-NAME . TRANSFORM-FN).
TRANSFORM-FN receives the value and returns the transformed value.
Used for tp-text transformations like formatting numbers or dates.")
(defvar tp--group-generated-layers nil
"Alist tracking layers generated by each group: (GROUP-NAME . LAYER-NAMES).
Only layers created by the group definition itself (anonymous and
named elements) are recorded here; layers merely referenced by name
are not. Used to clean up orphaned layers when a group is redefined
or undefined.")
;; The counter below INTENTIONALLY survives `tp-layer-reset' (which
;; clears `tp--anonymous-layer-registry' but not this): detached
;; strings can outlive a reset while still carrying `tp-anon-N'
;; property values, so the counter must keep increasing monotonically
;; - a post-reset anonymous layer must never be minted under a name a
;; stale string still holds. Do not "fix" this by resetting it.
(defvar tp--anonymous-layer-counter 0
"Counter for generating unique anonymous layer names.
Never reset - not even by `tp-layer-reset' - so freshly minted
`tp-anon-N' names cannot collide with names living on in detached
strings (see the comment above).")
(defun tp--generate-anonymous-layer-name ()
"Generate a unique symbol for anonymous reactive layers."
(setq tp--anonymous-layer-counter (1+ tp--anonymous-layer-counter))
(intern (format "tp-anon-%d" tp--anonymous-layer-counter)))
(defvar tp--anonymous-layer-registry nil
"Alist interning anonymous reactive layers: (PROPS-SPEC . LAYER-NAME).
PROPS-SPEC is the original (unresolved) props spec passed to
`tp--resolve-props'; LAYER-NAME is the anonymous layer registered for
it. Lookup is `equal'-based, so resolving an identical spec reuses
the existing anonymous layer instead of minting a new registry entry
on every call.")
(defun tp--anonymous-layer-name-for (props)
"Return the interned anonymous layer name for reactive spec PROPS.
If an `equal' spec was registered before, reuse its layer name;
otherwise generate a fresh name via `tp--generate-anonymous-layer-name'
and record it in `tp--anonymous-layer-registry'."
(or (cdr (assoc props tp--anonymous-layer-registry))
(let ((name (tp--generate-anonymous-layer-name)))
(push (cons (copy-tree props) name) tp--anonymous-layer-registry)
name)))
(defun tp--buffer-has-layer-region-p (layer-name &optional buffer)
"Return non-nil when BUFFER has a region carrying LAYER-NAME.
BUFFER defaults to the current buffer; a dead BUFFER yields nil.
Stack-aware: the layer counts as present when it is the rendered top
layer (direct `tp-name' text property) or sits anywhere inside the
`tp-layers' stack-storage property - buried below another layer, or
hidden (see `tp-hide-layer') - so liveness checks never miss a layer
a live buffer still holds. Built on the shared scan
`tp-reactive--buffer-layer-names'."
(and (member layer-name (tp-reactive--buffer-layer-names buffer)) t))
;;;###autoload
(defun tp-gc-anonymous-layers ()
"Collect anonymous layers that no live buffer displays anymore.
Walk `tp--anonymous-layer-registry' and, for every interned anonymous
layer whose buffer registry has real knowledge (see
`tp-reactive-layer-buffers'), check whether any registered live
buffer still contains a region carrying the layer - as the rendered
top layer or anywhere inside `tp-layers' stack storage, so buried and
hidden layers count as alive (see `tp--buffer-has-layer-region-p').
Layers displayed nowhere are undefined via `tp-undefine-layer', which
also drops their reactive dependencies, transforms and registry
entries.
Layers whose registry state is `unknown' are conservatively kept:
they were never seen in any buffer through the registering paths,
and detached strings may still reference them. A layer becomes
collectable only after it was registered for at least one buffer and
none of the registered buffers still shows it (for example after the
buffers were killed); call `tp-reactive-track-buffer' after
inserting propertized strings so their buffers are registered too.
Return the list of collected layer names."
(interactive)
(let ((collected nil))
;; Snapshot the names first: `tp-undefine-layer' mutates the
;; anonymous-layer registry while we iterate.
(dolist (name (mapcar #'cdr tp--anonymous-layer-registry))
(let ((bufs (tp-reactive-layer-buffers name)))
(when (and (not (eq bufs 'unknown))
(not (cl-some (lambda (buf)
(tp--buffer-has-layer-region-p name buf))
bufs)))
(tp-undefine-layer name)
(push name collected))))
(when (called-interactively-p 'interactive)
(message "tp: collected %d anonymous layer(s)" (length collected)))
(nreverse collected)))
(defvar tp--layer-expansion-stack nil
"Layer names currently being expanded, innermost first.
Dynamically bound during `tp-layer-props' / `tp-layer-props-with-arg'
to detect cyclic layer references.")
(defun tp--check-layer-cycle (layer-name)
"Signal a clear error if LAYER-NAME is already being expanded.
The error message names the full cycle, e.g. \"a -> b -> a\"."
(when (memq layer-name tp--layer-expansion-stack)
(error "tp: cyclic layer reference: %s"
(mapconcat #'symbol-name
(reverse (cons layer-name tp--layer-expansion-stack))
" -> "))))
(defun tp--get-layer-face-contribution (layer-name layer-prop-value)
"Get the face contribution from LAYER-NAME.
LAYER-PROP-VALUE is the value of the layer property (the argument passed to it).
Returns the face value that the layer adds, or nil if no face contribution."
(when (tp--is-layer-name-p layer-name)
(let ((layer-props
(cond
((tp-layer-parameterized-p layer-name)
(tp--layer-props-for-arg-value layer-name layer-prop-value nil))
((assoc layer-name tp-layer-alist)
(tp-layer-props layer-name nil))
((assoc layer-name tp-layer-groups)
(when-let ((layer-props-list (tp-group-props layer-name t)))
(tp--build-layer-props layer-props-list))))))
(when layer-props
(plist-get layer-props 'face)))))
(defun tp--parse-define-layer-args (args)
"Parse ARGS for tp--define-layer-internal function.
Returns plist with keys :props, :data, :watch, :compute, :transform.
- Keyword arguments: :props PLIST [:data DATA] [:watch WATCH]
[:compute COMPUTE] [:transform FN]"
(let (props data watch compute transform)
(cond
;; Check for keyword arguments format
((and (keywordp (car args))
(memq (car args) '(:props :data :watch :compute :transform)))
;; Parse keyword arguments
(let ((rest args))
(while rest
(pcase (car rest)
(:props (setq props (cadr rest) rest (cddr rest)))
(:data (setq data (cadr rest) rest (cddr rest)))
(:watch (setq watch (cadr rest) rest (cddr rest)))
(:compute (setq compute (cadr rest) rest (cddr rest)))
(:transform (setq transform (cadr rest) rest (cddr rest)))
(_ (error "Unknown keyword in tp--define-layer-internal: %s" (car rest))))))
;; Validate: if :watch, :compute, or :data present, :props must be present
(when (and (or watch compute data) (null props))
(error "When using :watch, :compute, or :data, :props must be explicitly specified")))
;; Format 1: single plist (the plist directly as first arg)
((and (= (length args) 1)
(listp (car args)))
(setq props (car args)))
(t (error "Invalid tp--define-layer-internal format")))
(list :props props :data data :watch watch :compute compute :transform transform)))
(defun tp--define-layer-internal (name &rest args)
"Define a single text property layer named NAME.
This function supports two formats:
Format 1 - Direct plist (no :watch/:compute/:data/:transform support):
(tp--define-layer-internal \\='layer-name
\\='(display \"🌑\" face (:height 1.0)))
Format 2 - With :props, :data, :watch, :compute, and/or :transform
\(Vue 3 style reactivity):
(tp--define-layer-internal \\='layer-name
;; props: $-prefixed symbols are reactive variables;
;; auto-defined if not bound
:props \\='(face (:foreground $my-color) help-echo $full-name)
;; data: additional reactive variables not used in props;
;; auto-defined if not bound
:data \\='((first-name . \"John\") (last-name . \"Doe\"))
;; compute: list of (VAR-NAME FUNCTION) - compute reactive variable values
:compute \\='((full-name (lambda () (concat first-name \" \" last-name))))
;; watch: list of (VAR-NAME CALLBACK) - side effects when vars change
:watch \\='((my-color (lambda (new old layer)
(message \"Color changed from %s to %s\" old new))))
;; transform: function to transform tp-text values before display
:transform (lambda (text) (upcase text)))
Reactive Variables:
If any symbol in :props starts with $, it is treated as a reactive variable.
Variables in :data are also reactive. All reactive variables are automatically
defined as global variables if they are not already bound.
:data - A list of variable symbols or cons cells (SYMBOL . INITIAL-VALUE)
for additional reactive state not in :props.
:compute - A list of (VAR-SYMBOL COMPUTE-FN) pairs. COMPUTE-FN is evaluated
to compute the value of VAR-SYMBOL. Can reference other reactive variables
from both :props and :data.
:watch - A list of (VAR-SYMBOL CALLBACK) pairs. CALLBACK is called when
VAR-SYMBOL changes, receiving (NEW-VALUE OLD-VALUE LAYER-NAME).
:transform - A function that receives the tp-text value and returns a
transformed string. Useful for formatting numbers, dates, or other values
before display.
Example: (lambda (text) (format \"$%.2f\" (string-to-number text)))
Note: When using :watch, :compute, or :data, you MUST use :props to specify
the text properties explicitly.
If a layer with the same NAME already exists, it will be overwritten.
The layer is stored in `tp-layer-alist'."
(declare (indent defun))
(let* ((old-props (when (assoc name tp-layer-alist)
(tp-layer-props name t)))
(parsed (tp--parse-define-layer-args args))
(properties (plist-get parsed :props))
(data (plist-get parsed :data))
(watch (plist-get parsed :watch))
(compute (plist-get parsed :compute))
(transform (plist-get parsed :transform))
(reactive-syms (tp--collect-reactive-symbols properties))
;; Collect computed variable names (they become reactive too)
(computed-vars (when compute (mapcar #'car compute)))
;; All variables that need to be reactive
(all-reactive-syms (delete-dups (append reactive-syms)))
;; Variables from :props that need to be defined (without initial values)
(props-vars (mapcar #'tp--reactive-var-symbol reactive-syms))
;; All variables to ensure are defined:
;; - :data entries (may have initial values as cons cells)
;; - :props reactive symbols (no initial values)
;; - :compute variable names (no initial values)
(all-vars-to-define (delete-dups
(append data
props-vars
computed-vars))))
;; Register or unregister transform function
(if transform
(if (assoc name tp-layer-transforms)
(setcdr (assoc name tp-layer-transforms) transform)
(push (cons name transform) tp-layer-transforms))
;; Remove any existing transform when redefining without one
(setq tp-layer-transforms (assq-delete-all name tp-layer-transforms)))
(if (or all-reactive-syms data compute)
;; Has reactive features - register dependencies and resolve at runtime
(progn
;; Clean up old reactive dependencies, watchers, computed properties, and data (for re-definition)
(tp--unregister-reactive-deps name)
;; Ensure all reactive variables are defined
(tp--ensure-reactive-variables all-vars-to-define)
;; Register data variables
(when data
(tp--register-layer-data name data))
;; Register computed variable definitions
(when compute
(tp--register-layer-computed name compute)
;; Apply initial computed values
(tp--apply-initial-computed compute))
;; Register reactive dependencies
(tp--register-reactive-deps name all-reactive-syms properties)
;; Register watchers
(when watch
(tp--register-layer-watchers name watch))
;; Set layer properties with resolved values
(let ((resolved-props (tp--resolve-reactive-symbols properties)))
(tp--set-layer-props name resolved-props))
(tp--bump-layer-definition-version name)
;; Update any text regions that already have this layer applied
;; This ensures re-definition immediately updates applied text
(tp--layer-refresh name old-props)
(assoc name tp-layer-alist))
;; No reactive symbols - use static properties
(progn
;; Clean up old reactive dependencies, watchers, computed properties, and data (for re-definition)
(tp--unregister-reactive-deps name)
(tp--set-layer-props name properties)
(tp--bump-layer-definition-version name)
;; Update any text regions that already have this layer applied
(tp--layer-refresh name old-props)
(assoc name tp-layer-alist)))))
;;;###autoload
(defmacro define-tp (name arglist &rest body)
"Define a text property layer named NAME.
This macro supports three formats:
Format 1 - Non-parameterized simple (empty arglist, simple body):
(define-tp tp-bold ()
\\='(face bold))
Format 2 - Parameterized simple (one or more arguments, simple body):
(define-tp tp-space (pixel)
\\=`(display (space :width (,pixel))))
(define-tp tp-colors (fg bg)
\\=`(face (:foreground ,fg :background ,bg)))
Format 3 - Non-parameterized with reactive features
\(requires $-prefixed variables):
(define-tp my-layer ()
:props \\='(face (:foreground $my-color))
:data \\='((my-color . \"red\"))
:compute \\='((full-name (lambda () (concat first-name \" \" last-name))))
:watch \\='((my-color (lambda (new old layer) (message \"Color changed!\"))))
:transform (lambda (text) (upcase text)))
Usage:
(tp-set \"emacs\" \\='tp-bold t)
(tp-set 0 5 \\='(tp-bold t) \"emacs\")
;; => #(\"emacs\" 0 5 (face bold))
Direct `tp-set' use expands a non-reactive layer as a property
template and does not retain `tp-name'. Use `tp-push-layer' or
`tp-put-layer' when the text must retain managed layer identity.
ARGLIST must be either:
- An empty list () for non-parameterized layers
- A list of one or more parameter symbols for parameterized layers
BODY is either:
- A single property list expression (simple format)
- Keyword arguments starting with :props, :data, :compute, :watch, or :transform
(reactive format - only for non-parameterized layers with $-prefixed
variables)
In simple format, exactly one body form is accepted; supplying more
than one signals an error at macro-expansion time instead of silently
discarding the extra forms.
$-prefixed reactive symbols appearing in a PARAMETERIZED body do not
create reactive dependencies (parameterized layers cannot be
reactive); they are resolved to the current value of the corresponding
variable each time the layer is evaluated via
`tp-layer-props-with-arg' or `tp-layer-props-with-args'.
Note: NAME cannot be a built-in Emacs text property name like `face',
`display', `invisible', etc. See `tp--builtin-text-properties' for the
complete list of reserved names."
(declare (indent defun))
(unless (listp arglist)
(error "define-tp ARGLIST must be a list"))
;; Check for built-in text property name conflict
(when (tp--builtin-text-property-p name)
(error "define-tp: '%s' is a built-in Emacs text property name and cannot be used as a layer name" name))
;; Check if body starts with keyword (reactive format)
(let ((first-elem (car body)))
(if (and (keywordp first-elem)
(memq first-elem '(:props :data :compute :watch :transform)))
;; Reactive format - only allowed for non-parameterized layers
(if arglist
(error "define-tp: reactive keywords (:props, :data, :compute, :watch, :transform) are only supported for non-parameterized layers (empty arglist)")
;; Non-parameterized reactive: use tp--define-layer-internal directly
`(tp--define-layer-internal ',name ,@body))
;; Simple format (original behavior)
(progn
(when (cdr body)
(error "define-tp %s: simple format takes exactly one body form, got %d (use the :props keyword format to combine multiple components)"
name (length body)))
(let ((simple-body (car body)))
(cond
;; Non-parameterized: empty arglist - store as (LAYER-NAME nil BODY-FORM)
((null arglist)
`(tp--define-layer-unified ',name nil ,simple-body))
;; Parameterized: one or more argument symbols - store as
;; (LAYER-NAME ARGLIST BODY-FORM)
((cl-every #'symbolp arglist)
`(tp--define-layer-unified ',name ',arglist ',simple-body))
(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.
For parameterized layers, ARGLIST is a list of one or more parameter
symbols and BODY is the unevaluated form.
Stores the layer in `tp-layer-alist' with format:
\(LAYER-NAME ARGLIST BODY-FORM).
For non-parameterized layers, if BODY contains reactive symbols ($-prefixed),
delegates to `tp--define-layer-internal' for proper reactive handling."
(if arglist
;; Parameterized - store for later evaluation
(let ((entry (list arglist body)))
(tp--store-layer-entry name entry t)
(tp--layer-refresh name nil)
(assoc name tp-layer-alist))
;; Non-parameterized - check for reactive symbols
(let ((reactive-syms (tp--collect-reactive-symbols body))
(old-props (when (assoc name tp-layer-alist)
(tp-layer-props name t))))
(if reactive-syms
;; Has reactive symbols - use tp--define-layer-internal for proper handling
(tp--define-layer-internal name body)
;; No reactive symbols - store as static layer
;; Clean up old reactive dependencies if the layer was previously reactive
(tp--unregister-reactive-deps name)
(let ((entry (list nil `',body)))
(tp--store-layer-entry name entry t)
(tp--layer-refresh name old-props)
(assoc name tp-layer-alist))))))
(defun tp--layer-group-element-format (element)
"Determine the format type of ELEMENT.
Returns `symbol', `format-1', `format-2', `format-3', `format-4', or
nil if invalid."
(cond
;; Symbol - reference to existing layer
((symbolp element) 'symbol)
;; Format 4 - ("name" :props (plist...) [:data ...] [:watch ...] [:compute ...])
;; Named layer with :props and optional :data/:watch/:compute
((and (listp element)
(> (length element) 3)
(stringp (car element))
(eq (cadr element) :props)
(listp (caddr element))
;; Must have additional keywords after :props
(let ((rest (cdddr element)))
(and rest (keywordp (car rest)))))
'format-4)
;; Format 3 - ("name" :props (plist...))
((and (listp element)
(= (length element) 3)
(stringp (car element))
(eq (cadr element) :props)
(listp (caddr element)))
'format-3)
;; Format 2 - ("name" . (plist...)) - cons cell with proper list cdr
((and (consp element)
(stringp (car element))
(listp (cdr element))
(not (eq (cadr element) :props))) ; Distinguish from format-3
'format-2)
;; Format 1 - (plist...) - anonymous, must start with a symbol
((and (listp element)
(symbolp (car element)))
'format-1)
(t nil)))
(defun tp--parse-layer-group-element (group-name element idx)
"Parse a layer group element and return (layer-name . properties)
or extended form.
GROUP-NAME is the name of the layer group.
ELEMENT is the element to parse (can be anonymous plist, cons-cell,
or :props form).
IDX is the index for anonymous elements.
Returns a cons cell (LAYER-NAME . PROPERTIES) or a symbol if ELEMENT
references an already-defined layer.
For format-4 elements, returns (LAYER-NAME :props PROPS :data DATA
:watch WATCH :compute COMPUTE :transform TRANSFORM).
Unknown keywords in format-4 elements signal an error."
(let ((format (tp--layer-group-element-format element)))
(pcase format
('symbol element)
('format-4
;; Parse named layer with :props and optional :data/:watch/:compute/:transform
(let* ((layer-suffix (car element))
(layer-name (intern (format "%s-%s" group-name layer-suffix)))
(rest (cdr element))
(props nil)
(data nil)
(watch nil)
(compute nil)
(transform nil))
;; Parse keyword arguments
(while rest
(pcase (car rest)
(:props (setq props (cadr rest) rest (cddr rest)))
(:data (setq data (cadr rest) rest (cddr rest)))
(:watch (setq watch (cadr rest) rest (cddr rest)))
(:compute (setq compute (cadr rest) rest (cddr rest)))
(:transform (setq transform (cadr rest) rest (cddr rest)))
(unknown
(error "Unknown keyword %S in layer group element: %S"
unknown element))))
(list layer-name :props props :data data :watch watch
:compute compute :transform transform)))
('format-3
(let* ((layer-suffix (car element))
(layer-name (intern (format "%s-%s" group-name layer-suffix)))
(props (caddr element)))
(cons layer-name props)))
('format-2
(let* ((layer-suffix (car element))
(layer-name (intern (format "%s-%s" group-name layer-suffix)))
(props (cdr element)))
(cons layer-name props)))
('format-1
(let ((layer-name (intern (format "%s-%d" group-name idx))))
(cons layer-name element)))
(_ (error "Invalid layer group element: %S" element)))))
(defun tp--define-layer-from-parsed (layer-name props data watch compute &optional transform)
"Internal helper to define a layer from parsed components.
LAYER-NAME is the symbol name for the layer.
PROPS is the property list.
DATA is the list of data variables.
WATCH is the list of watcher definitions.
COMPUTE is the list of computed variable definitions.
TRANSFORM, if non-nil, is registered in `tp-layer-transforms';
when nil, any previously registered transform for LAYER-NAME is
removed (mirroring `tp--define-layer-internal')."
(let ((old-props (when (assoc layer-name tp-layer-alist)
(tp-layer-props layer-name t))))
;; Register or unregister transform function
(if transform
(if (assoc layer-name tp-layer-transforms)
(setcdr (assoc layer-name tp-layer-transforms) transform)
(push (cons layer-name transform) tp-layer-transforms))
(setq tp-layer-transforms
(assq-delete-all layer-name tp-layer-transforms)))
(let* ((reactive-syms (tp--collect-reactive-symbols props))
(computed-vars (when compute (mapcar #'car compute)))
(all-reactive-syms (delete-dups reactive-syms))
(props-vars (mapcar #'tp--reactive-var-symbol reactive-syms))
(all-vars-to-define
(delete-dups (append data props-vars computed-vars))))
(if (or all-reactive-syms data compute)
(progn
(tp--unregister-reactive-deps layer-name)
(tp--ensure-reactive-variables all-vars-to-define)
(when data
(tp--register-layer-data layer-name data))
(when compute
(tp--register-layer-computed layer-name compute)
(tp--apply-initial-computed compute))
(tp--register-reactive-deps layer-name all-reactive-syms props)
(when watch
(tp--register-layer-watchers layer-name watch))
(tp--set-layer-props
layer-name (tp--resolve-reactive-symbols props))
(tp--bump-layer-definition-version layer-name)
(tp--layer-refresh layer-name old-props))
(tp--unregister-reactive-deps layer-name)
(tp--set-layer-props layer-name props)
(tp--bump-layer-definition-version layer-name)
(tp--layer-refresh layer-name old-props))
layer-name)))
(defun tp--define-layer-internal-group (name &rest elements)
"Define a layer group named NAME containing multiple layers.
This function accepts a list of layer definitions in ELEMENTS.
Each element in ELEMENTS should be one of:
- A symbol: reference to an existing layer
- A plist: anonymous layer (named as NAME-0, NAME-1, etc.)
- A cons cell (\"suffix\" . plist): named layer (named as NAME-suffix)
- A list (\"suffix\" :props plist [:data data] [:watch watch] [:compute compute]):
named layer with reactive features
All property lists should be evaluated (quoted in the call).
Example:
(tp--define-layer-internal-group \\='my-group
\\='existing-layer
\\='(face bold)
\\='(\"named\" . (face italic))
\\='(\"reactive\" :props (face (:foreground $color))
:data ((color . \"red\"))))
If a layer group with the same NAME already exists, it will be overwritten.
Individual layers created by the group are stored in `tp-layer-alist',
and the group itself is stored in `tp-layer-groups'."
(declare (indent defun))
(let ((layer-names nil)
(generated nil)
(idx 0))
(dolist (element elements)
(let ((parsed (tp--parse-layer-group-element name element idx)))
(cond
;; Reference to existing layer (symbol)
((symbolp parsed)
(push parsed layer-names))
;; Extended format with :data/:watch/:compute/:transform (format-4)
((and (listp parsed) (plist-get (cdr parsed) :props))
(let* ((layer-name (car parsed))
(props (plist-get (cdr parsed) :props))
(data (plist-get (cdr parsed) :data))
(watch (plist-get (cdr parsed) :watch))
(compute (plist-get (cdr parsed) :compute))
(transform (plist-get (cdr parsed) :transform)))
(tp--define-layer-from-parsed layer-name props data watch compute transform)
(push layer-name layer-names)
(push layer-name generated)))
;; Simple format (cons cell of name . props)
((consp parsed)
(let* ((layer-name (car parsed))
(props (cdr parsed)))
(tp--define-layer-from-parsed layer-name props nil nil nil)
(push layer-name layer-names)
(push layer-name generated)
;; Only increment idx for anonymous (Format 1) elements
(when (eq (tp--layer-group-element-format element) 'format-1)
(cl-incf idx)))))))
(setq layer-names (nreverse layer-names))
(setq generated (nreverse generated))
;; Undefine layers generated by a previous definition of this group
;; that are no longer part of it, so redefinition does not orphan them.
(let ((old-generated (cdr (assq name tp--group-generated-layers))))
(dolist (stale (cl-set-difference old-generated generated))
(tp-undefine-layer stale)))
(setf (alist-get name tp--group-generated-layers) generated)
(tp--set-group-layers name layer-names)
(assoc name tp-layer-groups)))
(defun tp--define-layer-group-internal (name arglist elements)
"Internal function for define-tps with ARGLIST and ELEMENTS.
NAME is the group name symbol.
ARGLIST is nil for non-parameterized groups, or a list with one symbol.
ELEMENTS is the list of layer definitions."
(if arglist
;; Parameterized group - store for later evaluation
(let ((entry (list arglist elements)))
(if (assoc name tp-layer-groups)
(setf (cdr (assoc name tp-layer-groups)) entry)
(push (cons name entry) tp-layer-groups))
(assoc name tp-layer-groups))
;; Non-parameterized - define immediately using tp--define-layer-internal-group
(apply #'tp--define-layer-internal-group name elements)))
(defun tp--define-layer-group-unified (name arglist body-form)
"Define a parameterized layer group NAME with ARGLIST and BODY-FORM.
Stores the group in `tp-layer-groups' with format:
\(GROUP-NAME ARGLIST BODY-FORM).
Layers generated by a previous non-parameterized definition of NAME
are undefined, since a parameterized group generates none."
(dolist (stale (cdr (assq name tp--group-generated-layers)))
(tp-undefine-layer stale))
(setq tp--group-generated-layers
(assq-delete-all name tp--group-generated-layers))
(let ((entry (list arglist body-form)))
(if (assoc name tp-layer-groups)
(setf (cdr (assoc name tp-layer-groups)) entry)
(push (cons name entry) tp-layer-groups)))
(assoc name tp-layer-groups))
;;;###autoload
(defmacro define-tps (name arglist &rest body)
"Define a text property group named NAME.
This macro defines a group of text properties (layers) that can be
used together.
It follows the same format as `define-tp' for consistency.
ARGLIST must be either:
- An empty list () for non-parameterized groups
- A list of one or more parameter symbols for parameterized groups
BODY contains the layer definitions, which should be quoted lists.
Format 1 - Non-parameterized (empty arglist):
(define-tps my-moon-phases ()
\\='(display \"🌑\")
\\='(display \"🌕\"))
Format 2 - Parameterized (with one or more arguments):
(define-tps my-status (color)
\\=`((face (:foreground ,color)))
\\='(face (:weight bold)))
Supported formats for each element in BODY:
Format 1 - Existing layer reference:
\\='existing-layer-name
Format 2 - Anonymous layer (named as NAME-0, NAME-1, etc.):
\\='(display \"🌑\" face (:height 1.0))
Format 3 - Named layer with cons-cell (named as NAME-suffix):
\\='(\"新月\" . (display \"🌑\" face (:height 1.0)))
Format 4 - Named layer with :props keyword (named as NAME-suffix):
\\='(\"新月\" :props (display \"🌑\" face (:height 1.0)))
Format 5 - Named layer with :props, :data, :watch, and/or :compute:
\\='(\"reactive\" :props (face (:foreground $my-color))
:data ((my-color . \"red\"))
:watch ((my-color (lambda (new old layer)
(message \"Changed!\")))))
Note: NAME cannot be a built-in Emacs text property name like `face',
`display', `invisible', etc. See `tp--builtin-text-properties' for the
complete list of reserved names."
(declare (indent defun))
(unless (listp arglist)
(error "define-tps ARGLIST must be a list"))
;; Check for built-in text property name conflict
(when (tp--builtin-text-property-p name)
(error "define-tps: '%s' is a built-in Emacs text property name and cannot be used as a group name" name))
(cond
;; Non-parameterized: empty arglist
((null arglist)
`(tp--define-layer-group-internal ',name nil (list ,@body)))
;; Parameterized: one or more argument symbols
((cl-every #'symbolp arglist)
`(tp--define-layer-group-unified ',name ',arglist '(list ,@body)))
(t
(error "define-tps ARGLIST must be empty or a list of symbols"))))
;; For backward compatibility, keep define-tp-group as an alias
(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.
Stores as (LAYER-NAME . PROPERTIES) for backward compatibility with
reactive layers.
This is an internal function used by layer definition macros and
reactive updates."
(tp--store-layer-entry layer-name properties))
(defun tp--set-group-layers (group-name layer-names)
"Set LAYER-NAMES for group GROUP-NAME in `tp-layer-groups'.
If the group already exists, updates its layer list; otherwise creates it.
This is an internal function used by group definition macros."
(if (assoc group-name tp-layer-groups)
(setf (cdr (assoc group-name tp-layer-groups)) layer-names)
(push (cons group-name layer-names) tp-layer-groups)))
(defun tp-layer-props (layer-name &optional include-tp-name)
"Return properties for layer LAYER-NAME from `tp-layer-alist'.
If INCLUDE-TP-NAME is non-nil, appends `tp-name' property to identify
the layer.
Also includes tp-name automatically if the layer has reactive
dependencies registered.
Handles two storage formats:
1. Old format (from tp--set-layer-props): (LAYER-NAME . PLIST) - flat plist
2. Unified format (from define-tp): (LAYER-NAME ARGLIST BODY-FORM)
For parameterized layers (ARGLIST non-nil), returns nil - use
`tp-layer-props-with-arg'.
Recursively expands any nested layer names in the returned plist.
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."
(when-let ((entry (cdr (assoc layer-name tp-layer-alist))))
(tp--check-layer-cycle layer-name)
;; Auto-include tp-name for layers with reactive deps
(let ((tp--layer-expansion-stack (cons layer-name tp--layer-expansion-stack))
(needs-tp-name (or include-tp-name
(tp--layer-has-reactive-deps-p layer-name))))
(copy-tree
(cond
;; Unified format: entry is (ARGLIST BODY-FORM) where first elem is nil or a list
;; Check: exactly 2 elements and first is nil or a list of symbols
((and (= (length entry) 2)
(or (null (car entry))
(and (listp (car entry))
(cl-every #'symbolp (car entry)))))
(let ((arglist (car entry))
(body (cadr entry)))
(if arglist
;; Parameterized - needs argument, return nil
nil
;; Non-parameterized - evaluate body and return props
(let ((plist (eval body)))
(when plist
;; Recursively expand nested layer names
(when (tp--plist-has-layer-key-p plist)
(setq plist (tp--expand-layer-in-plist plist)))
(if needs-tp-name
(append plist (list 'tp-name layer-name))
plist))))))
;; Old format: entry is just a flat plist
(t
(let ((plist entry))
;; Recursively expand nested layer names
(when (tp--plist-has-layer-key-p plist)
(setq plist (tp--expand-layer-in-plist plist)))
(if needs-tp-name
(append plist (list 'tp-name layer-name))
plist))))))))
(defun tp-layer-parameterized-p (layer-name)
"Return non-nil if LAYER-NAME is a parameterized layer.
Parameterized layers are stored in unified format (LAYER-NAME ARGLIST BODY-FORM)
where ARGLIST is a non-nil list of argument symbols."
(when-let ((entry (cdr (assoc layer-name tp-layer-alist))))
;; Unified format: entry is (ARGLIST BODY-FORM) with exactly 2 elements
;; and first element is a non-nil list of symbols
(and (= (length entry) 2)
(listp (car entry))
(not (null (car entry)))
(cl-every #'symbolp (car entry)))))
(defun tp-layer-arglist (layer-name)
"Return the parameter list of parameterized layer LAYER-NAME.
Returns nil when LAYER-NAME is not a parameterized layer (including
non-parameterized and undefined layers). The returned list is a copy
of the ARGLIST given to `define-tp', e.g. (fg bg) for a
two-parameter layer."
(when (tp-layer-parameterized-p layer-name)
(copy-sequence (car (cdr (assoc layer-name tp-layer-alist))))))
(defun tp-layer-props-with-args (layer-name args &optional include-tp-name)
"Return properties for parameterized layer LAYER-NAME with ARGS.
ARGS is a list of argument values bound positionally (via `cl-progv',
so dynamically) to the layer's parameters while the stored body form
is evaluated. Extra values are ignored; passing fewer values than
the layer has parameters signals a wrong-arity error (since Emacs 27
`cl-progv' silently binds missing parameters to nil, so the arity is
checked explicitly here).
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.
$-prefixed reactive symbols in the body are resolved to the current
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.
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))
(body (cadr entry)))
(when (< (length args) (length arglist))
(error "tp layer %s takes %d argument(s), got %d"
layer-name (length arglist) (length args)))
(tp--check-layer-cycle layer-name)
(let* ((tp--layer-expansion-stack
(cons layer-name tp--layer-expansion-stack))
;; Evaluate the body with all parameters bound. `eval'
;; without a lexical environment sees the dynamic
;; bindings established by `cl-progv'.
(plist (cl-progv arglist args (eval body))))
(when plist
;; Recursively expand nested layer names
(when (tp--plist-has-layer-key-p plist)
(setq plist (tp--expand-layer-in-plist plist)))
;; Resolve $-prefixed reactive symbols to their current values
;; so they never leak literally into the returned props.
(when (tp--collect-reactive-symbols plist)
(setq plist (tp--resolve-reactive-symbols plist)))
(copy-tree
(if include-tp-name
(append plist (list 'tp-name layer-name))
plist)))))))
(defun tp-layer-props-with-arg (layer-name arg &optional include-tp-name)
"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' - 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.
$-prefixed reactive symbols in the body are resolved to the current
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.
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)
"Return props for parameterized LAYER-NAME given a stored VALUE.
When LAYER-NAME takes more than one parameter and VALUE is a proper
list, VALUE is treated as the full argument list (as stored by the
plist-style spec (LAYER-NAME (ARG1 ARG2 ...))); otherwise VALUE is
the single argument (the single-parameter behavior).
INCLUDE-TP-NAME is passed through."
(if (and (proper-list-p value)
(> (length (tp-layer-arglist layer-name)) 1))
(tp-layer-props-with-args layer-name value include-tp-name)
(tp-layer-props-with-arg layer-name value include-tp-name)))
(defun tp-group-props (group-name &optional include-tp-name)
"Return list of properties for all layers in GROUP-NAME.
If INCLUDE-TP-NAME is non-nil, each layer's props will include tp-name.
Handles both old format (list of layer names) and new unified format
from `define-tps` (parameterized groups store ARGLIST and BODY-FORM)."
(when-let ((entry (cdr (assoc group-name tp-layer-groups))))
;; Check if it's the unified format from define-tps (ARGLIST BODY-FORM)
;; Unified format: (ARGLIST BODY-FORM) where ARGLIST is a list of symbols or nil
;; Old format: (layer1 layer2 ...) where each element is a symbol referring to a layer
(cond
;; Unified parameterized format: (ARGLIST BODY-FORM) with non-nil ARGLIST
((and (= (length entry) 2)
(listp (car entry))
(not (null (car entry)))
(cl-every #'symbolp (car entry)))
;; Parameterized group - can't get props without argument
nil)
;; Old format or non-parameterized define-tps: list of layer names
(t
(mapcar (lambda (layer)
(tp-layer-props layer include-tp-name))
entry)))))
(defun tp-group-parameterized-p (group-name)
"Return non-nil if GROUP-NAME is a parameterized group.
Parameterized groups are stored in format (GROUP-NAME ARGLIST BODY-FORM)
where ARGLIST is a non-nil list of argument symbols."
(when-let ((entry (cdr (assoc group-name tp-layer-groups))))
;; Check for unified format: (ARGLIST BODY-FORM) with non-nil ARGLIST
(and (= (length entry) 2)
(listp (car entry))
(not (null (car entry)))
(cl-every #'symbolp (car entry)))))
(defun tp--group-arglist (group-name)
"Return the parameter list of parameterized group GROUP-NAME.
Returns nil when GROUP-NAME is not a parameterized group. The
returned list is a copy of the ARGLIST given to `define-tps'."
(when (tp-group-parameterized-p group-name)
(copy-sequence (car (cdr (assoc group-name tp-layer-groups))))))
(defun tp--group-anonymous-props (plist)
"Normalize anonymous-layer PLIST from a parameterized group element.
Expands nested layer names, resolves $-prefixed reactive symbols to
their current values, and returns a fresh copy safe for caller
mutation. Returns nil if PLIST is nil."
(when plist
(let ((props plist))
(when (tp--plist-has-layer-key-p props)
(setq props (tp--expand-layer-in-plist props)))
(when (tp--collect-reactive-symbols props)
(setq props (tp--resolve-reactive-symbols props)))
(copy-tree props))))
(defun tp--group-spec-to-props (spec include-tp-name)
"Convert one evaluated parameterized-group element SPEC to a props plist.
SPEC may be:
- a symbol naming a defined layer;
- a list (LAYER-NAME ARG ...) whose head is a defined layer or group;
- a cons (\"NAME\" . PLIST) or a list (\"NAME\" :props PLIST);
- a raw property list (anonymous layer), optionally wrapped in one
extra set of parentheses as in the `define-tps' docstring example.
INCLUDE-TP-NAME is passed through for named layer references;
anonymous plists have no name, so it does not apply to them.
Returns nil if SPEC cannot be interpreted."
(cond
;; Layer name symbol
((symbolp spec)
(tp-layer-props spec include-tp-name))
((not (consp spec)) nil)
;; (LAYER-NAME ARG ...) - defined layer at the head
((and (symbolp (car spec)) (tp--is-layer-name-p (car spec)))
(let ((layer-name (car spec)))
(if (tp-layer-parameterized-p layer-name)
;; Bind as many arguments as the layer has parameters.
(tp-layer-props-with-args
layer-name
(-take (length (tp-layer-arglist layer-name)) (cdr spec))
include-tp-name)
;; Non-parameterized layer - arg should be t or ignored
(tp-layer-props layer-name include-tp-name))))
;; ("NAME" :props PLIST) or ("NAME" . PLIST) - use the props part
((stringp (car spec))
(tp--group-anonymous-props
(if (eq (cadr spec) :props)
(caddr spec)
(cdr spec))))
;; One extra level of wrapping, e.g. ((face (:foreground "red")))
((and (consp (car spec)) (null (cdr spec)))
(tp--group-spec-to-props (car spec) include-tp-name))
;; Raw plist - anonymous layer
((symbolp (car spec))
(tp--group-anonymous-props spec))
(t nil)))
(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 (via `cl-progv',
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.
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))
(body-form (cadr entry))
;; Evaluate the body with all parameters bound - returns
;; list of layer specs.
(layer-specs (cl-progv arglist args (eval body-form))))
;; Convert layer specs to property lists
(mapcar (lambda (spec)
(tp--group-spec-to-props spec include-tp-name))
layer-specs))))
(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
`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.
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
list, VALUE is treated as the full argument list (as stored by the
plist-style spec (GROUP-NAME (ARG1 ARG2 ...))); otherwise VALUE is
the single argument (the single-parameter behavior).
INCLUDE-TP-NAME is passed through."
(if (and (proper-list-p value)
(> (length (tp--group-arglist group-name)) 1))
(tp--group-props-with-args group-name value include-tp-name)
(tp-group-props-with-arg group-name value include-tp-name)))
(defun tp--is-layer-name-p (sym)
"Return non-nil if SYM is a defined layer, parameterized layer, or group name."
(and (symbolp sym)
(or (assoc sym tp-layer-alist)
(assoc sym tp-layer-groups))))
(defun tp--plist-has-layer-key-p (plist)
"Return non-nil if PLIST contains any layer names as keys."
(cl-loop for (key _val) on plist by #'cddr
thereis (tp--is-layer-name-p key)))
(defun tp--expand-layer-in-plist (props)
"Expand any layer names found in PROPS plist.
Scans through PROPS treating it as a plist (key value pairs).
When a key is a layer/group name, expands it with its properties.
Recursively expands until no more layer names are found in the result.
Does NOT add tp-name - this is for direct property setting (tp-set/add/reset).
Returns the expanded plist."
(let ((result nil)
(remaining props))
(while remaining
(let ((key (car remaining))
(val (cadr remaining)))
(cond
;; Key is a layer/parameterized layer/group name - expand it
((tp--is-layer-name-p key)
(let ((layer-props
(cond
;; Parameterized layer - evaluate with the argument (val);
;; for multi-parameter layers a list VAL carries all args
((tp-layer-parameterized-p key)
(tp--layer-props-for-arg-value key val nil)) ; no tp-name
;; Non-parameterized layer - val should be t
((assoc key tp-layer-alist)
(tp-layer-props key nil)) ; no tp-name
;; Parameterized layer group - evaluate with the argument (val);
;; for multi-parameter groups a list VAL carries all args
((tp-group-parameterized-p key)
(when-let ((layer-props-list
(tp--group-props-for-arg-value key val t)))
;; Build layered structure: first layer at top, rest in tp-layers
(tp--build-layer-props layer-props-list)))
;; Non-parameterized layer group - build layered structure
((assoc key tp-layer-groups)
(when-let ((layer-props-list (tp-group-props key t)))
;; Build layered structure: first layer at top, rest in tp-layers
(tp--build-layer-props layer-props-list))))))
(when layer-props
;; Recursively expand if the layer props contain more layer names
(when (tp--plist-has-layer-key-p layer-props)
(setq layer-props (tp--expand-layer-in-plist layer-props)))
(setq result (append result layer-props)))))
;; Regular property - keep as-is
(t
(setq result (append result (list key val)))))
(setq remaining (cddr remaining))))
;; Merge duplicate keys in the expanded result
;; Use (cdddr result) for O(1) check - need at least 4 elements (2 key-value pairs) for possible duplicates
(if (cdddr result)
(tp--merge-duplicate-keys result)
result)))
(defun tp--strip-trailing-plist-nil (plist)
"Remove a lone trailing nil from odd-length PLIST.
`tp--merge-duplicate-keys' pads an odd-length property spec (a flat
\(LAYER ARG1 ARG2 EXTRA-PROP VAL) call for a multi-parameter layer)
with a trailing nil value; strip it so the extra properties form a
proper plist again."
(if (and plist
(cl-oddp (length plist))
(null (car (last plist))))
(butlast plist)
plist))
(defun tp--resolve-props (props)
"Resolve PROPS to a property list with layer metadata.
PROPS can be:
- A symbol (layer name from `tp-layer-alist' or group name from
`tp-layer-groups')
- 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
- For multi-parameter layers/groups, (LAYER-NAME ARG1 ARG2 ...
EXTRA-PROPS...) binds as many leading elements as the layer has
parameters; alternatively (LAYER-NAME (ARG1 ARG2 ...) EXTRA-PROPS...)
passes all arguments as one list (recognized when the list's length
equals the layer's parameter count and the remaining elements form
an even-length plist)
- A plist with layer names at any position - they will be expanded inline
- A plist (handles anonymous layers with reactive variables)
If PROPS is a symbol:
- First checks `tp-layer-alist' and expands the layer properties
WITHOUT `tp-name' for direct property setting
- Then checks `tp-layer-groups' and returns properties WITH `tp-layers'
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 the argument(s)
and returns the result
- Extra properties after the argument(s) are appended to the layer
properties
If PROPS is a plist with layer names at any position:
- Layer names are expanded inline with their properties
- Other properties are preserved in order
If PROPS is a plist:
- If it contains reactive variables ($...), generates a UUID for `tp-name',
registers reactive dependencies, and returns the resolved props
with `tp-name'.
If the plist already has a `tp-name', uses that instead of
generating a new one.
- If no reactive variables, returns props as-is (no tp-name added).
Returns nil if PROPS is a symbol but no matching layer/group is found.
Reactive anonymous properties retain `tp-name' so they can be
updated. Plain layer names used through direct property APIs do not;
use stack APIs for a managed mount. Group names include `tp-layers'
with the full layer stack."
(cond
;; Already a plist - check for reactive variables and add tp-name
((listp props)
(let ((first-elem (car-safe props))
(second-elem (cadr props)))
(cond
;; Handle (layer-name arg ...) format for defined layers at the START
;; This includes both (layer-name arg) and (layer-name arg extra-prop val ...)
((and (>= (length props) 2)
(tp--is-layer-name-p first-elem))
(let* ((arity (cond ((tp-layer-parameterized-p first-elem)
(length (tp-layer-arglist first-elem)))
((tp-group-parameterized-p first-elem)
(length (tp--group-arglist first-elem)))
;; Non-parameterized: one slot is consumed
;; by the conventional `t' argument.
(t 1)))
;; Plist-style multi-arg spec (LAYER (ARG1 ... ARGN)
;; EXTRA...): the element after the name carries all
;; arguments when it is a list of exactly ARITY values
;; and the remaining elements form an even-length plist.
(wrapped-args (and (> arity 1)
(proper-list-p second-elem)
(= (length second-elem) arity)
(cl-evenp (length (cddr props)))))
(args (if wrapped-args
second-elem
(-take arity (cdr props))))
(extra-props (if wrapped-args
(cddr props)
(tp--strip-trailing-plist-nil
(-drop arity (cdr props)))))
;; ARG-1: wrong-arity parameterized calls must signal
;; clearly instead of nil-binding missing parameters or
;; applying excess positional args as garbage property
;; keys.
(kind (cond ((tp-layer-parameterized-p first-elem) "layer")
((tp-group-parameterized-p first-elem) "group")))
(_arity-check
(when kind
(when (< (length args) arity)
(error "tp %s %s takes %d argument(s), got %d"
kind first-elem arity (length args)))
(when (and (not wrapped-args)
extra-props
(not (symbolp (car extra-props))))
(error "tp %s %s takes %d argument(s); excess argument %S is not a property key"
kind first-elem arity (car extra-props)))))
(layer-props
(cond
;; Parameterized layer - evaluate with the argument(s)
((tp-layer-parameterized-p first-elem)
(tp-layer-props-with-args first-elem args nil)) ; no tp-name
;; 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 nil)) ; no tp-name
;; Parameterized layer group - evaluate with the argument(s)
((tp-group-parameterized-p first-elem)
(when-let ((layer-props-list
(tp--group-props-with-args first-elem args t)))
;; Build layered structure: first layer at top, rest in tp-layers
(tp--build-layer-props layer-props-list)))
;; Non-parameterized layer group - build layered structure
((assoc first-elem tp-layer-groups)
(when-let ((layer-props-list (tp-group-props first-elem t)))
;; Build layered structure: first layer at top, rest in tp-layers
(tp--build-layer-props layer-props-list))))))
;; Recursively resolve extra properties (they may also contain layer names)
(let ((expanded-props
(if (and layer-props extra-props)
(let* ((resolved-extra (tp--expand-layer-in-plist extra-props))
(combined (append layer-props resolved-extra)))
;; Merge duplicate keys after combining layer props with extra props
;; Need at least 4 elements (2 key-value pairs) for possible duplicates
(if (cdddr combined)
(tp--merge-duplicate-keys combined)
combined))
layer-props)))
;; After expansion, check for reactive symbols in the merged props
;; (original props may contain $vars that need reactive tracking)
(let ((reactive-syms (tp--collect-reactive-symbols props)))
(if reactive-syms
;; Has reactive symbols - need anonymous tp-name for reactive tracking
(let* ((existing-tp-name (plist-get props 'tp-name))
(layer-name (or existing-tp-name
(tp--anonymous-layer-name-for props)))
;; Resolve reactive symbols in expanded props
(resolved-props (tp--resolve-reactive-symbols expanded-props)))
;; Register reactive dependencies
(tp--set-layer-props layer-name resolved-props)
(tp--register-reactive-deps layer-name reactive-syms props)
(append resolved-props (list 'tp-name layer-name)))
;; No reactive symbols - return expanded props as-is (no tp-name)
expanded-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)
;; which produces props = (layer-name) in tp--parse-args.
((and (= (length props) 1)
(symbolp first-elem)
(or (assoc first-elem tp-layer-alist)
(assoc first-elem tp-layer-groups)))
;; It's a layer/group name wrapped in a list - recurse with the symbol
(tp--resolve-props first-elem))
;; Check if any key in the plist is a layer name (layer at any position)
((cl-some #'tp--is-layer-name-p
(cl-loop for (key _val) on props by #'cddr collect key))
;; Expand all layer names in the plist
(let ((expanded-props (tp--expand-layer-in-plist props)))
;; After expansion, check for reactive symbols in the original props
;; (they may contain $vars that need reactive tracking)
(let ((reactive-syms (tp--collect-reactive-symbols props)))
(if reactive-syms
;; Has reactive symbols - need anonymous tp-name for reactive tracking
(let* ((existing-tp-name (plist-get props 'tp-name))
(layer-name (or existing-tp-name
(tp--anonymous-layer-name-for props)))
;; Resolve reactive symbols in expanded props
(resolved-props (tp--resolve-reactive-symbols expanded-props)))
;; Register reactive dependencies
(tp--set-layer-props layer-name resolved-props)
(tp--register-reactive-deps layer-name reactive-syms props)
(append resolved-props (list 'tp-name layer-name)))
;; No reactive symbols - return expanded props as-is (no tp-name)
expanded-props))))
;; Normal plist processing
(t
(let* ((existing-tp-name (plist-get props 'tp-name))
(reactive-syms (tp--collect-reactive-symbols props)))
(if reactive-syms
;; Has reactive symbols - need to handle as anonymous reactive layer
(let* ((layer-name (or existing-tp-name
(tp--anonymous-layer-name-for props)))
;; Resolve reactive symbols to get current values
(resolved-props (tp--resolve-reactive-symbols props)))
;; Register this anonymous layer in tp-layer-alist with resolved props
(tp--set-layer-props layer-name resolved-props)
;; Register reactive dependencies with the original props
(tp--register-reactive-deps layer-name reactive-syms props)
;; Return resolved props with tp-name for reactive tracking
(append resolved-props (list 'tp-name layer-name)))
;; No reactive symbols - return props as-is (no tp-name needed)
;; This preserves the native text property behavior for non-reactive plists
props))))))
;; Symbol - check if it's a layer or group name
((symbolp props)
(cond
;; Parameterized layer without argument - cannot resolve, return nil
((tp-layer-parameterized-p props)
nil)
;; Check layer - get props without tp-name for direct property setting
((assoc props tp-layer-alist)
(tp-layer-props props nil)) ; no tp-name
;; Check group - build layered structure with tp-layers
((assoc props tp-layer-groups)
(when-let ((layer-props-list (tp-group-props props t))) ; include tp-name
;; Build layered structure: first layer at top, rest in tp-layers
(tp--build-layer-props layer-props-list)))
;; Parameterized group without argument - cannot resolve, return nil
((tp-group-parameterized-p props)
nil)
;; Not found - return nil (let caller decide how to handle)
(t nil)))
(t nil)))
(defun tp--ensure-props (plist)
"Ensure PLIST is a property list, resolving layer names and
handling reactive vars.
If PLIST is a symbol, resolve it via `tp--resolve-props'.
If PLIST is a plist, also process it via `tp--resolve-props' to handle
anonymous reactive layers.
If resolution fails, return PLIST unchanged (for backward compatibility)."
(or (tp--resolve-props plist) plist))
;;;###autoload
(defun tp-layer-reset ()
"Reset all layer definitions.
Clears both `tp-layer-alist' and `tp-layer-groups'.
Also resets all reactive text property watchers, dependencies, and transforms."
(interactive)
(tp-reactive-reset)
(setq tp-layer-alist nil)
(setq tp-layer-groups nil)
(setq tp--layer-definition-counter 0)
(setq tp--layer-definition-versions nil)
(setq tp--managed-entry-counter 0)
(setq tp-layer-transforms nil)
(setq tp--group-generated-layers nil)
(setq tp--anonymous-layer-registry nil))
(defun tp-undefine-layer (name)
"Remove layer NAME from `tp-layer-alist'.
Also unregisters any reactive dependencies and transforms for this layer,
and drops any anonymous-layer registry entries interned for it."
(tp--unregister-reactive-deps name)
(setq tp-layer-alist (assq-delete-all name tp-layer-alist))
(setq tp--layer-definition-versions
(assq-delete-all name tp--layer-definition-versions))
(setq tp-layer-transforms (assq-delete-all name tp-layer-transforms))
(setq tp--anonymous-layer-registry
(cl-remove-if (lambda (cell) (eq (cdr cell) name))
tp--anonymous-layer-registry)))
(defun tp-undefine-group (name)
"Remove layer group NAME from `tp-layer-groups'.
Also undefines the layers that the group definition itself generated
(anonymous and named elements), including their reactive dependencies
and transforms. Layers merely referenced by the group are left
untouched."
(dolist (generated (cdr (assq name tp--group-generated-layers)))
(tp-undefine-layer generated))
(setq tp--group-generated-layers
(assq-delete-all name tp--group-generated-layers))
(setq tp-layer-groups (assq-delete-all name tp-layer-groups)))
(defun tp--managed-entry-meta (name origin spec args arglist)
"Build managed metadata for NAME with ORIGIN, SPEC, ARGS and ARGLIST."
(list :schema 1
:entry-id (tp--next-managed-entry-id)
:origin origin
:spec (copy-tree spec)
:args (copy-tree args)
:arglist (copy-tree arglist)
:definition-version (tp--layer-definition-version name)
:entry-version 1
:mode 'exclusive
:palette-deps nil
:palette-generation (if (boundp 'tp-theme-generation)
tp-theme-generation 0)
:legacy-no-args nil))
(defun tp--stamp-managed-entry (props name spec args arglist origin)
"Return PROPS stamped with managed metadata for NAME."
(plist-put (copy-tree props)
'tp-meta
(tp--managed-entry-meta name origin spec args arglist)))
(defun tp--entry-render-projection (props)
"Return rendered PROPS without stack-only bookkeeping."
(let ((result (copy-sequence props)))
(dolist (key '(tp-meta tp-hidden tp-layers))
(cl-remf result key))
result))
(defun tp--entry-authoritative-storage-p (layer-list)
"Return non-nil when LAYER-LIST requires `tp-layers' authority."
(seq-some (lambda (layer)
(or (tp--stack-hidden-p layer)
(plist-member layer 'tp-meta)))
layer-list))
(defun tp--normalize-layer-spec (layer-spec)
"Normalize LAYER-SPEC to a plist with tp-name.
Used by layer stack functions that need tp-name for identification.
LAYER-SPEC can be:
- A symbol (non-parameterized layer name from define-tp or
tp--define-layer-internal)
- A list (LAYER-NAME ARG ...) for parameterized layers from
define-tp, with exactly as many arguments as the layer has
parameters
- A plist for inline layer definition
- A list (NAME &rest PLIST) for named inline layer"
(cond
;; Symbol - look up in tp-layer-alist (non-parameterized layer)
((symbolp layer-spec)
(cond
;; Parameterized layer symbol without arg - error
((tp-layer-parameterized-p layer-spec)
(error "Parameterized layer %S requires an argument, use '(%S arg)"
layer-spec layer-spec))
;; Non-parameterized layer or old-format layer
((assoc layer-spec tp-layer-alist)
(tp--stamp-managed-entry
(or (tp-layer-props layer-spec t)
(error "Layer %S not found in tp-layer-alist" layer-spec))
layer-spec layer-spec nil nil 'defined))
(t (signal 'tp-unresolved-layer (list layer-spec)))))
;; List starting with symbol - check if it's a parameterized layer
((and (listp layer-spec)
(symbolp (car layer-spec))
(not (keywordp (car layer-spec))))
(let ((name (car layer-spec))
(rest (cdr layer-spec)))
(cond
;; Parameterized layer: (LAYER-NAME ARG ...) with exactly as
;; many arguments as the layer has parameters
((and (tp-layer-parameterized-p name)
(= (length rest) (length (tp-layer-arglist name))))
(tp--stamp-managed-entry
(or (tp-layer-props-with-args name rest t)
(error "Failed to resolve parameterized layer %S with args %S"
name rest))
name layer-spec rest (tp-layer-arglist name) 'parameterized))
;; ARG-1: a parameterized layer with the wrong number of
;; arguments must not fall through to the named-inline branch,
;; which would build an odd-length plist and die with the
;; cryptic "Odd length text property list".
((tp-layer-parameterized-p name)
(error "tp layer %s expects %d args, got %d"
name (length (tp-layer-arglist name)) (length rest)))
;; Named inline layer: (NAME &rest PLIST)
(rest
(tp--stamp-managed-entry
(append rest (list 'tp-name name))
name layer-spec nil nil 'inline))
;; Just a symbol in a list - treat as non-parameterized layer
((null rest)
(tp--stamp-managed-entry
(or (tp-layer-props name t)
(signal 'tp-unresolved-layer (list name)))
name layer-spec nil nil 'defined)))))
;; Plist (starts with keyword or property name)
((and (listp layer-spec) layer-spec)
layer-spec)
(t (error "Invalid layer spec: %S" layer-spec))))
(defun tp--get-layer-stack (pos object)
"Get the layer stack at POS in OBJECT as a list.
Returns (TOP-PROPS . BELOW-PROPS-LIST)."
(let* ((props (text-properties-at pos object))
(tp-layers-idx (-elem-index 'tp-layers props))
(top-props (if tp-layers-idx
(-remove-at-indices
(list tp-layers-idx (1+ tp-layers-idx)) props)
props))
(below-props (plist-get props 'tp-layers)))
(cons top-props below-props)))
(defun tp--build-layer-props (layer-list)
"Build text properties from LAYER-LIST.
First element is top layer, rest are in tp-layers."
(if (null layer-list)
nil
(append (car layer-list)
(list 'tp-layers (cdr layer-list)))))
(defun tp--layer-stack-to-list (top belows)
"Convert TOP and BELOWS to a flat list of layers."
(if top
(cons top belows)
belows))
;;; Layer stack storage codec
;;
;; The encoding/decoding of a layer stack into raw text properties
;; lives here, beside `tp--build-layer-props' / `tp--layer-stack-to-list',
;; so both the stack operations (tp-stack.el) and the reactive
;; re-render engine (tp-render.el) can read and write stack storage
;; without duplicating format knowledge or requiring each other.
(defun tp--stack-hidden-p (layer)
"Return non-nil when the layer plist LAYER is flagged hidden.
A layer is hidden when its plist carries a non-nil `tp-hidden' entry;
see `tp-hide-layer'."
(and (plist-get layer 'tp-hidden) t))
(defun tp--plist-equivalent-p (left right)
"Return non-nil when LEFT and RIGHT contain the same plist entries."
(let ((left-proj (tp--entry-render-projection left))
(right-proj (tp--entry-render-projection right)))
(and (cl-loop for (key val) on left-proj by #'cddr
always (and (plist-member right-proj key)
(equal (plist-get right-proj key) val)))
(cl-loop for (key val) on right-proj by #'cddr
always (and (plist-member left-proj key)
(equal (plist-get left-proj key) val))))))
(defun tp--assert-hidden-render-cache (direct stack)
"Signal `tp-layer-conflict' unless DIRECT matches rendered STACK."
(let ((expected (seq-find (lambda (layer)
(not (tp--stack-hidden-p layer)))
stack)))
(unless (tp--plist-equivalent-p direct
(tp--entry-render-projection expected))
(signal 'tp-layer-conflict
(list "Direct properties changed while a layer was hidden"
:actual direct
:expected (tp--entry-render-projection expected))))))
(defun tp--stack-props-to-list (props)
"Return the ordered layer stack stored in raw text properties PROPS.
The result is a list of layer plists, top layer first, including
hidden layers (flagged with a non-nil `tp-hidden' entry) at their
stack position. Returns nil for bare text.
This is the inverse of `tp--stack-build-props': when any entry of the
`tp-layers' bookkeeping property is hidden, that property holds the
whole ordered stack and the direct properties are only a render cache
of the topmost non-hidden layer; otherwise the direct properties are
the top layer and `tp-layers' holds the layers below it.
When full-stack storage is active, an external direct-property edit
cannot be assigned to a managed layer safely. Rather than discard it,
signal `tp-layer-conflict' before decoding or rebuilding the stack."
(let* ((idx (-elem-index 'tp-layers props))
(top (if idx
(-remove-at-indices (list idx (1+ idx)) props)
props))
(belows (plist-get props 'tp-layers)))
(if (tp--entry-authoritative-storage-p belows)
(progn
(tp--assert-hidden-render-cache top belows)
belows)
(tp--layer-stack-to-list top belows))))
(defun tp--stack-build-props (layer-list)
"Build text properties from LAYER-LIST (top layer first).
Like `tp--build-layer-props', but the `tp-layers' entry is only added
when there are below-layers, so single-layer stacks do not carry a
garbage (tp-layers nil) property. Consumers must therefore tolerate
an absent `tp-layers' property (both `plist-get' and
`tp--stack-map-region' do).
When any layer in LAYER-LIST is hidden or carries `tp-meta', the
storage switches to full-stack mode: the direct properties are the
render projection of the topmost non-hidden layer (or no layer
properties at all when every layer is hidden) and the `tp-layers'
property holds the complete ordered LAYER-LIST. `tp--stack-props-to-list'
reverses either representation."
(cond
((null layer-list) nil)
((tp--entry-authoritative-storage-p layer-list)
(append (tp--entry-render-projection
(seq-find (lambda (layer)
(not (tp--stack-hidden-p layer)))
layer-list))
(list 'tp-layers layer-list)))
((null (cdr layer-list)) (copy-sequence (car layer-list)))
(t (append (car layer-list)
(list 'tp-layers (cdr layer-list))))))
(defun tp--describe-layer-data (name)
"Collect description data for layer NAME as a plist.
Returns nil when NAME is not registered in `tp-layer-alist'.
The returned plist has these keys:
:name NAME itself.
:format Storage format: `parameterized' (unified storage with
a non-empty arglist), `reactive' (flat storage with
reactive dependencies registered), `unified' (from
`define-tp' with an empty arglist) or `flat' (old
direct plist storage).
:arglist The parameter list for parameterized layers, else nil.
:body The raw stored body: the unevaluated BODY-FORM for
unified/parameterized layers, the stored plist for
flat/reactive layers.
:props The expanded properties from `tp-layer-props' (with
tp-name), or a placeholder string for parameterized
layers, which need arguments
\(see `tp-layer-props-with-args').
:reactive-deps List of reactive variable symbols NAME depends on,
from tp-reactive's `tp-reactive-deps' registry.
:transform Non-nil when a transform is registered for NAME in
`tp-layer-transforms'.
:group The group that generated NAME (from
`tp--group-generated-layers'), or nil."
(when-let ((entry (cdr (assoc name tp-layer-alist))))
(let* ((parameterized (tp-layer-parameterized-p name))
(reactive (tp--layer-has-reactive-deps-p name))
(unified (and (= (length entry) 2)
(or (null (car entry))
(and (listp (car entry))
(cl-every #'symbolp (car entry))))))
(format (cond (parameterized 'parameterized)
(reactive 'reactive)
(unified 'unified)
(t 'flat)))
(arglist (when parameterized (tp-layer-arglist name)))
(body (if unified (cadr entry) entry))
(props (if parameterized
"parameterized layer: expand with `tp-layer-props-with-args'"
(tp-layer-props name t)))
(deps (cl-loop for dep in tp-reactive-deps
when (assoc name (cdr dep))
collect (car dep)))
(transform (and (assoc name tp-layer-transforms) t))
(group (cl-loop for (group-name . layers)
in tp--group-generated-layers
when (memq name layers)
return group-name)))
(list :name name
:format format
:arglist arglist
:body body
:props props
:reactive-deps deps
:transform transform
:group group))))
;;;###autoload
(defun tp-describe-layer (name)
"Display a help buffer describing the tp layer NAME.
NAME is a layer registered in `tp-layer-alist'. Interactively,
prompt with completion over the registered layers.
The buffer shows the storage format (flat, unified, parameterized or
reactive), the raw stored body, the expanded properties (or a
placeholder for parameterized layers, which need arguments), the
parameter list, the reactive variables the layer depends on, whether
a transform is registered, and the group that generated the layer,
if any."
(interactive
(list (intern (completing-read "Describe tp layer: "
(mapcar #'car tp-layer-alist)
nil t))))
(let ((data (tp--describe-layer-data name)))
(unless data
(user-error "No tp layer named `%s'" name))
(with-help-window (help-buffer)
(princ (format "%s is a tp layer.\n\n" name))
(princ (format "Storage format: %s\n" (plist-get data :format)))
(when (plist-get data :arglist)
(princ (format "Arguments: %S\n" (plist-get data :arglist))))
(princ (format "Stored body: %S\n" (plist-get data :body)))
(let ((props (plist-get data :props)))
(princ (format "Expanded props: %s\n"
(if (stringp props) props (format "%S" props)))))
(princ (format "Reactive deps: %s\n"
(if (plist-get data :reactive-deps)
(mapconcat #'symbol-name
(plist-get data :reactive-deps) ", ")
"none")))
(princ (format "Transform: %s\n"
(if (plist-get data :transform) "yes" "no")))
(when (plist-get data :group)
(princ (format "Generated by: group %s\n"
(plist-get data :group)))))))
(defun tp--get-layer-by-idx-or-name (layers idx-or-name)
"Find layer in LAYERS by IDX-OR-NAME.
Returns (index . layer-props) or nil."
(cond
((integerp idx-or-name)
(let ((actual-idx (if (< idx-or-name 0)
(+ (length layers) idx-or-name)
idx-or-name)))
(when (and (>= actual-idx 0) (< actual-idx (length layers)))
(cons actual-idx (nth actual-idx layers)))))
((symbolp idx-or-name)
(cl-loop for layer in layers
for i from 0
when (equal idx-or-name (plist-get layer 'tp-name))
return (cons i layer)))
(t nil)))
(provide 'tp-layer)
;;; tp-layer.el ends here