0d35358e05
Replace the legacy managed layer renderer with one independent retained/reactive text runtime. TP now owns exact dependencies, stable objects, marker-backed mounts, property contribution composition, atomic publication, rollback, and direct text-property facades without ECSS or Ebox dependencies.\n\nBREAKING CHANGE: remove tp-render, tp-stack, scan-driven managed layers, inline runtime metadata, TP-owned CSS cascade APIs, and dollar-variable declarations.\n\nVerified: 290/290 ERT, shuffled 290/290 (seed 20260806), 8/8 doctests, WERROR compile-all, checkdoc, package-lint, diff-check, and isolated TP-only load.
561 lines
23 KiB
EmacsLisp
561 lines
23 KiB
EmacsLisp
;;; tp-layer.el --- Named property declaration recipes -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2024-2026 Geekinney
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; `define-tp' and `define-tps' register reusable native text-property
|
|
;; declaration recipes. A recipe is definition-time data only: applying it
|
|
;; expands to ordinary direct properties and never stamps runtime identity into
|
|
;; text. Live identity and reactivity belong to tp-surface and tp-reactive.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'tp-core)
|
|
(require 'tp-style)
|
|
|
|
(define-error 'tp-unresolved-layer "Unresolved TP declaration recipe")
|
|
(define-error 'tp-invalid-layer-definition "Invalid TP declaration recipe")
|
|
|
|
(defvar tp-layer-alist nil
|
|
"Alist of named declaration recipes.
|
|
Each entry has the form (NAME ARGLIST BODY-FORM).")
|
|
|
|
(defvar tp-layer-groups nil
|
|
"Alist of named declaration group recipes.
|
|
Each entry has the form (NAME ARGLIST BODY-FORM).")
|
|
|
|
(defvar tp--group-generated-layers nil
|
|
"Alist mapping group names to generated static recipe names.")
|
|
|
|
(defvar tp--compiled-style-layers nil
|
|
"Recipe names currently compiled into TP named direct styles.")
|
|
|
|
(defvar tp--layer-expansion-stack nil
|
|
"Recipe names currently being expanded, innermost first.")
|
|
|
|
(defun tp--recipe-entry (name registry)
|
|
"Return NAME's recipe entry from REGISTRY, or nil."
|
|
(cdr (assq name registry)))
|
|
|
|
(defun tp--validate-recipe-name (name kind)
|
|
"Validate recipe NAME for KIND and return NAME."
|
|
(unless (symbolp name)
|
|
(signal 'tp-invalid-layer-definition (list kind :name name)))
|
|
(when (tp--builtin-text-property-p name)
|
|
(signal 'tp-invalid-layer-definition
|
|
(list kind :reserved-text-property name)))
|
|
name)
|
|
|
|
(defun tp--validate-recipe-arglist (arglist kind name)
|
|
"Validate ARGLIST for KIND recipe NAME and return a copy."
|
|
(unless (and (listp arglist)
|
|
(cl-every #'symbolp arglist)
|
|
(= (length arglist) (length (delete-dups (copy-sequence arglist)))))
|
|
(signal 'tp-invalid-layer-definition
|
|
(list kind name :arglist arglist)))
|
|
(copy-sequence arglist))
|
|
|
|
(defun tp--recipe-dollar-symbol-p (value)
|
|
"Return non-nil when VALUE includes a legacy dollar-prefixed symbol."
|
|
(cond
|
|
((symbolp value) (string-prefix-p "$" (symbol-name value)))
|
|
((consp value)
|
|
(or (tp--recipe-dollar-symbol-p (car value))
|
|
(tp--recipe-dollar-symbol-p (cdr value))))
|
|
((vectorp value) (cl-some #'tp--recipe-dollar-symbol-p value))
|
|
(t nil)))
|
|
|
|
(defun tp--reject-legacy-reactive-syntax (value name)
|
|
"Reject legacy reactive syntax in VALUE from recipe NAME."
|
|
(when (tp--recipe-dollar-symbol-p value)
|
|
(signal 'tp-invalid-layer-definition
|
|
(list name :legacy-reactive-syntax
|
|
"Use tp-computed with signals or bindings"))))
|
|
|
|
(defun tp--check-layer-cycle (name)
|
|
"Signal an error when expanding NAME would create a cycle."
|
|
(when (memq name tp--layer-expansion-stack)
|
|
(error "TP: cyclic declaration recipe: %s"
|
|
(mapconcat #'symbol-name
|
|
(reverse (cons name tp--layer-expansion-stack))
|
|
" -> "))))
|
|
|
|
(defun tp--eval-recipe (name arglist body args)
|
|
"Evaluate recipe NAME with ARGLIST, BODY and ARGS."
|
|
(unless (= (length args) (length arglist))
|
|
(error "TP recipe %s takes %d argument(s), got %d"
|
|
name (length arglist) (length args)))
|
|
(let ((value (cl-progv arglist args (eval body))))
|
|
(tp--reject-legacy-reactive-syntax value name)
|
|
value))
|
|
|
|
(defun tp--merge-property-groups (&rest groups)
|
|
"Merge native property GROUPS using TP's direct property semantics."
|
|
(let ((flat (apply #'append
|
|
(mapcar #'tp--copy-property-value (delq nil groups)))))
|
|
(if (cddr flat) (tp--merge-duplicate-keys flat) flat)))
|
|
|
|
(defun tp--recipe-arguments (name arglist values)
|
|
"Split VALUES for recipe NAME with ARGLIST into (ARGS . EXTRA)."
|
|
(let ((arity (length arglist)))
|
|
(cond
|
|
((zerop arity)
|
|
(cons nil (unless (equal values '(t)) values)))
|
|
((and (consp values)
|
|
(listp (car values))
|
|
(= (length (car values)) arity)
|
|
(zerop (% (length (cdr values)) 2)))
|
|
(cons (car values) (cdr values)))
|
|
((>= (length values) arity)
|
|
(cons (cl-subseq values 0 arity) (nthcdr arity values)))
|
|
(t
|
|
(error "TP recipe %s takes %d argument(s), got %d"
|
|
name arity (length values))))))
|
|
|
|
(defun tp-layer-parameterized-p (name)
|
|
"Return non-nil when layer recipe NAME accepts arguments."
|
|
(when-let ((entry (tp--recipe-entry name tp-layer-alist)))
|
|
(and (car entry) t)))
|
|
|
|
(defun tp-layer-arglist (name)
|
|
"Return a defensive copy of layer recipe NAME's argument list."
|
|
(when-let ((entry (tp--recipe-entry name tp-layer-alist)))
|
|
(copy-sequence (car entry))))
|
|
|
|
(defun tp-group-parameterized-p (name)
|
|
"Return non-nil when group recipe NAME accepts arguments."
|
|
(when-let ((entry (tp--recipe-entry name tp-layer-groups)))
|
|
(and (car entry) t)))
|
|
|
|
(defun tp--group-arglist (name)
|
|
"Return a defensive copy of group recipe NAME's argument list."
|
|
(when-let ((entry (tp--recipe-entry name tp-layer-groups)))
|
|
(copy-sequence (car entry))))
|
|
|
|
(defun tp--is-layer-name-p (symbol)
|
|
"Return non-nil when SYMBOL names a layer or group recipe."
|
|
(and (symbolp symbol)
|
|
(or (assq symbol tp-layer-alist)
|
|
(assq symbol tp-layer-groups))))
|
|
|
|
(defun tp--plist-has-layer-key-p (properties)
|
|
"Return non-nil when PROPERTIES include a recipe as a key."
|
|
(and (listp properties)
|
|
(cl-loop for (key _value) on properties by #'cddr
|
|
thereis (tp--is-layer-name-p key))))
|
|
|
|
(defun tp--layer-value-args (name value)
|
|
"Return argument list for parameterized recipe NAME from VALUE."
|
|
(let ((arity (length (tp-layer-arglist name))))
|
|
(if (and (> arity 1) (proper-list-p value)) value (list value))))
|
|
|
|
(defun tp--group-value-args (name value)
|
|
"Return argument list for parameterized group NAME from VALUE."
|
|
(let ((arity (length (tp--group-arglist name))))
|
|
(if (and (> arity 1) (proper-list-p value)) value (list value))))
|
|
|
|
(defun tp--expand-layer-key (name value)
|
|
"Expand declaration recipe NAME used as a property key with VALUE."
|
|
(cond
|
|
((assq name tp-layer-alist)
|
|
(if (tp-layer-parameterized-p name)
|
|
(tp-layer-props-with-args name (tp--layer-value-args name value))
|
|
(tp-layer-props name)))
|
|
((assq name tp-layer-groups)
|
|
(apply #'tp--merge-property-groups
|
|
(if (tp-group-parameterized-p name)
|
|
(tp-group-props-with-args name (tp--group-value-args name value))
|
|
(tp-group-props name))))))
|
|
|
|
(defun tp--expand-layer-in-plist (properties)
|
|
"Expand recipe keys in native PROPERTIES and return direct properties."
|
|
(unless (and (listp properties) (zerop (% (length properties) 2)))
|
|
(signal 'tp-invalid-layer-definition
|
|
(list :invalid-property-list properties)))
|
|
(let (groups)
|
|
(cl-loop for (key value) on properties by #'cddr
|
|
do (push (if (tp--is-layer-name-p key)
|
|
(tp--expand-layer-key key value)
|
|
(list key (tp--copy-property-value value)))
|
|
groups))
|
|
(apply #'tp--merge-property-groups (nreverse groups))))
|
|
|
|
(defun tp--layer-properties (name args)
|
|
"Expand layer recipe NAME using ARGS."
|
|
(when-let ((entry (tp--recipe-entry name tp-layer-alist)))
|
|
(pcase-let ((`(,arglist ,body) entry))
|
|
(tp--check-layer-cycle name)
|
|
(let* ((tp--layer-expansion-stack
|
|
(cons name tp--layer-expansion-stack))
|
|
(properties (tp--eval-recipe name arglist body args)))
|
|
(unless (listp properties)
|
|
(signal 'tp-invalid-layer-definition
|
|
(list name :properties properties)))
|
|
(tp--expand-layer-in-plist properties)))))
|
|
|
|
(defun tp-layer-props (name &optional _provenance)
|
|
"Return direct properties for non-parameterized layer recipe NAME.
|
|
The result is a defensive copy. Return nil for an undefined or
|
|
parameterized recipe. PROVENANCE is accepted for source compatibility and
|
|
has no effect; runtime identity is never written into text."
|
|
(when (and (assq name tp-layer-alist)
|
|
(not (tp-layer-parameterized-p name)))
|
|
(tp--copy-property-value (tp--layer-properties name nil))))
|
|
|
|
(defun tp-layer-props-with-args (name args &optional _provenance)
|
|
"Return direct properties for layer recipe NAME evaluated with ARGS.
|
|
The result is a defensive copy. PROVENANCE is accepted for source
|
|
compatibility and has no effect."
|
|
(when (assq name tp-layer-alist)
|
|
(tp--copy-property-value (tp--layer-properties name args))))
|
|
|
|
(defun tp-layer-props-with-arg (name arg &optional provenance)
|
|
"Return layer recipe NAME evaluated with ARG.
|
|
PROVENANCE is accepted for source compatibility and has no effect."
|
|
(tp-layer-props-with-args name (list arg) provenance))
|
|
|
|
(defun tp--group-element-properties (group-name element)
|
|
"Resolve one ELEMENT produced by GROUP-NAME."
|
|
(cond
|
|
((symbolp element)
|
|
(or (tp-layer-props element)
|
|
(apply #'tp--merge-property-groups (tp-group-props element))
|
|
(signal 'tp-unresolved-layer (list element))))
|
|
((and (consp element) (symbolp (car element))
|
|
(tp--is-layer-name-p (car element)))
|
|
(or (tp--resolve-props element)
|
|
(signal 'tp-unresolved-layer (list (car element)))))
|
|
((and (consp element) (stringp (car element)))
|
|
(let ((properties
|
|
(if (eq (cadr element) :props) (caddr element) (cdr element))))
|
|
(tp--expand-layer-in-plist properties)))
|
|
((listp element) (tp--expand-layer-in-plist element))
|
|
(t
|
|
(signal 'tp-invalid-layer-definition
|
|
(list group-name :element element)))))
|
|
|
|
(defun tp--group-properties (name args)
|
|
"Return the ordered direct property groups produced by NAME with ARGS."
|
|
(when-let ((entry (tp--recipe-entry name tp-layer-groups)))
|
|
(pcase-let ((`(,arglist ,body) entry))
|
|
(tp--check-layer-cycle name)
|
|
(let* ((tp--layer-expansion-stack
|
|
(cons name tp--layer-expansion-stack))
|
|
(elements (tp--eval-recipe name arglist body args)))
|
|
(unless (listp elements)
|
|
(signal 'tp-invalid-layer-definition
|
|
(list name :elements elements)))
|
|
(mapcar (lambda (element)
|
|
(tp--group-element-properties name element))
|
|
elements)))))
|
|
|
|
(defun tp-group-props (name &optional _provenance)
|
|
"Return direct property groups for non-parameterized group recipe NAME.
|
|
PROVENANCE is accepted for source compatibility and has no effect."
|
|
(when (and (assq name tp-layer-groups)
|
|
(not (tp-group-parameterized-p name)))
|
|
(tp--copy-property-value (tp--group-properties name nil))))
|
|
|
|
(defun tp-group-props-with-args (name args &optional _provenance)
|
|
"Return direct property groups for group recipe NAME with ARGS."
|
|
(when (assq name tp-layer-groups)
|
|
(tp--copy-property-value (tp--group-properties name args))))
|
|
|
|
(defun tp-group-props-with-arg (name arg &optional provenance)
|
|
"Return group recipe NAME evaluated with ARG.
|
|
PROVENANCE is accepted for source compatibility and has no effect."
|
|
(tp-group-props-with-args name (list arg) provenance))
|
|
|
|
(defun tp--resolve-named-call (name values)
|
|
"Resolve recipe NAME applied to VALUES plus optional extra properties."
|
|
(let* ((arglist (if (assq name tp-layer-alist)
|
|
(tp-layer-arglist name)
|
|
(tp--group-arglist name)))
|
|
(split (tp--recipe-arguments name arglist values))
|
|
(args (car split))
|
|
(extra (cdr split))
|
|
(base
|
|
(if (assq name tp-layer-alist)
|
|
(tp-layer-props-with-args name args)
|
|
(apply #'tp--merge-property-groups
|
|
(tp-group-props-with-args name args))))
|
|
(expanded-extra
|
|
(when extra (tp--expand-layer-in-plist extra))))
|
|
(tp--merge-property-groups base expanded-extra)))
|
|
|
|
(defun tp--resolve-props (properties)
|
|
"Resolve PROPERTIES into ordinary direct Emacs text properties.
|
|
PROPERTIES may be a recipe name, a recipe call followed by extra property
|
|
pairs, or a native property list containing recipe keys. Return nil when a
|
|
symbol does not name a recipe."
|
|
(cond
|
|
((symbolp properties)
|
|
(when (tp--is-layer-name-p properties)
|
|
(tp--resolve-named-call properties nil)))
|
|
((and (consp properties)
|
|
(symbolp (car properties))
|
|
(tp--is-layer-name-p (car properties)))
|
|
(tp--resolve-named-call (car properties) (cdr properties)))
|
|
((listp properties)
|
|
(tp--expand-layer-in-plist properties))
|
|
(t nil)))
|
|
|
|
(defun tp--ensure-props (properties)
|
|
"Return direct properties resolved from PROPERTIES.
|
|
Signal `tp-unresolved-layer' when a symbol does not name a recipe."
|
|
(or (tp--resolve-props properties)
|
|
(if (symbolp properties)
|
|
(signal 'tp-unresolved-layer (list properties))
|
|
properties)))
|
|
|
|
(defun tp--compile-layer-style (name)
|
|
"Compile static layer recipe NAME into the named style registry."
|
|
(if (tp-layer-parameterized-p name)
|
|
(progn
|
|
(tp-undefine-style name)
|
|
(setq tp--compiled-style-layers
|
|
(delq name tp--compiled-style-layers)))
|
|
(tp-define-style name (tp-text-declarations (tp-layer-props name)))
|
|
(cl-pushnew name tp--compiled-style-layers))
|
|
name)
|
|
|
|
(defun tp--candidate-layer-parameterized-p (name layers)
|
|
"Return non-nil when NAME accepts arguments in candidate LAYERS."
|
|
(when-let ((entry (tp--recipe-entry name layers)))
|
|
(and (car entry) t)))
|
|
|
|
(defun tp--candidate-layer-properties (name args layers groups)
|
|
"Expand NAME with ARGS against candidate LAYERS and GROUPS."
|
|
(let ((tp-layer-alist layers)
|
|
(tp-layer-groups groups))
|
|
(tp--layer-properties name args)))
|
|
|
|
(defun tp--candidate-compile-layer-style
|
|
(name layers groups styles compiled)
|
|
"Compile NAME from LAYERS and GROUPS into STYLES; return COMPILED."
|
|
(if (tp--candidate-layer-parameterized-p name layers)
|
|
(progn
|
|
(remhash name styles)
|
|
(delq name compiled))
|
|
(puthash name
|
|
(tp-merge-declarations
|
|
(tp-text-declarations
|
|
(tp--candidate-layer-properties name nil layers groups)))
|
|
styles)
|
|
(cl-pushnew name compiled))
|
|
compiled)
|
|
|
|
(defun tp--candidate-define-layer-recipe
|
|
(name arglist body layers groups styles compiled)
|
|
"Define NAME with ARGLIST and BODY in candidate registries.
|
|
LAYERS, GROUPS, STYLES and COMPILED are the candidate registries.
|
|
Return (LAYERS . COMPILED) for the updated candidates."
|
|
(tp--validate-recipe-name name 'layer)
|
|
(setq arglist (tp--validate-recipe-arglist arglist 'layer name))
|
|
(let ((candidate-layers
|
|
(cons (cons name (list arglist (tp--copy-property-value body)))
|
|
(assq-delete-all name layers))))
|
|
(cons candidate-layers
|
|
(tp--candidate-compile-layer-style
|
|
name candidate-layers groups styles compiled))))
|
|
|
|
(defun tp--candidate-remove-layer (name layers styles compiled)
|
|
"Remove NAME from candidate LAYERS and STYLES; return (LAYERS . COMPILED)."
|
|
(remhash name styles)
|
|
(cons (assq-delete-all name layers)
|
|
(delq name compiled)))
|
|
|
|
(defun tp--define-layer-recipe (name arglist body)
|
|
"Register layer recipe NAME with ARGLIST and BODY."
|
|
(tp--validate-recipe-name name 'layer)
|
|
(setq arglist (tp--validate-recipe-arglist arglist 'layer name))
|
|
(let ((old-entry (assq name tp-layer-alist)))
|
|
(setq tp-layer-alist
|
|
(cons (cons name (list arglist (tp--copy-property-value body)))
|
|
(assq-delete-all name tp-layer-alist)))
|
|
(condition-case condition
|
|
(progn
|
|
(tp--compile-layer-style name)
|
|
(assq name tp-layer-alist))
|
|
(error
|
|
(setq tp-layer-alist (assq-delete-all name tp-layer-alist))
|
|
(when old-entry (push old-entry tp-layer-alist))
|
|
(signal (car condition) (cdr condition))))))
|
|
|
|
;;;###autoload
|
|
(defmacro define-tp (name arglist &rest body)
|
|
"Define named direct property recipe NAME with ARGLIST and BODY.
|
|
BODY must contain exactly one form returning a native text-property plist.
|
|
Use `tp-computed' for explicit reactive value sources."
|
|
(declare (indent defun))
|
|
(unless (= (length body) 1)
|
|
(error "Define-tp requires exactly one body form"))
|
|
(if arglist
|
|
`(tp--define-layer-recipe ',name ',arglist ',(car body))
|
|
`(tp--define-layer-recipe
|
|
',name nil (list 'quote ,(car body)))))
|
|
|
|
;;;###autoload
|
|
(defalias 'tp-define-layer 'define-tp
|
|
"Define a named direct property recipe; alias of `define-tp'.")
|
|
(function-put 'tp-define-layer 'lisp-indent-function 'defun)
|
|
|
|
(defun tp--group-generated-name (group-name suffix)
|
|
"Return a generated recipe name for GROUP-NAME and SUFFIX."
|
|
(intern (format "%s-%s" group-name suffix)))
|
|
|
|
(defun tp--static-group-generated-specs (name elements)
|
|
"Return validated generated recipe specs for static group NAME ELEMENTS."
|
|
(let (specs)
|
|
(cl-loop for element in elements
|
|
for index from 0
|
|
when (and (consp element) (stringp (car element)))
|
|
do (push (cons (tp--group-generated-name name (car element))
|
|
(if (eq (cadr element) :props)
|
|
(caddr element)
|
|
(cdr element)))
|
|
specs)
|
|
when (and (listp element)
|
|
(not (stringp (car-safe element)))
|
|
(not (symbolp element)))
|
|
do (push (cons (tp--group-generated-name name index) element)
|
|
specs))
|
|
(dolist (spec specs)
|
|
(tp--validate-recipe-name (car spec) 'group-element)
|
|
(tp-text-declarations (tp--expand-layer-in-plist (cdr spec))))
|
|
(nreverse (tp--copy-property-value specs))))
|
|
|
|
(defun tp--define-group-recipe (name arglist body)
|
|
"Register group recipe NAME with ARGLIST and BODY."
|
|
(tp--validate-recipe-name name 'group)
|
|
(setq arglist (tp--validate-recipe-arglist arglist 'group name))
|
|
(let* ((elements (unless arglist (tp--eval-recipe name nil body nil)))
|
|
(tp--layer-expansion-stack (cons name tp--layer-expansion-stack))
|
|
(_validated
|
|
(unless arglist
|
|
(mapc (lambda (element)
|
|
(tp--group-element-properties name element))
|
|
elements)))
|
|
(specs (unless arglist
|
|
(tp--static-group-generated-specs name elements))))
|
|
(let ((candidate-layers (tp--copy-property-value tp-layer-alist))
|
|
(candidate-groups (tp--copy-property-value tp-layer-groups))
|
|
(candidate-generated
|
|
(tp--copy-property-value tp--group-generated-layers))
|
|
(candidate-compiled (copy-sequence tp--compiled-style-layers))
|
|
(candidate-styles (copy-hash-table tp--named-styles))
|
|
generated-names)
|
|
(dolist (generated (cdr (assq name candidate-generated)))
|
|
(pcase-let ((`(,layers . ,compiled)
|
|
(tp--candidate-remove-layer
|
|
generated candidate-layers
|
|
candidate-styles candidate-compiled)))
|
|
(setq candidate-layers layers
|
|
candidate-compiled compiled)))
|
|
(setq candidate-generated
|
|
(assq-delete-all name candidate-generated))
|
|
(setf (alist-get name candidate-groups)
|
|
(list arglist (tp--copy-property-value body)))
|
|
(dolist (spec specs)
|
|
(pcase-let ((`(,layers . ,compiled)
|
|
(tp--candidate-define-layer-recipe
|
|
(car spec) nil
|
|
(list 'quote (tp--copy-property-value (cdr spec)))
|
|
candidate-layers candidate-groups
|
|
candidate-styles candidate-compiled)))
|
|
(setq candidate-layers layers
|
|
candidate-compiled compiled)
|
|
(push (car spec) generated-names)))
|
|
(when specs
|
|
(setf (alist-get name candidate-generated)
|
|
(nreverse generated-names)))
|
|
(setq tp-layer-alist candidate-layers
|
|
tp-layer-groups candidate-groups
|
|
tp--group-generated-layers candidate-generated
|
|
tp--compiled-style-layers candidate-compiled
|
|
tp--named-styles candidate-styles)))
|
|
(assq name tp-layer-groups))
|
|
|
|
;;;###autoload
|
|
(defmacro define-tps (name arglist &rest body)
|
|
"Define named direct property group recipe NAME with ARGLIST.
|
|
Each BODY form evaluates to one layer name, recipe call, native property
|
|
plist, or named element such as (\"label\" . (face bold))."
|
|
(declare (indent defun))
|
|
(if arglist
|
|
`(tp--define-group-recipe ',name ',arglist '(list ,@body))
|
|
`(tp--define-group-recipe
|
|
',name nil (list 'quote (list ,@body)))))
|
|
|
|
(defalias 'define-tp-group 'define-tps
|
|
"Define a declaration group; alias of `define-tps'.")
|
|
|
|
;;;###autoload
|
|
(defalias 'tp-define-group 'define-tps
|
|
"Define a declaration group; alias of `define-tps'.")
|
|
(function-put 'tp-define-group 'lisp-indent-function 'defun)
|
|
|
|
;;;###autoload
|
|
(defun tp-layer-reset ()
|
|
"Remove every named layer and group declaration recipe."
|
|
(interactive)
|
|
(dolist (name tp--compiled-style-layers)
|
|
(tp-undefine-style name))
|
|
(setq tp-layer-alist nil
|
|
tp-layer-groups nil
|
|
tp--group-generated-layers nil
|
|
tp--compiled-style-layers nil))
|
|
|
|
(defun tp-undefine-layer (name)
|
|
"Remove named layer declaration recipe NAME."
|
|
(setq tp-layer-alist (assq-delete-all name tp-layer-alist)
|
|
tp--compiled-style-layers (delq name tp--compiled-style-layers))
|
|
(tp-undefine-style name))
|
|
|
|
(defun tp-undefine-group (name)
|
|
"Remove named declaration group NAME and recipes it generated."
|
|
(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)
|
|
tp-layer-groups (assq-delete-all name tp-layer-groups))
|
|
nil)
|
|
|
|
(defun tp--describe-layer-data (name)
|
|
"Return declarative registry data for layer recipe NAME."
|
|
(when-let ((entry (tp--recipe-entry name tp-layer-alist)))
|
|
(list :name name
|
|
:kind 'direct-declaration-recipe
|
|
:arglist (copy-sequence (car entry))
|
|
:body (tp--copy-property-value (cadr entry))
|
|
:props (if (car entry)
|
|
"parameterized recipe"
|
|
(tp-layer-props name))
|
|
:group (cl-loop for (group . generated)
|
|
in tp--group-generated-layers
|
|
when (memq name generated)
|
|
return group))))
|
|
|
|
;;;###autoload
|
|
(defun tp-describe-layer (name)
|
|
"Display a help buffer describing declaration recipe NAME."
|
|
(interactive
|
|
(list (intern (completing-read "Describe TP recipe: "
|
|
(mapcar #'car tp-layer-alist) nil t))))
|
|
(let ((data (tp--describe-layer-data name)))
|
|
(unless data (user-error "No TP recipe named `%s'" name))
|
|
(with-help-window (help-buffer)
|
|
(princ (format "%s is a TP direct declaration recipe.\n\n" name))
|
|
(princ (format "Arguments: %S\n" (plist-get data :arglist)))
|
|
(princ (format "Stored body: %S\n" (plist-get data :body)))
|
|
(princ (format "Expanded properties: %S\n" (plist-get data :props)))
|
|
(when (plist-get data :group)
|
|
(princ (format "Generated by group: %s\n"
|
|
(plist-get data :group)))))))
|
|
|
|
(provide 'tp-layer)
|
|
;;; tp-layer.el ends here
|