tp/tp-layer.el
Kinneyzhang ceb0dfb0bc Fix confirmed bugs in layer, stack, search, and reactive-render modules
35 fixes across tp-layer.el, tp-stack.el, tp-search.el, tp-reactive.el
and tp-render.el, each empirically reproduced before and after:
layer-definition resolution/cycles/copying/cleanup, clipped region-local
stack mutators, symmetric backward search matching, length-changing
replacements, and reactive re-render correctness (replace-not-accumulate,
buffer-local isolation, batching union, per-interval props).

Adds four per-module regression suites (100 new tests); combined suite
is 438/438 green. tp-test-backward updated to the now-symmetric backward
matching contract it previously codified inverted. The string-vs-buffer
shortfall divergence in tp-forward-do/tp-backward-do is documented in
CHANGELOG as a known divergence rather than changed. Adds CHANGELOG.md.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-26 20:01:20 +08:00

1296 lines
60 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)
(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) after a layer is
redefined, so text that already uses the layer picks up the new
definition. When nil, redefinition only updates the registry.")
(defun tp--layer-refresh (layer-name)
"Re-render regions carrying LAYER-NAME via `tp--layer-refresh-function'."
(when tp--layer-refresh-function
(funcall tp--layer-refresh-function layer-name)))
(defvar tp-layer-alist nil
"Alist of layer definitions: (LAYER-NAME . PROPERTIES).")
(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.")
(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)))
(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--expand-layer-to-props-list (layer-name str start)
"Expand LAYER-NAME to a list of property keys it contributes.
If LAYER-NAME is a layer defined in `tp-layer-alist', returns a list
of the property keys that the layer adds, plus 'tp-name.
STR and START are used to get the argument value for parameterized layers.
For non-layer symbols, returns a list containing just that symbol."
(if (tp--is-layer-name-p layer-name)
(let* ((existing-props (text-properties-at start str))
(existing-tp-name (plist-get existing-props 'tp-name))
(layer-prop-value (plist-get existing-props layer-name))
;; Proceed if tp-name matches OR if the layer property exists
;; (for cases where layer was used in mixed syntax without tp-name)
(layer-props
(cond
;; tp-name matches - traditional layer application
((eq existing-tp-name layer-name)
(cond
;; Parameterized layer - get property keys it would produce
;; We pass a dummy arg (t) since we only need the key names, not values
((tp-layer-parameterized-p layer-name)
(tp-layer-props-with-arg layer-name t nil)) ; arg=t, include-tp-name=nil
;; Non-parameterized layer
((assoc layer-name tp-layer-alist)
(tp-layer-props layer-name nil)) ; include-tp-name=nil
;; Layer group
((assoc layer-name tp-layer-groups)
(when-let ((layer-props-list (tp-group-props layer-name t)))
(tp--build-layer-props layer-props-list)))))
;; Layer property exists (mixed syntax like `tp-set str 'face 'bold 'layer arg`)
;; In this case, the layer's face properties are merged into face
(layer-prop-value
(cond
((tp-layer-parameterized-p layer-name)
(tp-layer-props-with-arg 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))))))))
(if layer-props
;; Return all property keys from the layer plus tp-name and the layer itself
(let ((keys (cl-loop for (key _val) on layer-props by #'cddr
collect key)))
(unless (memq 'tp-name keys)
(push 'tp-name keys))
(unless (memq layer-name keys)
(push layer-name keys))
keys)
;; Layer name doesn't match tp-name and layer property doesn't exist
;; Just remove the literal symbol
(list layer-name)))
;; Not a layer name, just return the symbol itself
(list layer-name)))
(defun tp--expand-props-to-remove (props-to-remove str start)
"Expand PROPS-TO-REMOVE list, expanding any layer names to their property keys.
STR and START are used to determine context for parameterized layers."
(let ((result nil))
(dolist (prop props-to-remove)
(dolist (expanded (tp--expand-layer-to-props-list prop str start))
(unless (memq expanded result)
(push expanded result))))
(nreverse result)))
(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-with-arg 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 has-keywords)
(cond
;; Check for keyword arguments format
((and (keywordp (car args))
(memq (car args) '(:props :data :watch :compute :transform)))
(setq has-keywords t)
;; 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* ((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))
;; Update any text regions that already have this layer applied
;; This ensures re-definition immediately updates applied text
(tp--layer-refresh name)
(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)
;; Update any text regions that already have this layer applied
(tp--layer-refresh name)
(assoc name tp-layer-alist)))))
(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 (single argument, simple body):
(define-tp tp-space (pixel)
\\=`(display (space :width (,pixel))))
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 (tp-name tp-bold face bold))
ARGLIST must be either:
- An empty list () for non-parameterized layers
- A list containing exactly one symbol 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'.
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: single argument - store as (LAYER-NAME ARGLIST BODY-FORM)
((and (= (length arglist) 1)
(symbolp (car arglist)))
`(tp--define-layer-unified ',name ',arglist ',simple-body))
(t
(error "define-tp ARGLIST must be empty or contain exactly one symbol"))))))))
(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 contains one symbol 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)))
(if (assoc name tp-layer-alist)
(setf (cdr (assoc name tp-layer-alist)) entry)
(push (cons name entry) tp-layer-alist))
(assoc name tp-layer-alist))
;; Non-parameterized - check for reactive symbols
(let ((reactive-syms (tp--collect-reactive-symbols body)))
(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)))
(if (assoc name tp-layer-alist)
(setf (cdr (assoc name tp-layer-alist)) entry)
(push (cons name entry) tp-layer-alist))
(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')."
;; 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)
;; Has reactive features - register dependencies and resolve at runtime
(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))
(let ((resolved-props (tp--resolve-reactive-symbols props)))
(tp--set-layer-props layer-name resolved-props))
(tp--layer-refresh layer-name))
;; No reactive symbols - use static properties
(progn
(tp--unregister-reactive-deps layer-name)
(tp--set-layer-props layer-name props)
(tp--layer-refresh layer-name)))
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))
(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 containing exactly one symbol 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 argument):
(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: single argument
((and (= (length arglist) 1)
(symbolp (car arglist)))
`(tp--define-layer-group-unified ',name ',arglist '(list ,@body)))
(t
(error "define-tps ARGLIST must be empty or contain exactly one symbol"))))
;; For backward compatibility, keep define-tp-group as an alias
(defalias 'define-tp-group 'define-tps
"Alias for `define-tps' for backward compatibility.")
(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."
(if (assoc layer-name tp-layer-alist)
(setf (cdr (assoc layer-name tp-layer-alist)) properties)
(push (cons layer-name properties) tp-layer-alist)))
(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-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.
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."
(when-let ((entry (cdr (assoc layer-name tp-layer-alist))))
;; entry is (ARGLIST BODY-FORM)
(let ((arglist (car entry))
(body (cadr entry)))
(when arglist ; Only for parameterized layers
(tp--check-layer-cycle layer-name)
(let* ((tp--layer-expansion-stack
(cons layer-name tp--layer-expansion-stack))
(arg-sym (car arglist))
;; Evaluate the body with the argument bound
(plist (eval `(let ((,arg-sym ',arg)) ,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-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-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))
(layer-arg (cadr spec)))
(if (tp-layer-parameterized-p layer-name)
(tp-layer-props-with-arg layer-name layer-arg 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-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.
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."
(when-let ((entry (cdr (assoc group-name tp-layer-groups))))
;; entry is (ARGLIST BODY-FORM)
(let ((arglist (car entry))
(body-form (cadr entry)))
(when arglist ; Only for parameterized groups
(let* ((arg-sym (car arglist))
;; Evaluate the body with the argument bound - returns list of layer specs
(layer-specs (eval `(let ((,arg-sym ',arg)) ,body-form))))
;; Convert layer specs to property lists
(mapcar (lambda (spec)
(tp--group-spec-to-props spec include-tp-name))
layer-specs))))))
(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)
((tp-layer-parameterized-p key)
(tp-layer-props-with-arg 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)
((tp-group-parameterized-p key)
(when-let ((layer-props-list (tp-group-props-with-arg 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--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
- 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 returns the layer properties WITH `tp-name'
- 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 ARG and returns the result
- Extra properties after ARG 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.
For layer names, includes `tp-name' property for reactive text property support.
For group names, includes `tp-layers' property 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))
(extra-props (cddr 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 ((layer-props
(cond
;; Parameterized layer - evaluate with the argument
((tp-layer-parameterized-p first-elem)
(tp-layer-props-with-arg first-elem second-elem 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
((tp-group-parameterized-p first-elem)
(when-let ((layer-props-list (tp-group-props-with-arg first-elem second-elem 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))
(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-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-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--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
- 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)
(or (tp-layer-props layer-spec t) ; include tp-name for layer stack
(error "Layer %S not found in tp-layer-alist" layer-spec)))
(t (error "Layer %S not found in tp-layer-alist" 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)
((and (tp-layer-parameterized-p name)
(= (length rest) 1))
(or (tp-layer-props-with-arg name (car rest) t) ; include tp-name
(error "Failed to resolve parameterized layer %S with arg %S"
name (car rest))))
;; Named inline layer: (NAME &rest PLIST)
(rest
(append rest (list 'tp-name name)))
;; Just a symbol in a list - treat as non-parameterized layer
((null rest)
(or (tp-layer-props name t)
(error "Layer %S not found in tp-layer-alist" name))))))
;; 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))
(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