geekinney/etaf
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: close M0 core interaction contracts

Browse Source
This commit is contained in:
Kinneyzhang 2026-08-31 15:18:26 +08:00
parent 8d685b75e3
commit 525e6b38b7
15 changed files with 2423 additions and 946 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -2,7 +2,7 @@ EMACS ?= emacs
LOAD_PATH = -L . -L examples -L scripts -L ../ebox -L ../tp -L ../ecss LOAD_PATH = -L . -L examples -L scripts -L ../ebox -L ../tp -L ../ecss
SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-reactive.el etaf-observer.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el scripts/emacs-gui-verifier.el SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-reactive.el etaf-observer.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el scripts/emacs-gui-verifier.el
EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-component-frontends-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el tests/etaf-m0a-current-characterization-tests.el tests/etaf-interaction-contract-tests.el tests/etaf-m0b-component-manifest-tests.el
.PHONY: test compile load checkdoc docs-check check clean .PHONY: test compile load checkdoc docs-check check clean

24
etaf-actions.el
View File

@ -31,12 +31,23 @@
(defvar etaf--action-registry (make-hash-table :test #'eq) (defvar etaf--action-registry (make-hash-table :test #'eq)
"Action name -> `etaf-action-spec' table.") "Action name -> `etaf-action-spec' table.")
(defvar etaf--allow-action-redefinition nil
"Non-nil only inside `etaf-action-redefine-run'.")
(defun etaf--action-assert-definition-available (name)
"Signal when Action NAME cannot be defined in the current boundary."
(when (and (gethash name etaf--action-registry)
(not etaf--allow-action-redefinition))
(signal 'etaf-action-error
(list (format "Duplicate ETAF Action: %S" name)))))
(defun etaf-action-register (name function) (defun etaf-action-register (name function)
"Register FUNCTION as named Action NAME and return NAME." "Register FUNCTION as named Action NAME and return NAME."
(etaf--assert-not-rendering 'register-action) (etaf--assert-not-rendering 'register-action)
(unless (and (symbolp name) (not (keywordp name)) (functionp function)) (unless (and (symbolp name) (not (keywordp name)) (functionp function))
(signal 'etaf-action-error (signal 'etaf-action-error
(list (format "Invalid Action registration: %S" name)))) (list (format "Invalid Action registration: %S" name))))
(etaf--action-assert-definition-available name)
(puthash name (etaf--action-spec-create :name name :function function) (puthash name (etaf--action-spec-create :name name :function function)
etaf--action-registry) etaf--action-registry)
name) name)
@ -52,12 +63,25 @@ through `etaf-dispatch'."
(let ((docstring (when (stringp (car body)) (pop body))) (let ((docstring (when (stringp (car body)) (pop body)))
(function-symbol (intern (format "%s--etaf-action" name)))) (function-symbol (intern (format "%s--etaf-action" name))))
`(progn `(progn
(etaf--action-assert-definition-available ',name)
(defun ,function-symbol ,arguments (defun ,function-symbol ,arguments
,(or docstring (format "Run ETAF Action `%s'." name)) ,(or docstring (format "Run ETAF Action `%s'." name))
,@body) ,@body)
(etaf-action-register ',name #',function-symbol) (etaf-action-register ',name #',function-symbol)
',name))) ',name)))
;;;###autoload
(defun etaf-action-redefine-run (function)
"Run FUNCTION while allowing intentional Action redefinition.
Normal duplicate registrations remain errors. This dynamic authoring
boundary replaces only the process-global name binding used by future
`etaf-dispatch' calls; it does not flush or rerender mounted Runtimes."
(unless (functionp function)
(signal 'wrong-type-argument (list 'functionp function)))
(let ((etaf--allow-action-redefinition t))
(funcall function)))
;;;###autoload ;;;###autoload
(defun etaf-dispatch (action &rest arguments) (defun etaf-dispatch (action &rest arguments)
"Dispatch named ACTION through the active Runtime with ARGUMENTS. "Dispatch named ACTION through the active Runtime with ARGUMENTS.

33
etaf-compiler.el
View File

@ -18,6 +18,7 @@
(defconst etaf-compiler-blueprint-abi "etaf-view-blueprint/2") (defconst etaf-compiler-blueprint-abi "etaf-view-blueprint/2")
(defvar etaf-compiler--static-cache (make-hash-table :test #'equal)) (defvar etaf-compiler--static-cache (make-hash-table :test #'equal))
(defvar etaf-compiler--site-token-cache (make-hash-table :test #'equal))
(defvar etaf-compiler--registry-epoch 0) (defvar etaf-compiler--registry-epoch 0)
(defvar etaf-compiler--instantiate-count 0) (defvar etaf-compiler--instantiate-count 0)
(defvar etaf-compiler--last-blueprint nil) (defvar etaf-compiler--last-blueprint nil)
@ -30,7 +31,22 @@
(defun etaf-compiler-clear-cache () (defun etaf-compiler-clear-cache ()
"Clear all process-local compiled View materializations." "Clear all process-local compiled View materializations."
(interactive) (interactive)
(clrhash etaf-compiler--static-cache)) (clrhash etaf-compiler--static-cache)
(clrhash etaf-compiler--site-token-cache))
(defun etaf-compiler--site-token (blueprint block)
"Return the stable opaque token for compiled BLOCK in BLUEPRINT."
(let* ((key (list (plist-get blueprint :id)
(plist-get block :path)))
(missing (make-symbol "etaf-compiled-site-token-missing"))
(token (gethash key etaf-compiler--site-token-cache missing)))
(if (not (eq token missing))
token
(setq token (list 'etaf-compiled-site
(plist-get blueprint :id)
(plist-get block :path)))
(puthash key token etaf-compiler--site-token-cache)
token)))
(defun etaf-compiler-statistics () (defun etaf-compiler-statistics ()
"Return a read-only snapshot of compiler runtime statistics." "Return a read-only snapshot of compiler runtime statistics."
@ -313,12 +329,19 @@
cached cached
(let ((value (let ((value
(pcase (plist-get block :kind) (pcase (plist-get block :kind)
('literal (plist-get block :value)) ;; The compiler's literal block is also used for a root string.
;; Keep the same canonicalization as the non-compiled View path:
;; a bare string is a Text View, while nil remains an empty
;; structural value.
('literal
(let ((literal (plist-get block :value)))
(if (and (stringp literal)
(= (length (plist-get block :path)) 1))
(etaf--text-view-from-string literal)
literal)))
('expr ('expr
(etaf--expr-create (etaf--expr-create
:token (list 'etaf-compiled-site :token (etaf-compiler--site-token blueprint block)
(plist-get blueprint :id)
(plist-get block :path))
:thunk (aref programs (plist-get block :hole)))) :thunk (aref programs (plist-get block :hole))))
((or 'branch 'keyed-list) ((or 'branch 'keyed-list)
(let ((program (let ((program

79
etaf-data.el
View File

@ -49,7 +49,8 @@ CAPABILITIES is a plist. `:load' is required and receives QUERY, PAGE, and
PAGE-SIZE. It must return a plist containing at least `:items', and may return PAGE-SIZE. It must return a plist containing at least `:items', and may return
`:total', `:page', and `:page-size'. `:mutate' is optional and receives `:total', `:page', and `:page-size'. `:mutate' is optional and receives
OPERATION and PAYLOAD. `:dispose' is optional and runs when the owning OPERATION and PAYLOAD. `:dispose' is optional and runs when the owning
controller stops. `:provider' may name the source in observation reports and controller stops. `:item-key' optionally returns stable selection identity
for one item. `:provider' may name the source in observation reports and
defaults to `data'." defaults to `data'."
(let ((load (plist-get capabilities :load)) (let ((load (plist-get capabilities :load))
(mutate (plist-get capabilities :mutate)) (mutate (plist-get capabilities :mutate))
@ -58,7 +59,8 @@ defaults to `data'."
(unless (functionp load) (unless (functionp load)
(signal 'wrong-type-argument (list 'functionp load))) (signal 'wrong-type-argument (list 'functionp load)))
(dolist (entry `((:mutate . ,mutate) (dolist (entry `((:mutate . ,mutate)
(:dispose . ,dispose))) (:dispose . ,dispose)
(:item-key . ,(plist-get capabilities :item-key))))
(when (and (cdr entry) (not (functionp (cdr entry)))) (when (and (cdr entry) (not (functionp (cdr entry))))
(signal 'wrong-type-argument (list 'functionp (cdr entry))))) (signal 'wrong-type-argument (list 'functionp (cdr entry)))))
(when (and (plist-member capabilities :provider) (when (and (plist-member capabilities :provider)
@ -166,7 +168,8 @@ defaults to `data'."
(cl-defun etaf-data-memory-source (items &key id-key name) (cl-defun etaf-data-memory-source (items &key id-key name)
"Create an in-memory Data source over ITEMS. "Create an in-memory Data source over ITEMS.
ID-KEY identifies records for `replace', `update', and `delete' mutations. ID-KEY identifies records for `replace', `update', and `delete' mutations,
and is exposed to Data Controllers as the source's stable item identity.
NAME optionally labels the source for diagnostics. NAME optionally labels the source for diagnostics.
Queries may be nil, a predicate, a search string, a plist, an alist, or an Queries may be nil, a predicate, a search string, a plist, an alist, or an
exact value. Supported mutations are `insert', `replace', `update', `delete', exact value. Supported mutations are `insert', `replace', `update', `delete',
@ -182,6 +185,9 @@ and `reset'."
(etaf-data-source (etaf-data-source
:name name :name name
:provider 'memory :provider 'memory
:item-key (and id-key
(lambda (record)
(etaf-data--memory-record-id record id-key)))
:load (lambda (query page page-size) :load (lambda (query page page-size)
(let* ((all (etaf-value records)) (let* ((all (etaf-value records))
(filtered (funcall query-function query all))) (filtered (funcall query-function query all)))
@ -245,6 +251,35 @@ use its result as `:initial-result' for `etaf-data-controller'."
(etaf-data--normalize-result (etaf-data--normalize-result
(etaf-data--source-load source query page page-size)))) (etaf-data--source-load source query page page-size))))
(defun etaf-data--item-identity (controller item)
"Return ITEM's selection identity in CONTROLLER."
(if-let* ((item-key (etaf-data--controller-item-key controller)))
(funcall item-key item)
item))
(defun etaf-data--ensure-selected-ref (controller identity)
"Return CONTROLLER's retained boolean selection ref for IDENTITY."
(let* ((refs (etaf-data--controller-selected-refs controller))
(selected-ref (gethash identity refs)))
(or selected-ref
(let ((created
(etaf-ref
(not (null
(member identity
(etaf-data--controller-selection-snapshot
controller))))
:name 'etaf-data-selected)))
(puthash identity created refs)
created))))
(defun etaf-data--prepare-selected-refs (controller items)
"Materialize CONTROLLER selection dependencies for ITEMS before render."
(dolist (identity (etaf-data--controller-selection-snapshot controller))
(etaf-data--ensure-selected-ref controller identity))
(dolist (item items)
(etaf-data--ensure-selected-ref
controller (etaf-data--item-identity controller item))))
(defun etaf-data--apply-load-success (controller request-id result) (defun etaf-data--apply-load-success (controller request-id result)
"Publish successful RESULT for CONTROLLER when REQUEST-ID is current." "Publish successful RESULT for CONTROLLER when REQUEST-ID is current."
(when (= request-id (etaf-data--controller-request-id controller)) (when (= request-id (etaf-data--controller-request-id controller))
@ -253,6 +288,11 @@ use its result as `:initial-result' for `etaf-data-controller'."
(unwind-protect (unwind-protect
(progn (progn
(setf (etaf-data--controller-auto-load-p controller) nil) (setf (etaf-data--controller-auto-load-p controller) nil)
;; ITEMS publication may synchronously schedule a DataGrid render.
;; Materialize keyed selection dependencies first so render only
;; reads retained reactive state.
(etaf-data--prepare-selected-refs
controller (plist-get normalized :items))
(setf (etaf-value (etaf-data--controller-items controller)) (setf (etaf-value (etaf-data--controller-items controller))
(plist-get normalized :items)) (plist-get normalized :items))
(setf (etaf-value (etaf-data--controller-total controller)) (setf (etaf-value (etaf-data--controller-total controller))
@ -285,8 +325,8 @@ use its result as `:initial-result' for `etaf-data-controller'."
QUERY, PAGE, PAGE-SIZE, result ITEMS, TOTAL, STATUS, ERROR, and SELECTION are QUERY, PAGE, PAGE-SIZE, result ITEMS, TOTAL, STATUS, ERROR, and SELECTION are
stored in refs. When AUTO-LOAD is non-nil, the controller loads immediately stored in refs. When AUTO-LOAD is non-nil, the controller loads immediately
and reloads after query or pagination refs change. NAME optionally labels the and reloads after query or pagination refs change. NAME optionally labels the
controller for diagnostics. ITEM-KEY is a function used by controller for diagnostics. ITEM-KEY identifies selection and selected-item
`etaf-data-selected-item' to match a selected identity to one loaded item. state; it defaults to the source's `:item-key' capability when available.
When OWNER-SCOPE is supplied, or when a current ETAF Scope exists, the When OWNER-SCOPE is supplied, or when a current ETAF Scope exists, the
controller's own child Scope is disposed with that owner; otherwise it keeps controller's own child Scope is disposed with that owner; otherwise it keeps
the detached Scope behavior. INITIAL-RESULT may be a normalized source result the detached Scope behavior. INITIAL-RESULT may be a normalized source result
@ -294,6 +334,7 @@ for QUERY/PAGE/PAGE-SIZE; it seeds a successful Controller without another
load. INITIAL-RESULT and AUTO-LOAD are mutually exclusive." load. INITIAL-RESULT and AUTO-LOAD are mutually exclusive."
(unless (etaf-data-source-p source) (unless (etaf-data-source-p source)
(signal 'wrong-type-argument (list 'etaf-data-source-p source))) (signal 'wrong-type-argument (list 'etaf-data-source-p source)))
(setq item-key (or item-key (plist-get source :item-key)))
(unless (or (null item-key) (functionp item-key)) (unless (or (null item-key) (functionp item-key))
(signal 'wrong-type-argument (list 'functionp item-key))) (signal 'wrong-type-argument (list 'functionp item-key)))
(when (and initial-result auto-load) (when (and initial-result auto-load)
@ -337,10 +378,11 @@ load. INITIAL-RESULT and AUTO-LOAD are mutually exclusive."
:selection (etaf-ref (copy-sequence selection) :selection (etaf-ref (copy-sequence selection)
:name 'etaf-data-selection) :name 'etaf-data-selection)
:selection-snapshot (copy-sequence selection) :selection-snapshot (copy-sequence selection)
:selected-refs (make-hash-table :test #'equal :weakness 'value) :selected-refs (make-hash-table :test #'equal)
:request-id 0 :request-id 0
:auto-load-p auto-load :auto-load-p auto-load
:item-key item-key))) :item-key item-key)))
(etaf-data--prepare-selected-refs controller initial-items)
(etaf-scope-run (etaf-scope-run
scope scope
(lambda () (lambda ()
@ -349,6 +391,8 @@ load. INITIAL-RESULT and AUTO-LOAD are mutually exclusive."
(lambda (new-selection old-selection) (lambda (new-selection old-selection)
(setf (etaf-data--controller-selection-snapshot controller) (setf (etaf-data--controller-selection-snapshot controller)
new-selection) new-selection)
(dolist (identity new-selection)
(etaf-data--ensure-selected-ref controller identity))
(let ((selected-refs (let ((selected-refs
(etaf-data--controller-selected-refs controller))) (etaf-data--controller-selected-refs controller)))
(unless (zerop (hash-table-count selected-refs)) (unless (zerop (hash-table-count selected-refs))
@ -490,6 +534,14 @@ The status value is one of `idle', `loading', `success', or `error'."
(etaf-data--controller-selection (etaf-data--controller-selection
(etaf-data--require-controller controller))) (etaf-data--require-controller controller)))
;;;###autoload
(defun etaf-data-item-identity (controller item)
"Return ITEM's stable selection identity in CONTROLLER.
The identity comes from the Controller's explicit `:item-key', then from its
source capability, and otherwise is ITEM itself."
(etaf-data--item-identity (etaf-data--require-controller controller) item))
;;;###autoload ;;;###autoload
(defun etaf-data-selected-ref (controller identity) (defun etaf-data-selected-ref (controller identity)
"Return CONTROLLER's stable boolean selection ref for IDENTITY. "Return CONTROLLER's stable boolean selection ref for IDENTITY.
@ -498,19 +550,8 @@ The returned ref changes only when IDENTITY enters or leaves the controller's
selection. Repeated calls for the same identity return the same ref for the selection. Repeated calls for the same identity return the same ref for the
controller lifetime. Updates made through the selection APIs or by writing controller lifetime. Updates made through the selection APIs or by writing
the public `etaf-data-selection' ref directly are both reflected." the public `etaf-data-selection' ref directly are both reflected."
(setq controller (etaf-data--require-controller controller)) (etaf-data--ensure-selected-ref
(let* ((refs (etaf-data--controller-selected-refs controller)) (etaf-data--require-controller controller) identity))
(selected-ref (gethash identity refs)))
(or selected-ref
(let ((created
(etaf-ref
(not (null
(member identity
(etaf-data--controller-selection-snapshot
controller))))
:name 'etaf-data-selected)))
(puthash identity created refs)
created))))
;;;###autoload ;;;###autoload
(defun etaf-data-selected-item (controller &optional item-key) (defun etaf-data-selected-item (controller &optional item-key)

25
etaf-renderer.el
View File

@ -526,12 +526,11 @@ multi-root forest; a single material root is returned unchanged."
(let ((resolved (funcall (etaf--expr-thunk value)))) (let ((resolved (funcall (etaf--expr-thunk value))))
(cond ((null resolved) nil) (cond ((null resolved) nil)
((stringp resolved) (list resolved)) ((stringp resolved) (list resolved))
(t ;; Text Hosts validate interpolation through
(signal 'etaf-renderer-error ;; `etaf--inline-text-content'. At a structural boundary the
(list ;; same evaluated value may be a dynamically produced View
(format ;; forest (notably a transparent Component's fragment).
"Expr interpolation must return nil or string: %S" (t (etaf--flatten-view-value resolved)))))
resolved)))))))
('branch ('branch
(etaf--flatten-view-value (funcall (etaf--expr-thunk value)))) (etaf--flatten-view-value (funcall (etaf--expr-thunk value))))
('keyed-list ('keyed-list
@ -752,8 +751,12 @@ multi-root forest; a single material root is returned unchanged."
(or semantic-id (or semantic-id
etaf--current-semantic-parent-id))) etaf--current-semantic-parent-id)))
(if (and semantic-id (if (and semantic-id
(etaf--structural-program-p child) ;; Code-mode may carry a retained
(not etaf--rendering-range-p)) ;; structural Expr through `etaf-node'.
;; Both compiler-owned programs and these
;; validated Expr values use the same
;; direct Range lowering boundary.
(etaf--expr-p child))
(let ((result (let ((result
(etaf--runtime-render-child-range (etaf--runtime-render-child-range
etaf--render-runtime child etaf--render-runtime child
@ -763,8 +766,7 @@ multi-root forest; a single material root is returned unchanged."
(cdr result)) (cdr result))
(if (and semantic-id (if (and semantic-id
(etaf--view-node-p child) (etaf--view-node-p child)
(eq (etaf--view-node-name child) 'fragment) (eq (etaf--view-node-name child) 'fragment))
(not etaf--rendering-range-p))
(let ((result (let ((result
(etaf--runtime-render-fragment-range (etaf--runtime-render-fragment-range
etaf--render-runtime child etaf--render-runtime child
@ -774,8 +776,7 @@ multi-root forest; a single material root is returned unchanged."
(if (and semantic-id (if (and semantic-id
(etaf--slot-projection-p child) (etaf--slot-projection-p child)
(etaf--slot-projection-range-compatible-p (etaf--slot-projection-range-compatible-p
child) child))
(not etaf--rendering-range-p))
(let ((result (let ((result
(etaf--runtime-render-slot-range (etaf--runtime-render-slot-range
etaf--render-runtime child etaf--render-runtime child

745
etaf-runtime.el
View File

@ -732,12 +732,24 @@ FULL-P means candidate tables describe the complete mounted tree."
(etaf--semantic-range-range-ref semantic) (etaf--semantic-range-range-ref semantic)
(etaf--semantic-slot-range-range-ref semantic))) (etaf--semantic-slot-range-range-ref semantic)))
(defun etaf--semantic-backend-range-semantic-id (semantic)
"Return retained semantic id for direct or slot Range SEMANTIC."
(if (etaf--semantic-range-p semantic)
(etaf--semantic-range-semantic-id semantic)
(etaf--semantic-slot-range-semantic-id semantic)))
(defun etaf--semantic-backend-range-container-component-id (semantic) (defun etaf--semantic-backend-range-container-component-id (semantic)
"Return the Component containing backend Range SEMANTIC's artifact." "Return the Component containing backend Range SEMANTIC's artifact."
(if (etaf--semantic-range-p semantic) (if (etaf--semantic-range-p semantic)
(etaf--semantic-range-component-id semantic) (etaf--semantic-range-component-id semantic)
(etaf--semantic-slot-range-consumer-component-id semantic))) (etaf--semantic-slot-range-consumer-component-id semantic)))
(defun etaf--semantic-backend-range-item-root-ids (semantic)
"Return direct material root ids owned by backend Range SEMANTIC."
(if (etaf--semantic-range-p semantic)
(etaf--semantic-range-item-root-ids semantic)
(etaf--semantic-slot-range-item-root-ids semantic)))
(defun etaf--generation-component-output-range (generation component) (defun etaf--generation-component-output-range (generation component)
"Return COMPONENT's transparent output Range from GENERATION." "Return COMPONENT's transparent output Range from GENERATION."
(let* ((range-id (etaf--semantic-component-output-range-id component)) (let* ((range-id (etaf--semantic-component-output-range-id component))
@ -1495,6 +1507,19 @@ OLD-SEMANTIC supplies the already-read committed Host, when any."
(puthash parent-id cell children)) (puthash parent-id cell children))
(puthash parent-id cell tails))) (puthash parent-id cell tails)))
(defun etaf--runtime-range-must-refresh-for-component-input-p (expr)
"Return non-nil when EXPR's value is coupled to a Component rerender.
Compiler-owned branch/keyed programs and compiled direct Expr callsites may
read the current Component props while they materialize. Setup-retained
interpolation programs are opaque values and can safely reuse their Range
when only an unrelated parent structure changed."
(and etaf--rendering-component-effect-p
(or (memq (and (etaf--expr-p expr) (etaf--expr-kind expr))
'(branch keyed-list))
(and (etaf--expr-p expr)
(consp (etaf--expr-token expr))
(eq (car (etaf--expr-token expr)) 'etaf-compiled-site)))))
(defun etaf--runtime-semantic-id-for-identity (runtime identity) (defun etaf--runtime-semantic-id-for-identity (runtime identity)
"Return stable semantic id for IDENTITY in RUNTIME's current candidate." "Return stable semantic id for IDENTITY in RUNTIME's current candidate."
(or (gethash identity (etaf-runtime-candidate-identity-entries runtime)) (or (gethash identity (etaf-runtime-candidate-identity-entries runtime))
@ -1653,14 +1678,25 @@ receive an independent Host effect."
(t (t
(signal 'etaf-behavior-error (signal 'etaf-behavior-error
(list (format "Invalid :use entry: %S" entry))))))) (list (format "Invalid :use entry: %S" entry)))))))
(cond (let ((specs
((null value) nil) (cond
((or (symbolp value) (etaf-behavior-spec-p value)) ((null value) nil)
(list (resolve value))) ((or (symbolp value) (etaf-behavior-spec-p value))
((proper-list-p value) (mapcar #'resolve value)) (list (resolve value)))
(t ((proper-list-p value) (mapcar #'resolve value))
(signal 'etaf-behavior-error (t
(signal
'etaf-behavior-error
(list ":use must be a Behavior symbol, spec, or proper list")))))) (list ":use must be a Behavior symbol, spec, or proper list"))))))
(let (names)
(dolist (spec specs)
(let ((name (etaf-behavior-spec-name spec)))
(when (memq name names)
(signal 'etaf-behavior-error
(list (format "Duplicate Behavior on one Host: %S"
name))))
(push name names))))
specs)))
(defun etaf--runtime-target-value-equal-p (left right) (defun etaf--runtime-target-value-equal-p (left right)
"Compare LEFT and RIGHT with reactive/function identity rules." "Compare LEFT and RIGHT with reactive/function identity rules."
@ -1860,9 +1896,25 @@ need to know how Behavior attributes are merged."
"Attach current caller ownership to unowned normalized SLOTS." "Attach current caller ownership to unowned normalized SLOTS."
(mapcar (mapcar
(lambda (entry) (lambda (entry)
(let ((name (car entry)) (value (cdr entry))) (let* ((name (car entry)) (value (cdr entry))
;; Code-mode forwarding uses `etaf-current-slot', which exposes
;; the owned child list rather than the private SlotContent
;; wrapper. Recover the wrapper by spine identity so the
;; original author Component remains the lifecycle owner.
(forwarded-content
(cl-loop for forwarded in etaf--current-component-slots
for content = (cdr forwarded)
when (and (etaf--slot-content-p content)
value
(or (eq value
(etaf--slot-content-children content))
(equal-including-properties
value
(etaf--slot-content-children content))))
return content)))
(cond (cond
((etaf--slot-content-p value) entry) ((etaf--slot-content-p value) entry)
(forwarded-content (cons name forwarded-content))
((and (= (length value) 1) ((and (= (length value) 1)
(etaf--slot-projection-p (car value))) (etaf--slot-projection-p (car value)))
(let* ((projection (car value)) (let* ((projection (car value))
@ -2004,35 +2056,18 @@ need to know how Behavior attributes are merged."
(let ((etaf--current-semantic-parent-id (let ((etaf--current-semantic-parent-id
(or range-id etaf--current-semantic-parent-id)) (or range-id etaf--current-semantic-parent-id))
(etaf--current-range-item-index (etaf--current-range-item-index
(and old-range (or (and old-range
(etaf--semantic-range-item-identity-index old-range))) (etaf--semantic-range-item-identity-index
;; Material Components nested below an existing semantic old-range))
;; Range flatten their child Range sites into that outer etaf--current-range-item-index))
;; owner; Ebox must never receive nested descriptors. ;; Rendering below a retained Range changes only how this
;; Component publishes its own output. Descendant Range
;; anchors remain semantic children and are never folded
;; into their ancestor's identity.
(etaf--rendering-range-p (etaf--rendering-range-p
(or transparent-p etaf--rendering-range-p))) (or transparent-p etaf--rendering-range-p)))
(etaf--render-value-list rendered (etaf--render-value-list rendered
(append path (list :view)))))) (append path (list :view))))))
(let ((child-ids
(copy-sequence
(gethash range-id
(etaf-runtime-candidate-graph-children runtime)))))
(when (= (length child-ids) (length nodes))
(setq nodes
(cl-mapcan
(lambda (child-id node)
(let ((child
(gethash child-id
(etaf-runtime-candidate-graph-nodes runtime))))
(cond
((etaf--semantic-range-p child)
(copy-sequence
(etaf--runtime-range-nodes runtime child)))
((etaf--semantic-slot-range-p child)
(copy-sequence
(etaf--runtime-range-nodes runtime child)))
(t (list node)))))
child-ids nodes))))
(when (cl-some (lambda (node) (when (cl-some (lambda (node)
(memq node etaf--rendered-range-container-nodes)) (memq node etaf--rendered-range-container-nodes))
nodes) nodes)
@ -2480,19 +2515,6 @@ need to know how Behavior attributes are merged."
(let* ((name (etaf--semantic-host-name semantic)) (let* ((name (etaf--semantic-host-name semantic))
(props (copy-tree (etaf--semantic-host-props-signature semantic))) (props (copy-tree (etaf--semantic-host-props-signature semantic)))
(child-ids (etaf--semantic-host-child-ids semantic)) (child-ids (etaf--semantic-host-child-ids semantic))
(parent-semantic
(and (etaf--semantic-host-parent-id semantic)
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
(etaf--semantic-host-parent-id semantic))))
;; A semantic Range may contain one material Host anchor whose
;; descendants include another Range. Flatten that nested
;; semantic Range at the Renderer boundary so Ebox receives only
;; declarative children; the outer Range remains the publication
;; identity and ancestor invalidation still follows the graph.
(flatten-range-children-p
(or (etaf--semantic-range-p parent-semantic)
(etaf--semantic-slot-range-p parent-semantic)))
(content (content
(if (eq name 'text) (if (eq name 'text)
(if (etaf--semantic-host-content-parts semantic) (if (etaf--semantic-host-content-parts semantic)
@ -2510,30 +2532,20 @@ need to know how Behavior attributes are merged."
(etaf--semantic-host-content semantic))) (etaf--semantic-host-content semantic)))
(children (children
(unless (eq name 'text) (unless (eq name 'text)
(cl-mapcan (mapcar
(lambda (child-id) (lambda (child-id)
(let ((child (etaf--pvec-get (etaf--runtime-lower-semantic-artifact
(etaf-generation-semantic-nodes generation) runtime generation child-id))
child-id)))
(if (and flatten-range-children-p
(or (etaf--semantic-range-p child)
(etaf--semantic-slot-range-p child)))
(copy-sequence
(etaf--runtime-range-nodes runtime child))
(list
(etaf--runtime-lower-semantic-artifact
runtime generation child-id)))))
child-ids))) child-ids)))
(range-child-p (range-child-p
(and (not flatten-range-children-p) (cl-some
(cl-some (lambda (child-id)
(lambda (child-id) (let ((child (etaf--pvec-get
(let ((child (etaf--pvec-get (etaf-generation-semantic-nodes generation)
(etaf-generation-semantic-nodes generation) child-id)))
child-id))) (or (etaf--semantic-range-p child)
(or (etaf--semantic-range-p child) (etaf--semantic-slot-range-p child))))
(etaf--semantic-slot-range-p child)))) child-ids)))
child-ids))))
(etaf--lower-resolved-semantic-host (etaf--lower-resolved-semantic-host
name props content name props content
children range-child-p))) children range-child-p)))
@ -2743,7 +2755,13 @@ need to know how Behavior attributes are merged."
(copy-sequence (copy-sequence
(etaf--runtime-range-nodes runtime candidate)))))) (etaf--runtime-range-nodes runtime candidate))))))
(if (and old (if (and old
(not etaf--rendering-component-effect-p) ;; A parent Component may rerender because a preceding static
;; sibling changed while this direct Range did not. Its stable
;; site token and retained artifact are sufficient to reuse the
;; Range; a genuinely dirty Range effect still takes the render
;; branch below.
(not (etaf--runtime-range-must-refresh-for-component-input-p
expr))
(not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime)))) (not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime))))
(progn (progn
(puthash identity semantic-id (puthash identity semantic-id
@ -2771,9 +2789,13 @@ need to know how Behavior attributes are merged."
(etaf--runtime-keyed-range-snapshot expr)) (etaf--runtime-keyed-range-snapshot expr))
(setq value (setq value
(etaf--runtime-normalize-range-value (etaf--runtime-normalize-range-value
;; Keyed item renderers may intentionally return a
;; transparent Component span; ordinary direct Expr
;; ranges still fail closed on Component output.
(if keyed-snapshot (if keyed-snapshot
(etaf--keyed-program-outputs expr keyed-snapshot) (etaf--keyed-program-outputs expr keyed-snapshot)
(funcall (etaf--expr-thunk expr)))))) (funcall (etaf--expr-thunk expr)))
(not (null keyed-snapshot)))))
(puthash identity semantic-id (puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime)) (etaf-runtime-candidate-identity-entries runtime))
(etaf--runtime-candidate-add-child (etaf--runtime-candidate-add-child
@ -2805,6 +2827,7 @@ need to know how Behavior attributes are merged."
expr keyed-snapshot expr keyed-snapshot
(plist-get range-render :item-root-groups) (plist-get range-render :item-root-groups)
(plist-get range-render :item-node-counts))) (plist-get range-render :item-node-counts)))
(input (etaf--ebox-input-for-nodes nodes))
(record (record
(etaf--semantic-range-create (etaf--semantic-range-create
:semantic-id semantic-id :identity identity :effect-id effect-id :semantic-id semantic-id :identity identity :effect-id effect-id
@ -2845,8 +2868,18 @@ need to know how Behavior attributes are merged."
:semantic-id semantic-id :semantic-id semantic-id
:deps (etaf--semantic-range-deps record) :target expr) :deps (etaf--semantic-range-deps record) :target expr)
(etaf-runtime-candidate-effects runtime)) (etaf-runtime-candidate-effects runtime))
(puthash effect-id (etaf--ebox-input-for-nodes nodes) (puthash effect-id input
(etaf-runtime-candidate-range-artifacts runtime)) (etaf-runtime-candidate-range-artifacts runtime))
(when (and old
(not (ebox-canonical-input-equal-p
(etaf--runtime-committed-range-input runtime old)
input)))
(push (list old record
(etaf--runtime-committed-range-input runtime old)
input nil)
(etaf-runtime-candidate-eager-range-changes runtime))
(etaf--runtime-invalidate-range-ancestors runtime old)
(etaf--runtime-record-range-owner-update runtime old))
(cons 'range (cons 'range
(list (apply #'ebox-child-range range-ref nodes))))))))) (list (apply #'ebox-child-range range-ref nodes)))))))))
@ -3050,27 +3083,38 @@ The candidate uses resolved VALUE, DEPS, and NODES."
styled) styled)
item))) item)))
(defun etaf--runtime-normalize-range-value (value) (defun etaf--runtime-normalize-range-value (value &optional allow-components-p)
"Return Host/string RANGE VALUE with nested expr sites eagerly resolved." "Return normalized RANGE VALUE with nested Expr sites eagerly resolved.
When ALLOW-COMPONENTS-P is non-nil, keyed item boundaries may contain
Component calls whose retained output is owned by the keyed Range."
(cond (cond
((null value) nil) ((null value) nil)
((stringp value) (list value)) ((stringp value) (list value))
((or (etaf--component-call-p value) ((and allow-components-p
(etaf--slot-projection-p value)) (or (etaf--component-call-p value)
(etaf--slot-projection-p value)))
(list value)) (list value))
((etaf--expr-p value) ((etaf--expr-p value)
(etaf--runtime-normalize-range-value (funcall (etaf--expr-thunk value)))) (etaf--runtime-normalize-range-value
(funcall (etaf--expr-thunk value)) allow-components-p))
((etaf--view-node-p value) ((etaf--view-node-p value)
(if (eq (etaf--view-node-name value) 'fragment) (if (eq (etaf--view-node-name value) 'fragment)
(cl-mapcan #'etaf--runtime-normalize-range-value (cl-mapcan (lambda (child)
(etaf--runtime-normalize-range-value
child allow-components-p))
(etaf--view-node-children value)) (etaf--view-node-children value))
(let ((copy (copy-sequence value))) (let ((copy (copy-sequence value)))
(setf (etaf--view-node-children copy) (setf (etaf--view-node-children copy)
(cl-mapcan #'etaf--runtime-normalize-range-value (cl-loop for child in (etaf--view-node-children value)
(etaf--view-node-children value))) append
(etaf--runtime-normalize-range-value
child allow-components-p)))
(list copy)))) (list copy))))
((proper-list-p value) ((proper-list-p value)
(cl-mapcan #'etaf--runtime-normalize-range-value value)) (cl-mapcan (lambda (child)
(etaf--runtime-normalize-range-value
child allow-components-p))
value))
(t (t
(signal 'etaf-runtime-error (signal 'etaf-runtime-error
(list "Direct material expr requires Step4b output"))))) (list "Direct material expr requires Step4b output")))))
@ -3095,7 +3139,8 @@ The candidate uses resolved VALUE, DEPS, and NODES."
(defun etaf--runtime-keyed-range-keys (expr snapshot) (defun etaf--runtime-keyed-range-keys (expr snapshot)
"Return validated keys for EXPR aligned with keyed SNAPSHOT items." "Return validated keys for EXPR aligned with keyed SNAPSHOT items."
(or (plist-get snapshot :keys) (if (plist-member snapshot :keys)
(plist-get snapshot :keys)
(let ((key-function (etaf--expr-range-key expr))) (let ((key-function (etaf--expr-range-key expr)))
(unless (functionp key-function) (unless (functionp key-function)
(signal 'etaf-runtime-error (signal 'etaf-runtime-error
@ -3619,17 +3664,41 @@ Generation, including its effects and Host contributions."
(make-hash-table :test #'equal))) (make-hash-table :test #'equal)))
(identity-copy nil) (identity-copy nil)
(affected-sources (make-hash-table :test #'eq)) (affected-sources (make-hash-table :test #'eq))
(effect-map-shadow (make-hash-table :test #'eql))
(effect-sources-shadow (make-hash-table :test #'eql))
(source-effects-shadow (make-hash-table :test #'eql))
(missing-index-value (make-symbol "etaf-missing-index-value"))
deltas deltas
node-updates resource-updates) node-updates resource-updates
effect-map-update-ids effect-sources-update-ids
source-effects-update-ids)
(cl-labels (cl-labels
((install-effect ((index-value
(shadow root id kind)
(let ((value (gethash id shadow missing-index-value)))
(if (eq value missing-index-value)
(etaf--pvec-get root id metrics kind)
value)))
(stage-index-value
(shadow ids id value)
(let ((new-p (eq (gethash id shadow missing-index-value)
missing-index-value)))
(puthash id value shadow)
(if new-p (cons id ids) ids)))
(staged-index-entries
(shadow ids)
(mapcar (lambda (id) (cons id (gethash id shadow)))
(nreverse ids)))
(install-effect
(effect old-deps new-deps) (effect old-deps new-deps)
(let ((effect-id (etaf--generation-effect-effect-id effect))) (let ((effect-id (etaf--generation-effect-effect-id effect)))
(setq effect-map (setq effect-map-update-ids
(etaf--pvec-put effect-map effect-id effect metrics) (stage-index-value effect-map-shadow effect-map-update-ids
effect-sources effect-id effect)
(etaf--pvec-put effect-sources effect-id effect-sources-update-ids
(copy-sequence new-deps) metrics)) (stage-index-value effect-sources-shadow
effect-sources-update-ids effect-id
(copy-sequence new-deps)))
(dolist (source (cl-delete-duplicates (dolist (source (cl-delete-duplicates
(append (copy-sequence old-deps) (append (copy-sequence old-deps)
(copy-sequence new-deps)) (copy-sequence new-deps))
@ -3638,39 +3707,42 @@ Generation, including its effects and Host contributions."
(let* ((source-id (etaf-reactive-source-id source)) (let* ((source-id (etaf-reactive-source-id source))
(current-effects (current-effects
(copy-sequence (copy-sequence
(etaf--pvec-get source-effects source-id (index-value source-effects-shadow source-effects
metrics 'source))) source-id 'source)))
(new-effects (delq effect-id current-effects))) (new-effects (delq effect-id current-effects)))
(when (memq source new-deps) (when (memq source new-deps)
(setq new-effects (setq new-effects
(sort (cons effect-id new-effects) #'<))) (sort (cons effect-id new-effects) #'<)))
(unless (equal current-effects new-effects) (unless (equal current-effects new-effects)
(setq source-effects (setq source-effects-update-ids
(etaf--pvec-put source-effects source-id (stage-index-value source-effects-shadow
new-effects metrics))))))) source-effects-update-ids
source-id new-effects)))))))
(remove-effect (remove-effect
(effect-id) (effect-id)
(when-let* ((old-effect (when-let* ((old-effect
(and effect-map (index-value effect-map-shadow effect-map effect-id
(etaf--pvec-get effect-map effect-id metrics 'effect)))
'effect))))
(let ((deps (etaf--generation-effect-deps old-effect))) (let ((deps (etaf--generation-effect-deps old-effect)))
(setq effect-map (setq effect-map-update-ids
(etaf--pvec-put effect-map effect-id nil metrics) (stage-index-value effect-map-shadow effect-map-update-ids
effect-sources effect-id nil)
(etaf--pvec-put effect-sources effect-id nil metrics)) effect-sources-update-ids
(stage-index-value effect-sources-shadow
effect-sources-update-ids effect-id nil))
(dolist (source deps) (dolist (source deps)
(puthash source t affected-sources) (puthash source t affected-sources)
(let* ((source-id (etaf-reactive-source-id source)) (let* ((source-id (etaf-reactive-source-id source))
(current-effects (current-effects
(copy-sequence (copy-sequence
(etaf--pvec-get source-effects source-id metrics (index-value source-effects-shadow source-effects
'source))) source-id 'source)))
(new-effects (delq effect-id current-effects))) (new-effects (delq effect-id current-effects)))
(unless (equal current-effects new-effects) (unless (equal current-effects new-effects)
(setq source-effects (setq source-effects-update-ids
(etaf--pvec-put source-effects source-id (stage-index-value source-effects-shadow
new-effects metrics)))))))) source-effects-update-ids
source-id new-effects))))))))
(semantic-effect-ids (semantic-effect-ids
(semantic) (semantic)
(cond (cond
@ -3732,31 +3804,32 @@ Generation, including its effects and Host contributions."
(dolist (effect-id (etaf-runtime-candidate-removed-effect-ids runtime)) (dolist (effect-id (etaf-runtime-candidate-removed-effect-ids runtime))
(remove-effect effect-id)) (remove-effect effect-id))
(dolist (semantic-id (etaf-runtime-candidate-removed-semantic-ids runtime)) (dolist (semantic-id (etaf-runtime-candidate-removed-semantic-ids runtime))
(when-let* ((old-node (and base (let ((live-p
(etaf--pvec-get (gethash semantic-id
(etaf-generation-semantic-nodes base) (etaf-runtime-candidate-graph-nodes runtime))))
semantic-id)))) ;; Replacement may reintroduce a stable descendant below a new
;; A stable identity may be reintroduced in this candidate. In that ;; ancestor. Candidate liveness wins over the old subtree's removal
;; case its new effect is installed below; only remove effects for a ;; journal for both the node and its effects.
;; semantic node that is absent from the candidate graph. (unless live-p
(unless (gethash semantic-id (when-let* ((old-node (and base
(etaf-runtime-candidate-graph-nodes runtime)) (etaf--pvec-get
(dolist (effect-id (semantic-effect-ids old-node)) (etaf-generation-semantic-nodes base)
(remove-effect effect-id))) semantic-id))))
(when (and (etaf--semantic-host-p old-node) (dolist (effect-id (semantic-effect-ids old-node))
(etaf--semantic-host-host-ref old-node)) (remove-effect effect-id))
(let ((host-ref (etaf--semantic-host-host-ref old-node))) (when (and (etaf--semantic-host-p old-node)
;; A dirty Component may remove and recreate the same stable (etaf--semantic-host-host-ref old-node))
;; Host address in one candidate. The new contribution wins; (let ((host-ref (etaf--semantic-host-host-ref old-node)))
;; do not leave a removal tombstone that shadows it. (unless (or
(unless (or (gethash host-ref (gethash host-ref
(etaf-runtime-candidate-host-props runtime)) (etaf-runtime-candidate-host-props runtime))
(gethash host-ref (gethash host-ref
(etaf-runtime-candidate-handlers runtime))) (etaf-runtime-candidate-handlers runtime)))
(cl-pushnew host-ref (cl-pushnew
(etaf-runtime-candidate-removed-host-refs runtime) host-ref
:test #'equal))))) (etaf-runtime-candidate-removed-host-refs runtime)
(push (cons semantic-id nil) node-updates)) :test #'equal)))))
(push (cons semantic-id nil) node-updates))))
(maphash (maphash
(lambda (identity semantic-id) (lambda (identity semantic-id)
(unless (gethash identity identity-index) (unless (gethash identity identity-index)
@ -3800,7 +3873,24 @@ Generation, including its effects and Host contributions."
;; Apply all semantic/index membership edits in one trie batch. The ;; Apply all semantic/index membership edits in one trie batch. The
;; candidate remains immutable; only the number of copied persistent ;; candidate remains immutable; only the number of copied persistent
;; vector spines changes. ;; vector spines changes.
(setq nodes (setq effect-map
(etaf--pvec-put-many effect-map
(staged-index-entries
effect-map-shadow effect-map-update-ids)
metrics)
effect-sources
(etaf--pvec-put-many effect-sources
(staged-index-entries
effect-sources-shadow
effect-sources-update-ids)
metrics)
source-effects
(etaf--pvec-put-many source-effects
(staged-index-entries
source-effects-shadow
source-effects-update-ids)
metrics)
nodes
(etaf--pvec-put-many nodes node-updates metrics) (etaf--pvec-put-many nodes node-updates metrics)
resources resources
(etaf--pvec-put-many resources resource-updates metrics)) (etaf--pvec-put-many resources resource-updates metrics))
@ -4107,64 +4197,46 @@ removed inside the same rollback journal."
(defun etaf--runtime-evaluate-component-input (runtime semantic) (defun etaf--runtime-evaluate-component-input (runtime semantic)
"Recompute RUNTIME SEMANTIC input and enqueue render only when it differs." "Recompute RUNTIME SEMANTIC input and enqueue render only when it differs."
(let* ((generation (etaf-runtime-current-generation runtime)) (let* ((caller-id (etaf--semantic-component-caller-component-id semantic))
(caller-id (etaf--semantic-component-caller-component-id semantic))
(base-caller
(and caller-id
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
caller-id)))
(caller
(and base-caller
(or (gethash (etaf--semantic-component-identity base-caller)
(etaf-runtime-candidate-semantic-nodes runtime))
base-caller)))
(instance
(and caller
(gethash (etaf--semantic-component-resource-key caller)
(etaf-runtime-resource-registry runtime))))
deps) deps)
(let ((etaf--runtime-dependency-collector (etaf--runtime-call-with-component-env
(lambda (source) (cl-pushnew source deps :test #'eq))) runtime caller-id
(etaf--current-runtime runtime) (lambda ()
(etaf--current-component-instance instance) (let ((etaf--runtime-dependency-collector
(etaf--current-component-identity (lambda (source) (cl-pushnew source deps :test #'eq)))
(and caller (etaf--semantic-component-identity caller))) (etaf--active-effect nil)
(etaf--current-component-semantic-id caller-id) (etaf--render-phase-p t))
(etaf--current-component-props (let* ((props (etaf--resolve-property-plist
(and caller (etaf--semantic-component-props caller))) (etaf--semantic-component-input-props semantic)))
(etaf--current-component-slots (attrs (etaf--resolve-property-plist
(and caller (etaf--semantic-component-slots caller))) (etaf--semantic-component-input-attrs semantic)))
(etaf--current-context (slots (etaf--semantic-component-input-slots semantic))
(and caller (etaf--semantic-component-context-frame caller))) (candidate (copy-sequence semantic))
(etaf--active-effect nil) (effect-id
(etaf--render-phase-p t)) (etaf--semantic-component-input-effect-id semantic)))
(let* ((props (etaf--resolve-property-plist (setf (etaf--semantic-component-props candidate) (copy-tree props)
(etaf--semantic-component-input-props semantic))) (etaf--semantic-component-attrs candidate) (copy-tree attrs)
(attrs (etaf--resolve-property-plist (etaf--semantic-component-slots candidate) (copy-tree slots)
(etaf--semantic-component-input-attrs semantic))) (etaf--semantic-component-input-deps candidate)
(slots (etaf--semantic-component-input-slots semantic)) (nreverse deps))
(candidate (copy-sequence semantic)) (puthash (etaf--semantic-component-identity semantic) candidate
(effect-id (etaf--semantic-component-input-effect-id semantic))) (etaf-runtime-candidate-semantic-nodes runtime))
(setf (etaf--semantic-component-props candidate) (copy-tree props) (puthash effect-id
(etaf--semantic-component-attrs candidate) (copy-tree attrs) (etaf--generation-effect-create
(etaf--semantic-component-slots candidate) (copy-tree slots) :effect-id effect-id :kind 'component-input
(etaf--semantic-component-input-deps candidate) (nreverse deps)) :semantic-id
(puthash (etaf--semantic-component-identity semantic) candidate (etaf--semantic-component-semantic-id semantic)
(etaf-runtime-candidate-semantic-nodes runtime)) :deps (etaf--semantic-component-input-deps candidate))
(puthash effect-id (etaf-runtime-candidate-effects runtime))
(etaf--generation-effect-create (unless
:effect-id effect-id :kind 'component-input (and (etaf--runtime-target-value-equal-p
:semantic-id (etaf--semantic-component-semantic-id semantic) props (etaf--semantic-component-props semantic))
:deps (etaf--semantic-component-input-deps candidate)) (etaf--runtime-target-value-equal-p
(etaf-runtime-candidate-effects runtime)) attrs (etaf--semantic-component-attrs semantic))
(unless (and (etaf--runtime-target-value-equal-p (etaf--runtime-target-value-equal-p
props (etaf--semantic-component-props semantic)) slots (etaf--semantic-component-slots semantic)))
(etaf--runtime-target-value-equal-p (etaf--runtime-enqueue-effect
attrs (etaf--semantic-component-attrs semantic)) runtime (etaf--semantic-component-effect-id semantic)))))))))
(etaf--runtime-target-value-equal-p
slots (etaf--semantic-component-slots semantic)))
(etaf--runtime-enqueue-effect
runtime (etaf--semantic-component-effect-id semantic)))))))
(defun etaf--runtime-retarget-component-slot-ranges (runtime semantic slots) (defun etaf--runtime-retarget-component-slot-ranges (runtime semantic slots)
"Retarget SEMANTIC projection slot effects to candidate SLOTS in RUNTIME." "Retarget SEMANTIC projection slot effects to candidate SLOTS in RUNTIME."
@ -4579,6 +4651,22 @@ the range is not eligible for keyed incremental rendering."
(cl-pushnew (cons (etaf-context-owner-id frame) key) (cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal))) context-deps :test #'equal)))
(etaf--render-runtime runtime) (etaf--render-runtime runtime)
(etaf--current-runtime runtime)
(etaf--current-component-instance instance)
(etaf--current-component-state
(etaf--component-instance-state instance))
(etaf--current-component-setup-defined-p
(not (null (etaf--component-spec-setup
(etaf--component-instance-spec instance)))))
(etaf--current-component-setup-complete-p
(etaf--component-instance-setup-complete-p instance))
(etaf--component-phase 'render)
(etaf--current-component-identity
(etaf--semantic-component-identity component))
(etaf--current-component-props
(etaf--semantic-component-props component))
(etaf--current-component-slots
(etaf--semantic-component-slots component))
(etaf--current-context (etaf--current-context
(etaf--semantic-component-context-frame component)) (etaf--semantic-component-context-frame component))
(etaf--current-component-semantic-id (etaf--current-component-semantic-id
@ -4658,7 +4746,8 @@ the range is not eligible for keyed incremental rendering."
(etaf-runtime-candidate-graph-children runtime)))) (etaf-runtime-candidate-graph-children runtime))))
(value (value
(etaf--runtime-normalize-range-value (etaf--runtime-normalize-range-value
(funcall item-function item context))) (funcall item-function item context)
t))
(rendered (rendered
(etaf--render-value-list (etaf--render-value-list
value value
@ -4687,7 +4776,11 @@ the range is not eligible for keyed incremental rendering."
:item-node-counts (nreverse item-node-counts) :item-node-counts (nreverse item-node-counts)
:deps (nreverse deps) :deps (nreverse deps)
:context-deps (nreverse context-deps) :context-deps (nreverse context-deps)
:reuse-map (nreverse reuse-map))))))))) :reuse-map (nreverse reuse-map)
;; Ebox validates every non-reused slot against this input's
;; source generation; reused slots are replaced by their
;; exact published objects from the explicit reuse map.
:retain-item-identities-p t))))))))
(defun etaf--runtime-render-dirty-range (runtime effect range) (defun etaf--runtime-render-dirty-range (runtime effect range)
"Evaluate RUNTIME dirty RANGE EFFECT without running its Component owner." "Evaluate RUNTIME dirty RANGE EFFECT without running its Component owner."
@ -4748,32 +4841,32 @@ the range is not eligible for keyed incremental rendering."
(etaf--runtime-normalize-range-value (etaf--runtime-normalize-range-value
(funcall (etaf--expr-thunk (funcall (etaf--expr-thunk
(etaf--generation-effect-target effect)))))) (etaf--generation-effect-target effect))))))
(let ((etaf--runtime-dependency-collector collector) ;; Lowering may resolve property expressions on Component calls
(etaf--context-inject-recorder ;; produced by the Range. Keep the lexical Component environment for
(lambda (frame key) ;; both normalization and lowering; otherwise prop symbol macros read
(cl-pushnew (cons (etaf-context-owner-id frame) key) ;; an empty dynamic environment during an independent Range update.
context-deps :test #'equal))) (etaf--runtime-call-with-component-env
(etaf--render-runtime runtime) runtime (etaf--semantic-range-component-id range)
;; Static style tokens are lowered in this second pass. Preserve (lambda ()
;; only the owning Context frame needed by Theme resolution; the (let ((etaf--runtime-dependency-collector collector)
;; range semantic ids below already provide the runtime lowering (etaf--context-inject-recorder
;; identity, and the other Component bindings belong to the value (lambda (frame key)
;; normalization pass above. (cl-pushnew (cons (etaf-context-owner-id frame) key)
(etaf--current-context context-deps :test #'equal)))
(etaf--semantic-component-context-frame component)) (etaf--render-runtime runtime)
(etaf--current-component-semantic-id (etaf--current-component-semantic-id
(etaf--semantic-range-component-id range)) (etaf--semantic-range-component-id range))
(etaf--current-semantic-parent-id (etaf--current-semantic-parent-id
(etaf--semantic-range-semantic-id range)) (etaf--semantic-range-semantic-id range))
(etaf--current-range-item-index (etaf--current-range-item-index
(etaf--semantic-range-item-identity-index range)) (etaf--semantic-range-item-identity-index range))
(etaf--rendering-range-p t) (etaf--rendering-range-p t)
(etaf--active-effect nil) (etaf--active-effect nil)
(etaf--render-phase-p t) (etaf--render-phase-p t)
(etaf--render-style-stack (etaf--render-style-stack
(copy-tree (etaf--semantic-range-caller-style-stack range)))) (copy-tree (etaf--semantic-range-caller-style-stack range))))
(setq nodes (etaf--render-value-list (setq nodes (etaf--render-value-list
value (etaf--semantic-range-path range)))))) value (etaf--semantic-range-path range))))))))
(let* ((item-root-ids (let* ((item-root-ids
(copy-sequence (copy-sequence
(gethash (etaf--semantic-range-semantic-id range) (gethash (etaf--semantic-range-semantic-id range)
@ -4838,7 +4931,12 @@ the range is not eligible for keyed incremental rendering."
(list range candidate (list range candidate
(etaf--runtime-committed-range-input runtime range) (etaf--runtime-committed-range-input runtime range)
(etaf--runtime-range-input runtime candidate) (etaf--runtime-range-input runtime candidate)
(plist-get keyed :reuse-map))))))) (plist-get keyed :reuse-map)
;; A keyed render with no reused item owns every payload node in
;; this candidate source generation. Ebox rechecks that proof
;; before retaining identity; other Range paths keep copy-based
;; fallback semantics.
(plist-get keyed :retain-item-identities-p)))))))
(defun etaf--runtime-record-range-owner-update (runtime range) (defun etaf--runtime-record-range-owner-update (runtime range)
"Record RANGE's lexical Component lifecycle participation in RUNTIME." "Record RANGE's lexical Component lifecycle participation in RUNTIME."
@ -4969,6 +5067,110 @@ the range is not eligible for keyed incremental rendering."
(and ref (and ref
(ebox-range-ref-present-p (etaf-runtime-buffer runtime) ref)))) (ebox-range-ref-present-p (etaf-runtime-buffer runtime) ref))))
(defun etaf--runtime-range-direct-node-signature
(runtime generation semantic-id candidate-p)
"Return SEMANTIC-ID's direct material signature.
When CANDIDATE-P is non-nil, read the candidate overlay before GENERATION.
Nested Range identity is retained, but its internal artifact is deliberately
excluded so descendant-only work cannot masquerade as an ancestor change."
(let ((semantic
(or (and candidate-p
(gethash semantic-id
(etaf-runtime-candidate-graph-nodes runtime)))
(etaf--pvec-get
(etaf-generation-semantic-nodes generation) semantic-id))))
(cond
((etaf--semantic-host-p semantic)
(list 'host
(etaf--semantic-host-identity semantic)
(etaf--semantic-host-name semantic)
(etaf--semantic-host-props-signature semantic)
(etaf--semantic-host-content semantic)
(mapcar
(lambda (part)
(if (integerp part)
(etaf--runtime-range-direct-node-signature
runtime generation part candidate-p)
part))
(etaf--semantic-host-content-parts semantic))
(mapcar
(lambda (child-id)
(etaf--runtime-range-direct-node-signature
runtime generation child-id candidate-p))
(etaf--semantic-host-child-ids semantic))))
((etaf--semantic-component-p semantic)
(list 'component
(etaf--semantic-component-identity semantic)
(etaf--semantic-component-publication-kind semantic)
(mapcar
(lambda (child-id)
(etaf--runtime-range-direct-node-signature
runtime generation child-id candidate-p))
(etaf--semantic-component-child-ids semantic))))
((or (etaf--semantic-range-p semantic)
(etaf--semantic-slot-range-p semantic))
(list 'range-anchor
(etaf--semantic-backend-range-semantic-id semantic)
(etaf--semantic-backend-range-ref semantic)))
((etaf--semantic-inline-range-p semantic)
(list 'inline (etaf--semantic-inline-range-output semantic)))
(t (list 'missing semantic-id)))))
(defun etaf--runtime-range-direct-payload-equal-p
(runtime generation old candidate)
"Return whether OLD and CANDIDATE own the same direct Range payload."
(and (equal
(etaf--semantic-backend-range-item-root-ids old)
(etaf--semantic-backend-range-item-root-ids candidate))
(equal-including-properties
(mapcar
(lambda (semantic-id)
(etaf--runtime-range-direct-node-signature
runtime generation semantic-id nil))
(etaf--semantic-backend-range-item-root-ids old))
(mapcar
(lambda (semantic-id)
(etaf--runtime-range-direct-node-signature
runtime generation semantic-id t))
(etaf--semantic-backend-range-item-root-ids candidate)))))
(defun etaf--runtime-normalize-range-changes (runtime generation changes)
"Return non-overlapping CHANGES ordered as originally staged.
An ancestor absorbs descendants only when its own direct material payload
changed. If its root identity/cardinality and direct payload are stable, its
staged artifact differs solely because it contains a descendant candidate;
drop that ancestor and publish the deepest direct change instead."
(let ((changed (make-hash-table :test #'eql))
(direct-changed (make-hash-table :test #'eql))
normalized)
(dolist (change changes)
(when-let* ((range (car change)))
(puthash (etaf--semantic-backend-range-semantic-id range)
change changed)))
(maphash
(lambda (semantic-id change)
(unless (etaf--runtime-range-direct-payload-equal-p
runtime generation (car change) (cadr change))
(puthash semantic-id t direct-changed)))
changed)
(dolist (change changes)
(let* ((range (car change))
(semantic-id
(etaf--semantic-backend-range-semantic-id range))
(parent-id (etaf--generation-parent-id generation semantic-id))
absorbed-p)
(while (and parent-id (not absorbed-p))
(when (gethash parent-id direct-changed)
(setq absorbed-p t))
(unless absorbed-p
(setq parent-id
(etaf--generation-parent-id generation parent-id))))
(unless (or absorbed-p
(not (gethash semantic-id direct-changed))
(not (eq change (gethash semantic-id changed))))
(push change normalized))))
(nreverse normalized)))
(defun etaf--runtime-invalidate-semantic-ancestors (runtime parent-id) (defun etaf--runtime-invalidate-semantic-ancestors (runtime parent-id)
"Invalidate RUNTIME artifacts from PARENT-ID through semantic ancestors." "Invalidate RUNTIME artifacts from PARENT-ID through semantic ancestors."
(let* ((generation (etaf-runtime-current-generation runtime)) (let* ((generation (etaf-runtime-current-generation runtime))
@ -5132,7 +5334,35 @@ RENDERED-IDENTITIES names the Component render participants."
runtime old base-semantic)) runtime old base-semantic))
(pcase (etaf--generation-effect-kind effect) (pcase (etaf--generation-effect-kind effect)
('component-input ('component-input
(etaf--runtime-evaluate-component-input runtime semantic)) (etaf--runtime-evaluate-component-input runtime semantic)
;; Input evaluation may enqueue the Component render while
;; lower-priority inline/Range effects are already waiting
;; in this turn. Restore the priority order immediately
;; so the render observes the final input before those
;; effects can seed a stale candidate.
(setf (etaf-runtime-dirty-effect-queue runtime)
(etaf--runtime-sort-dirty-effects
old
(etaf-runtime-dirty-effect-queue runtime))
(etaf-runtime-dirty-effect-queue-tail runtime)
(last (etaf-runtime-dirty-effect-queue runtime)))
;; `component-render' deliberately keeps its historical
;; sort class for the public priority contract, but a
;; render created by this input update must run before an
;; already queued child Range/inline effect. Move only
;; this known dependent to the front of the remaining
;; turn; the ordinary FIFO remains unchanged otherwise.
(let ((render-id
(etaf--semantic-component-effect-id semantic)))
(when (gethash render-id
(etaf-runtime-dirty-effect-ids runtime))
(setf (etaf-runtime-dirty-effect-queue runtime)
(cons
render-id
(delq render-id
(etaf-runtime-dirty-effect-queue runtime)))
(etaf-runtime-dirty-effect-queue-tail runtime)
(last (etaf-runtime-dirty-effect-queue runtime))))))
('component-render ('component-render
(unless (member (etaf--semantic-component-identity semantic) (unless (member (etaf--semantic-component-identity semantic)
(etaf-runtime-candidate-rendered-identities (etaf-runtime-candidate-rendered-identities
@ -5170,37 +5400,6 @@ RENDERED-IDENTITIES names the Component render participants."
(ebox-canonical-input-equal-p (ebox-canonical-input-equal-p
(nth 2 change) (nth 3 change))) (nth 2 change) (nth 3 change)))
range-changes)) range-changes))
;; A semantic Range may be nested below a material Component whose
;; backend publication exposes only the ancestor component-output anchor.
;; Never submit an address that Ebox cannot resolve against this base;
;; discard the local candidate and let the next branch publish one exact
;; root candidate. This is a proof miss, not an exception path.
(let (fallback-component-effect-ids fallback-p)
(dolist (change range-changes)
(unless (etaf--runtime-range-change-has-backend-anchor-p
runtime change)
(setq fallback-p t)
(when-let* ((range (car change))
(component-id
(etaf--semantic-backend-range-container-component-id
range))
(component
(etaf--pvec-get
(etaf-generation-semantic-nodes old) component-id)))
(cl-pushnew
(etaf--semantic-component-effect-id component)
fallback-component-effect-ids :test #'eql))))
(when fallback-p
;; Re-render the material owner during the root fallback. A root
;; rebuild may otherwise carry its old artifact and leave the source
;; value visually stale even though the invalid Range was discarded.
(etaf--runtime-mark-root-dirty runtime)
(etaf--runtime-clear-dirty-effects runtime)
(dolist (effect-id fallback-component-effect-ids)
(puthash effect-id t (etaf-runtime-dirty-effect-ids runtime)))
(etaf--runtime-dispose-created-candidate runtime)
(etaf--runtime-clear-candidate runtime)
(cl-return-from etaf--runtime-component-overlay :root-fallback)))
(let (material-changes) (let (material-changes)
(dolist (change changes) (dolist (change changes)
(let ((candidate (car change))) (let ((candidate (car change)))
@ -5250,6 +5449,39 @@ RENDERED-IDENTITIES names the Component render participants."
(member (etaf--semantic-component-identity component) (member (etaf--semantic-component-identity component)
backend-component-identities))) backend-component-identities)))
range-changes)) range-changes))
(setq range-changes
(etaf--runtime-normalize-range-changes runtime old range-changes))
;; A semantic Range may be nested below a material Component whose
;; backend publication exposes only the ancestor component-output anchor.
;; Never submit an address that Ebox cannot resolve against this base;
;; discard the local candidate and let the next branch publish one exact
;; root candidate. This is a proof miss, not an exception path.
(let (fallback-component-effect-ids fallback-p)
(dolist (change range-changes)
(unless (etaf--runtime-range-change-has-backend-anchor-p
runtime change)
(setq fallback-p t)
(when-let* ((range (car change))
(component-id
(etaf--semantic-backend-range-container-component-id
range))
(component
(etaf--pvec-get
(etaf-generation-semantic-nodes old) component-id)))
(cl-pushnew
(etaf--semantic-component-effect-id component)
fallback-component-effect-ids :test #'eql))))
(when fallback-p
;; Re-render the material owner during the root fallback. A root
;; rebuild may otherwise carry its old artifact and leave the source
;; value visually stale even though the invalid Range was discarded.
(etaf--runtime-mark-root-dirty runtime)
(etaf--runtime-clear-dirty-effects runtime)
(dolist (effect-id fallback-component-effect-ids)
(puthash effect-id t (etaf-runtime-dirty-effect-ids runtime)))
(etaf--runtime-dispose-created-candidate runtime)
(etaf--runtime-clear-candidate runtime)
(cl-return-from etaf--runtime-component-overlay :root-fallback)))
(setq candidate-generation (etaf--runtime-build-generation runtime old) (setq candidate-generation (etaf--runtime-build-generation runtime old)
;; Component artifacts are first produced while dirty effects are ;; Component artifacts are first produced while dirty effects are
;; still being evaluated. Rebuild material publication roots from ;; still being evaluated. Rebuild material publication roots from
@ -5313,9 +5545,20 @@ RENDERED-IDENTITIES names the Component render participants."
(ebox-canonical-input-root-host-ref (nth 1 change)) (ebox-canonical-input-root-host-ref (nth 1 change))
(nth 2 change))) (nth 2 change)))
(dolist (change range-changes) (dolist (change range-changes)
(ebox-candidate-replace-range-ref (let ((reuse-map (nth 4 change))
candidate (etaf--semantic-backend-range-ref (car change)) (retain-item-identities-p (nth 5 change)))
(nth 3 change) (nth 4 change))) ;; Keep the optional identity-retention flag off the call
;; when it is not needed. Besides avoiding an unnecessary
;; argument on the common path, this preserves the stable
;; three/four-argument integration boundary for callers
;; which only observe ordinary Range replacement.
(if retain-item-identities-p
(ebox-candidate-replace-range-ref
candidate (etaf--semantic-backend-range-ref (car change))
(nth 3 change) reuse-map retain-item-identities-p)
(ebox-candidate-replace-range-ref
candidate (etaf--semantic-backend-range-ref (car change))
(nth 3 change) reuse-map))))
(dolist (change inline-changes) (dolist (change inline-changes)
(ebox-candidate-replace-host-ref (ebox-candidate-replace-host-ref
candidate (etaf--semantic-host-host-ref (car change)) candidate (etaf--semantic-host-host-ref (car change))

9
etaf-view.el
View File

@ -776,8 +776,8 @@ Return `(BUSINESS ATTRS)'. `:key' remains framework-owned input metadata."
(when (gethash domain attr-domains) (when (gethash domain attr-domains)
(etaf--component-error (etaf--component-error
"Duplicate Component Host attribute domain: %S" key)) "Duplicate Component Host attribute domain: %S" key))
(puthash domain t attr-domains)) (puthash domain t attr-domains)
(setq attrs (append attrs (list key value)))) (setq attrs (append attrs (list domain value)))))
(t (t
(etaf--component-error (etaf--component-error
"Unknown prop or Host attribute %S for Component %S" "Unknown prop or Host attribute %S for Component %S"
@ -794,6 +794,11 @@ Return `(BUSINESS ATTRS)'. `:key' remains framework-owned input metadata."
"Return non-nil when VALUE is one already validated View child." "Return non-nil when VALUE is one already validated View child."
(or (null value) (or (null value)
(stringp value) (stringp value)
;; Code-mode setup may retain a structural program (for example, a
;; direct Range expression) and pass that opaque value to `etaf-node'.
;; It is still validated and interpreted only at the renderer boundary;
;; arbitrary lists remain rejected here.
(etaf--expr-p value)
(etaf--view-node-p value) (etaf--view-node-p value)
(etaf--component-call-p value) (etaf--component-call-p value)
(etaf--slot-projection-p value))) (etaf--slot-projection-p value)))

138
examples/etaf-counter-example.el
View File

@ -25,67 +25,25 @@
('reset 0) ('reset 0)
(_ (user-error "Unknown counter operation: %S" operation))))) (_ (user-error "Unknown counter operation: %S" operation)))))
(defun etaf-counter-example--header (title) (etaf-define-component etaf-counter-example-action
"Return the counter header for TITLE." (&key count label operation)
(etaf-view "Render one semantic counter action."
(box :class "hero" :view
(column (box :class "action" :role 'button :use (list (etaf-focusable))
(text :class "eyebrow" "BEST PRACTICE / RETAINED STATE") :on-press
(text :font-weight 'bold (expr :value title)) (let ((cell count) (next-operation operation))
(text :color "#66706A" (lambda ()
"State belongs to setup; rendering only reads it."))))) (etaf-dispatch 'etaf-counter-example-update
cell next-operation)))
(defun etaf-counter-example--metrics (count double status) (text (expr label)))
"Return metric cards for COUNT, DOUBLE, and STATUS." :styles
(etaf-view (styles
(flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12)) ("&" :flex-grow 1 :flex-shrink 1 :flex-basis (160)
(box :class "metric" :min-width (140) :padding (1 (12)) :border "#4E7890"
(text (expr :value (format "COUNT %d" (etaf-value count))))) :bgcolor "#D9EAF2" :text-align center :font-weight bold)))
(box :class "metric"
(text (expr :value (format "DOUBLE %d" (etaf-value double)))))
(box :class "metric"
(text (expr :value (format "STATE %s" (etaf-value status))))))))
(defun etaf-counter-example--action (count label host-ref operation)
"Return one COUNT action named LABEL using HOST-REF and OPERATION."
(etaf-view
(box :class "action" :ref host-ref :role 'button
:use (list (etaf-focusable))
:on-press (lambda ()
(etaf-dispatch 'etaf-counter-example-update
count operation))
(text (expr :value label)))))
(defun etaf-counter-example--actions (count)
"Return the action group for COUNT."
(etaf-view
(flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12))
(expr :value
(etaf-counter-example--action
count "− DECREMENT" 'counter-decrement 'decrement))
(expr :value
(etaf-counter-example--action
count "RESET" 'counter-reset 'reset))
(expr :value
(etaf-counter-example--action
count "+ INCREMENT" 'counter-increment 'increment)))))
(etaf-define-component etaf-counter-example-card (&key title initial-value) (etaf-define-component etaf-counter-example-card (&key title initial-value)
"Render a retained counter named TITLE starting at INITIAL-VALUE." "Render a retained counter named TITLE starting at INITIAL-VALUE."
:styles
(styles
("&" :width (680) :color "#252A2E" :bgcolor "#F8F5EE")
(".hero" :width (680) :padding (1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align center)
(".eyebrow" :color "#8F432F" :font-weight bold)
(".metric" :flex-grow 1 :flex-shrink 1 :flex-basis (200)
:min-width (180) :padding (1 (14)) :border "#6D8A73"
:bgcolor "#DCEBDD" :text-align center)
(".action" :flex-grow 1 :flex-shrink 1 :flex-basis (160)
:min-width (140) :padding (1 (12)) :border "#4E7890"
:bgcolor "#D9EAF2" :text-align center :font-weight bold)
(".note" :width (680) :padding (1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2"))
:setup :setup
(let* ((count (etaf-ref (or initial-value 0) :name 'counter)) (let* ((count (etaf-ref (or initial-value 0) :name 'counter))
(double (etaf-computed (double (etaf-computed
@ -95,19 +53,57 @@
(lambda () (lambda ()
(if (zerop (etaf-value count)) "READY" "ACTIVE")) (if (zerop (etaf-value count)) "READY" "ACTIVE"))
:name 'counter-status))) :name 'counter-status)))
(lambda () (list :count count :double double :status status))
(etaf-view :view
(column (column
(expr :value (etaf-counter-example--header title)) (box :class "hero"
(box :height 1) (column
(expr :value (text :class "eyebrow" "BEST PRACTICE / RETAINED STATE")
(etaf-counter-example--metrics count double status)) (text :font-weight 'bold (expr title))
(box :height 1) (text :color "#66706A"
(expr :value (etaf-counter-example--actions count)) "State belongs to setup; rendering only reads it.")))
(box :height 1) (box :height 1)
(box :class "note" (flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12))
(text (box :class "metric"
"Public path: Event → Action → Ref → Computed → Runtime commit"))))))) (text (expr
(format "COUNT %d"
(etaf-value (plist-get (etaf-state) :count))))))
(box :class "metric"
(text (expr
(format "DOUBLE %d"
(etaf-value (plist-get (etaf-state) :double))))))
(box :class "metric"
(text (expr
(format "STATE %s"
(etaf-value (plist-get (etaf-state) :status)))))))
(box :height 1)
(flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12))
(etaf-counter-example-action
:ref 'counter-decrement
:count (plist-get (etaf-state) :count)
:label "− DECREMENT" :operation 'decrement)
(etaf-counter-example-action
:ref 'counter-reset
:count (plist-get (etaf-state) :count)
:label "RESET" :operation 'reset)
(etaf-counter-example-action
:ref 'counter-increment
:count (plist-get (etaf-state) :count)
:label "+ INCREMENT" :operation 'increment))
(box :height 1)
(box :class "note"
(text "Public path: Event → Action → Ref → Computed → Runtime commit")))
:styles
(styles
("&" :width (680) :color "#252A2E" :bgcolor "#F8F5EE")
(".hero" :width (680) :padding (1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align center)
(".eyebrow" :color "#8F432F" :font-weight bold)
(".metric" :flex-grow 1 :flex-shrink 1 :flex-basis (200)
:min-width (180) :padding (1 (14)) :border "#6D8A73"
:bgcolor "#DCEBDD" :text-align center)
(".note" :width (680) :padding (1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2")))
;;;###autoload ;;;###autoload
(defun etaf-counter-example-view () (defun etaf-counter-example-view ()

213
examples/etaf-data-example.el
View File

@ -45,109 +45,53 @@
(etaf-data-set-query controller query) (etaf-data-set-query controller query)
(etaf-data-load controller)) (etaf-data-load controller))
(defun etaf-data-example--row (controller task) (etaf-define-component etaf-data-example-row (&key controller task)
"Return one TASK row bound to CONTROLLER." "Render one retained TASK row from CONTROLLER."
(let* ((identity (plist-get task :id)) :view
(selected (etaf-data-selected-p controller identity)) (flex :width '(718) :flex-flow '(row nowrap) :gap '(0 (10))
(status (plist-get task :status)) :padding '(1 (12)) :border "#6D8A73"
(host-ref (intern (format "data-task-%d" identity)))) :bgcolor
(etaf-view (if (etaf-value
(flex :width '(718) :flex-flow '(row nowrap) :gap '(0 (10)) (etaf-data-selected-ref controller (plist-get task :id)))
:padding '(1 (12)) :border "#6D8A73" "#DCEBDD" "#FFFDF8")
:bgcolor (if selected "#DCEBDD" "#FFFDF8") :role 'button :use (list (etaf-focusable))
:ref host-ref :role 'button :use (list (etaf-focusable)) :on-press
:on-press (lambda () (let ((data-controller controller)
(etaf-dispatch 'etaf-data-example-toggle (identity (plist-get task :id)))
controller identity)) (lambda ()
(box :width '(36) :font-weight 'bold (etaf-dispatch 'etaf-data-example-toggle
:color (if selected "#2F6B43" "#8D887F") data-controller identity)))
(text (expr :value (if selected "●" "○")))) (box :width '(36) :font-weight 'bold
(box :flex-grow 1 :flex-shrink 1 :flex-basis '(390) :color
:min-width '(280) (if (etaf-value
(text (expr :value (plist-get task :title)))) (etaf-data-selected-ref controller (plist-get task :id)))
(box :width '(96) :color "#66706A" "#2F6B43" "#8D887F")
(text (expr :value (plist-get task :owner))))
(box :width '(84) :font-weight 'bold :text-align 'right
:color (if (eq status 'done) "#2F6B43" "#9B4A34")
(text (expr :value (upcase (symbol-name status)))))))))
(defun etaf-data-example--header (controller)
"Return the summary header for CONTROLLER."
(let ((total (etaf-value (etaf-data-total controller)))
(selection (etaf-value (etaf-data-selection controller))))
(etaf-view
(box :width '(720) :padding '(1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align 'center
(column
(text :color "#8F432F" :font-weight 'bold
"BEST PRACTICE / DATA OWNERSHIP")
(text :font-weight 'bold "Task controller")
(text :color "#66706A"
(expr :value
(format "%d records · %d selected" total
(length selection)))))))))
(defun etaf-data-example--filter-control
(controller label host-ref query border background)
"Return a filter LABEL for CONTROLLER using HOST-REF and QUERY.
Use BORDER and BACKGROUND for its semantic color family."
(etaf-view
(box :padding '(1 (12)) :border border :bgcolor background
:font-weight 'bold :ref host-ref :role 'button
:use (list (etaf-focusable))
:on-press (lambda ()
(etaf-data-example--filter controller query))
(text (expr :value label)))))
(defun etaf-data-example--toolbar (controller next-id)
"Return the action toolbar for CONTROLLER and NEXT-ID."
(etaf-view
(flex :width '(720) :flex-flow '(row wrap) :gap '(1 (10))
(expr :value (etaf-data-example--filter-control
controller "ALL" 'data-filter-all nil
"#4E7890" "#D9EAF2"))
(expr :value (etaf-data-example--filter-control
controller "OPEN" 'data-filter-open '(:status open)
"#C97252" "#F1D4C9"))
(expr :value (etaf-data-example--filter-control
controller "DONE" 'data-filter-done '(:status done)
"#6D8A73" "#DCEBDD"))
(box :padding '(1 (12)) :border "#7A6B95" :bgcolor "#E7E2F1"
:font-weight 'bold :ref 'data-add :role 'button
:use (list (etaf-focusable))
:on-press (lambda ()
(etaf-dispatch 'etaf-data-example-add
controller next-id))
(text "+ ADD TASK")))))
(defun etaf-data-example--rows (controller)
"Return the loaded task rows for CONTROLLER."
(let ((items (etaf-value (etaf-data-items controller))))
(if items
(mapcar (lambda (task)
(etaf-data-example--row controller task))
items)
(etaf-view
(box :width '(720) :padding '(2 (16))
:border "#8D887F" :bgcolor "#EEEAE2"
:text-align 'center
(text "No matching tasks."))))))
(defun etaf-data-example--view (controller next-id)
"Return the Data example View for CONTROLLER and NEXT-ID."
(etaf-view
(column :width '(720) :color "#252A2E" :bgcolor "#F8F5EE"
(expr :value (etaf-data-example--header controller))
(box :height 1)
(expr :value (etaf-data-example--toolbar controller next-id))
(box :height 1)
(column :width '(720)
(expr :value (etaf-data-example--rows controller)))
(box :height 1)
(box :width '(720) :padding '(1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2"
(text (text
"Owner rule: create in setup, mutate through Data, stop on unmount"))))) (expr
(if (etaf-value
(etaf-data-selected-ref controller (plist-get task :id)))
"●" "○"))))
(box :flex-grow 1 :flex-shrink 1 :flex-basis '(390)
:min-width '(280)
(text (expr (plist-get task :title))))
(box :width '(96) :color "#66706A"
(text (expr (plist-get task :owner))))
(box :width '(84) :font-weight 'bold :text-align 'right
:color (if (eq (plist-get task :status) 'done)
"#2F6B43" "#9B4A34")
(text (expr (upcase (symbol-name (plist-get task :status))))))))
(etaf-define-component etaf-data-example-filter
(&key controller label query border background)
"Render one query filter for CONTROLLER."
:view
(box :padding '(1 (12)) :border border :bgcolor background
:font-weight 'bold :role 'button :use (list (etaf-focusable))
:on-press
(let ((data-controller controller) (next-query query))
(lambda ()
(etaf-data-example--filter data-controller next-query)))
(text (expr label))))
(etaf-define-component etaf-data-example-app () (etaf-define-component etaf-data-example-app ()
"Render a memory-backed task application with owned cleanup." "Render a memory-backed task application with owned cleanup."
@ -161,7 +105,70 @@ Use BORDER and BACKGROUND for its semantic color family."
(next-id (etaf-ref 6 :name 'etaf-data-example-next-id))) (next-id (etaf-ref 6 :name 'etaf-data-example-next-id)))
(etaf-on-mounted (lambda () (etaf-data-load controller))) (etaf-on-mounted (lambda () (etaf-data-load controller)))
(etaf-on-unmounted (lambda () (etaf-data-stop controller))) (etaf-on-unmounted (lambda () (etaf-data-stop controller)))
(lambda () (etaf-data-example--view controller next-id)))) (list :controller controller :next-id next-id))
:view
(column :width '(720) :color "#252A2E" :bgcolor "#F8F5EE"
(box :width '(720) :padding '(1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align 'center
(column
(text :color "#8F432F" :font-weight 'bold
"BEST PRACTICE / DATA OWNERSHIP")
(text :font-weight 'bold "Task controller")
(text :color "#66706A"
(expr
(format
"%d records · %d selected"
(etaf-value
(etaf-data-total (plist-get (etaf-state) :controller)))
(length
(etaf-value
(etaf-data-selection (plist-get (etaf-state) :controller)))))))))
(box :height 1)
(flex :width '(720) :flex-flow '(row wrap) :gap '(1 (10))
(etaf-data-example-filter
:ref 'data-filter-all
:controller (plist-get (etaf-state) :controller)
:label "ALL" :query nil :border "#4E7890" :background "#D9EAF2")
(etaf-data-example-filter
:ref 'data-filter-open
:controller (plist-get (etaf-state) :controller)
:label "OPEN" :query '(:status open)
:border "#C97252" :background "#F1D4C9")
(etaf-data-example-filter
:ref 'data-filter-done
:controller (plist-get (etaf-state) :controller)
:label "DONE" :query '(:status done)
:border "#6D8A73" :background "#DCEBDD")
(box :padding '(1 (12)) :border "#7A6B95" :bgcolor "#E7E2F1"
:font-weight 'bold :ref 'data-add :role 'button
:use (list (etaf-focusable))
:on-press
(let ((controller (plist-get (etaf-state) :controller))
(next-id (plist-get (etaf-state) :next-id)))
(lambda ()
(etaf-dispatch 'etaf-data-example-add controller next-id)))
(text "+ ADD TASK")))
(box :height 1)
(column :width '(720)
(box :if
(null
(etaf-value
(etaf-data-items (plist-get (etaf-state) :controller))))
:width '(720) :padding '(2 (16))
:border "#8D887F" :bgcolor "#EEEAE2" :text-align 'center
(text "No matching tasks."))
(etaf-data-example-row
:for (task
(etaf-value
(etaf-data-items (plist-get (etaf-state) :controller))))
:key (plist-get task :id)
:ref (intern (format "data-task-%d" (plist-get task :id)))
:controller (plist-get (etaf-state) :controller)
:task task))
(box :height 1)
(box :width '(720) :padding '(1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2"
(text "Owner rule: create in setup, mutate through Data, stop on unmount"))))
;;;###autoload ;;;###autoload
(defun etaf-data-example-view () (defun etaf-data-example-view ()

138
examples/etaf-resource-example.el
View File

@ -22,73 +22,6 @@
('loading "Loading service snapshot…") ('loading "Loading service snapshot…")
(_ "Resource has not loaded."))) (_ "Resource has not loaded.")))
(defun etaf-resource-example--header ()
"Return the Resource example header."
(etaf-view
(box :width '(680) :padding '(1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align 'center
(column
(text :color "#8F432F" :font-weight 'bold
"BEST PRACTICE / RESOURCE LIFECYCLE")
(text :font-weight 'bold "Service health")
(text :color "#66706A"
"Loader errors become explicit state; cleanup stays scoped.")))))
(defun etaf-resource-example--status (resource cleanup-count)
"Return the status card for RESOURCE and CLEANUP-COUNT."
(let* ((status (etaf-resource-status resource))
(success (eq status 'success))
(surface (if success "#DCEBDD" "#F1D4C9"))
(border (if success "#6D8A73" "#C97252"))
(ink (if success "#24422D" "#6B3020")))
(etaf-view
(box :width '(680) :padding '(2 (18)) :border border
:bgcolor surface :color ink :text-align 'center
(column
(text :font-weight 'bold
(expr :value (upcase (symbol-name status))))
(text (expr :value (etaf-resource-example--message resource)))
(text :color "#66706A"
(expr :value
(format "CLEANUPS %d" (etaf-value cleanup-count)))))))))
(defun etaf-resource-example--actions (resource fail-next)
"Return action controls for RESOURCE and FAIL-NEXT."
(etaf-view
(flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12))
(box :flex-grow 1 :flex-shrink 1 :flex-basis '(200)
:min-width '(180) :padding '(1 (12))
:border "#4E7890" :bgcolor "#D9EAF2" :font-weight 'bold
:text-align 'center :ref 'resource-reload :role 'button
:use (list (etaf-focusable))
:on-press (lambda () (etaf-resource-load resource))
(text "RELOAD"))
(box :flex-grow 1 :flex-shrink 1 :flex-basis '(200)
:min-width '(180) :padding '(1 (12))
:border "#C97252" :bgcolor "#F1D4C9" :font-weight 'bold
:text-align 'center :ref 'resource-fail :role 'button
:use (list (etaf-focusable))
:on-press (lambda ()
(etaf-set-value fail-next t)
(etaf-resource-load resource))
(text "SIMULATE FAILURE")))))
(defun etaf-resource-example--view (resource fail-next cleanup-count)
"Return the example View for RESOURCE, FAIL-NEXT, and CLEANUP-COUNT."
(etaf-view
(column :width '(680) :color "#252A2E" :bgcolor "#F8F5EE"
(expr :value (etaf-resource-example--header))
(box :height 1)
(expr :value
(etaf-resource-example--status resource cleanup-count))
(box :height 1)
(expr :value (etaf-resource-example--actions resource fail-next))
(box :height 1)
(box :width '(680) :padding '(1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2"
(text
"Scope rule: reload releases the old value; unmount releases the last one")))))
(etaf-define-component etaf-resource-example-app () (etaf-define-component etaf-resource-example-app ()
"Render a reloadable Resource with visible cleanup and error state." "Render a reloadable Resource with visible cleanup and error state."
:setup :setup
@ -114,8 +47,75 @@
:immediate nil :immediate nil
:name 'etaf-resource-example)) :name 'etaf-resource-example))
(etaf-on-mounted (lambda () (etaf-resource-load resource))) (etaf-on-mounted (lambda () (etaf-resource-load resource)))
(lambda () (list :resource resource :fail-next fail-next
(etaf-resource-example--view resource fail-next cleanup-count)))) :cleanup-count cleanup-count))
:view
(column :width '(680) :color "#252A2E" :bgcolor "#F8F5EE"
(box :width '(680) :padding '(1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align 'center
(column
(text :color "#8F432F" :font-weight 'bold
"BEST PRACTICE / RESOURCE LIFECYCLE")
(text :font-weight 'bold "Service health")
(text :color "#66706A"
"Loader errors become explicit state; cleanup stays scoped.")))
(box :height 1)
(box :width '(680) :padding '(2 (18))
:border
(if (eq (etaf-resource-status
(plist-get (etaf-state) :resource)) 'success)
"#6D8A73" "#C97252")
:bgcolor
(if (eq (etaf-resource-status
(plist-get (etaf-state) :resource)) 'success)
"#DCEBDD" "#F1D4C9")
:color
(if (eq (etaf-resource-status
(plist-get (etaf-state) :resource)) 'success)
"#24422D" "#6B3020")
:text-align 'center
(column
(text :font-weight 'bold
(expr
(upcase
(symbol-name
(etaf-resource-status (plist-get (etaf-state) :resource))))))
(text
(expr
(etaf-resource-example--message
(plist-get (etaf-state) :resource))))
(text :color "#66706A"
(expr
(format "CLEANUPS %d"
(etaf-value (plist-get (etaf-state) :cleanup-count)))))))
(box :height 1)
(flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12))
(box :flex-grow 1 :flex-shrink 1 :flex-basis '(200)
:min-width '(180) :padding '(1 (12))
:border "#4E7890" :bgcolor "#D9EAF2" :font-weight 'bold
:text-align 'center :ref 'resource-reload :role 'button
:use (list (etaf-focusable))
:on-press
(let ((resource (plist-get (etaf-state) :resource)))
(lambda () (etaf-resource-load resource)))
(text "RELOAD"))
(box :flex-grow 1 :flex-shrink 1 :flex-basis '(200)
:min-width '(180) :padding '(1 (12))
:border "#C97252" :bgcolor "#F1D4C9" :font-weight 'bold
:text-align 'center :ref 'resource-fail :role 'button
:use (list (etaf-focusable))
:on-press
(let ((resource (plist-get (etaf-state) :resource))
(fail-next (plist-get (etaf-state) :fail-next)))
(lambda ()
(etaf-set-value fail-next t)
(etaf-resource-load resource)))
(text "SIMULATE FAILURE")))
(box :height 1)
(box :width '(680) :padding '(1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2"
(text
"Scope rule: reload releases the old value; unmount releases the last one"))))
;;;###autoload ;;;###autoload
(defun etaf-resource-example-view () (defun etaf-resource-example-view ()

315
scripts/etaf-m0a-inventory.el Normal file
View File

@ -0,0 +1,315 @@
;;; etaf-m0a-inventory.el --- M0a current-contract inventory -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; This is a read-only M0a inventory surface. It records current contracts,
;; known pre-activation baselines, and the condition handlers present in ETAF
;; source files. It intentionally does not turn future architecture targets
;; into passing assertions.
;;; Code:
(require 'cl-lib)
(require 'etaf)
(require 'json)
(require 'macroexp)
(defconst etaf-m0a-package-root
(file-name-directory
(directory-file-name
(file-name-directory (or load-file-name buffer-file-name))))
"Absolute ETAF package root inferred when this inventory is loaded.")
(defconst etaf-m0a-current-contract-inventory
'((:id component-definition
:evidence-mode current-contract
:summary ":view or :render is required; :setup/:styles are optional"
:tests (etaf-component-frontends-definition-boundary-is-strict
etaf-component-definition-keywords-have-one-owner))
(:id host-attrs
:evidence-mode current-contract
:summary "undeclared Host attrs fall through a single-root Component chain"
:tests (etaf-component-host-attrs-fall-through-one-root-chain
etaf-component-host-attrs-reject-ambiguous-or-invalid-targets
etaf-component-host-attrs-rollback-root-shape-failure))
(:id slots-key-lifecycle-rollback
:evidence-mode current-contract
:summary "slots retain caller ownership; key is framework-owned; lifecycle and rollback are ordered"
:tests (etaf-component-frontends-project-default-and-named-slots
etaf-component-key-is-framework-owned-and-render-result-is-typed
etaf-component-lifecycle-and-scope-cleanup-are-ordered
etaf-component-render-side-effect-rolls-back-completely))
(:id action-registration
:evidence-mode observed-baseline
:activation-milestone M0b
:owner etaf-actions
:summary "registering an existing Action name replaces the current spec"
:tests (etaf-m0a-action-registration-replaces-current-definition))
(:id behavior-duplicates
:evidence-mode observed-baseline
:activation-milestone M0b
:owner etaf-runtime
:summary "same-name Behaviors are currently processed in declaration order; no pre-install duplicate gate exists"
:tests (etaf-runtime-composes-host-and-behavior-events-in-order
etaf-behavior-replacement-disposes-previous-installer))
(:id event-rules
:evidence-mode current-contract
:summary "event names normalize keyword/symbol/string on-* spellings; Host callback precedes Behavior callback"
:tests (etaf-m0a-event-kind-normalizes-current-spellings
etaf-runtime-composes-host-and-behavior-events-in-order))
(:id dependency-only-publication
:evidence-mode current-contract
:summary "semantic generation advances without Ebox commit or TP surface revision"
:tests (etaf-m0a-dependency-only-skips-ebox-and-tp-publication))
(:id initial-attach
:evidence-mode current-contract
:summary "initial observed publication reports TP, Ebox, then ETAF"
:tests (etaf-runtime-observer-covers-initial-publication))
(:id unmount-kill
:evidence-mode current-contract
:summary "unmount disposes lifecycle before scope cleanup; kill follows unmount; repeated public unmount signals"
:tests (etaf-component-lifecycle-and-scope-cleanup-are-ordered
etaf-runtime-killed-buffer-unmounts-owned-scope
etaf-m0a-repeated-public-unmount-signals-runtime-error))
(:id condition-trailer
:evidence-mode observed-baseline
:activation-milestone M3a
:owner etaf-runtime
:summary "current consumers receive raw condition symbols/data; typed compatibility trailer is not active"
:tests (etaf-m0a-public-update-preserves-raw-condition-symbol-and-data))
(:id document-examples
:evidence-mode observed-baseline
:activation-milestone M0b
:owner etaf-documentation
:summary "all user-facing fenced Elisp blocks have reviewed read, macroexpand, load-safety, and drift outcomes"
:tests (etaf-m0a-document-example-inventory-matches-reviewed-golden)))
"Machine-readable M0a ledger for ETAF current behavior and future gates.")
(defconst etaf-m0a-document-example-files
'("README.md"
"README.zh-CN.md"
"examples/README.md"
"examples/README.zh-CN.md"
"docs/architecture.en.md"
"docs/architecture.zh.md"
"docs/user-guide.en.md"
"docs/user-guide.zh.md"
"docs/implementation-plan.en.md"
"docs/implementation-plan.zh.md")
"User-facing documents whose fenced Elisp blocks belong to M0a inventory.")
(defun etaf-m0a--condition-handler-symbols (clause)
"Return the condition symbols handled by `condition-case' CLAUSE."
(let ((head (car-safe clause)))
(cond
((symbolp head) (list head))
((proper-list-p head) (cl-remove-if-not #'symbolp head))
(t nil))))
(defun etaf-m0a--condition-policy (conditions)
"Return the current handling policy for CONDITIONS."
(if (cl-every (lambda (condition) (memq condition '(error quit))) conditions)
'generic-containment
'specific-compatibility))
(defun etaf-m0a--walk-condition-consumers (form file line)
"Return condition consumer records below FORM from FILE at LINE."
(let (records)
(when (consp form)
(unless (memq (car form) '(quote function))
(when (memq (car form) '(condition-case condition-case-unless-debug))
(dolist (clause (cdddr form))
(let ((conditions (etaf-m0a--condition-handler-symbols clause)))
(when conditions
(push (list :file file :line line :form (car form)
:conditions conditions
:owner (intern (file-name-base file))
:policy (etaf-m0a--condition-policy conditions))
records)))))
(setq records
(nconc records
(etaf-m0a--walk-condition-consumers
(car form) file line)
(etaf-m0a--walk-condition-consumers
(cdr form) file line)))))
records))
(defun etaf-m0a-condition-consumer-inventory (&optional directory)
"Return condition consumers in top-level ETAF sources under DIRECTORY.
DIRECTORY defaults to the package root inferred from this script. Test and
example files are excluded so this inventory describes product consumers."
(let* ((root (file-name-as-directory
(expand-file-name
(or directory etaf-m0a-package-root))))
(files (sort (directory-files root t "\\`etaf-.*\\.el\\'")
#'string<))
records)
(dolist (file files)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(condition-case nil
(while t
(let ((line (line-number-at-pos))
(form (read (current-buffer))))
(setq records
(nconc records
(etaf-m0a--walk-condition-consumers
form (file-relative-name file root) line)))))
(end-of-file nil))))
(sort records
(lambda (left right)
(or (string< (plist-get left :file) (plist-get right :file))
(and (equal (plist-get left :file) (plist-get right :file))
(< (plist-get left :line) (plist-get right :line))))))))
(defun etaf-m0a-condition-consumer-signatures (&optional directory)
"Return stable golden signatures for source consumers under DIRECTORY.
Line numbers remain available in the diagnostic inventory but are excluded
from this signature so unrelated line movement does not rewrite the golden."
(mapcar
(lambda (entry)
(list :file (plist-get entry :file)
:form (plist-get entry :form)
:conditions (plist-get entry :conditions)
:owner (plist-get entry :owner)
:policy (plist-get entry :policy)))
(etaf-m0a-condition-consumer-inventory directory)))
(defun etaf-m0a--document-elisp-blocks (file root)
"Return fenced Elisp blocks from FILE below ROOT."
(with-temp-buffer
(insert-file-contents (expand-file-name file root))
(goto-char (point-min))
(let ((index 0) blocks)
(while (re-search-forward "^```elisp[[:space:]]*$" nil t)
(let ((line (line-number-at-pos))
(start (line-beginning-position 2)))
(unless (re-search-forward "^```[[:space:]]*$" nil t)
(error "Unclosed Elisp block in %s" file))
(cl-incf index)
(push (list :index index :line line
:source (buffer-substring-no-properties
start (match-beginning 0)))
blocks)))
(nreverse blocks))))
(defun etaf-m0a--read-document-forms (source)
"Read all forms from documentation SOURCE and return a result plist."
(with-temp-buffer
(emacs-lisp-mode)
(insert source)
(goto-char (point-min))
(let (forms failure)
(condition-case condition
(while (progn
(skip-chars-forward " \t\r\n")
(< (point) (point-max)))
(push (read (current-buffer)) forms))
(error (setq failure (car condition))))
(if failure
(list :status 'error :detail failure :forms nil)
(list :status 'ok :detail (length forms) :forms (nreverse forms))))))
(defun etaf-m0a--macroexpand-document-forms (forms)
"Macroexpand FORMS and return a stable outcome plist."
(condition-case condition
(progn
(mapc #'macroexpand-all forms)
(list :status 'ok :detail (length forms)))
(error (list :status 'error :detail (car condition)))))
(defun etaf-m0a-document-example-inventory (&optional directory)
"Return current read/macroexpand/load outcomes for user documentation.
DIRECTORY defaults to `etaf-m0a-package-root'.
Arbitrary documentation code is never evaluated in the agent process: it may
mount buffers, mutate files, start async work, or depend on user state. Every
block therefore has an explicit skipped load outcome and safety reason."
(let ((root (file-name-as-directory
(expand-file-name (or directory etaf-m0a-package-root)))))
(mapcar
(lambda (file)
(list
:file file
:blocks
(mapcar
(lambda (block)
(let* ((source (plist-get block :source))
(read-result (etaf-m0a--read-document-forms source))
(macro-result
(if (eq 'ok (plist-get read-result :status))
(etaf-m0a--macroexpand-document-forms
(plist-get read-result :forms))
(list :status 'skipped :detail 'read-failed)))
(drift
(cond
((eq 'error (plist-get read-result :status)) 'read-error)
((eq 'error (plist-get macro-result :status))
'macroexpand-error)
(t 'none))))
(list :index (plist-get block :index)
:line (plist-get block :line)
:sha256 (secure-hash 'sha256 source)
:read-status (plist-get read-result :status)
:read-detail (plist-get read-result :detail)
:macroexpand-status (plist-get macro-result :status)
:macroexpand-detail (plist-get macro-result :detail)
:load-status 'skipped-unsafe
:load-reason 'arbitrary-document-code
:drift drift)))
(etaf-m0a--document-elisp-blocks file root))))
etaf-m0a-document-example-files)))
(defun etaf-m0a-document-example-signatures (&optional directory)
"Return stable golden signatures for documentation under DIRECTORY."
(mapcar
(lambda (file-entry)
(list
:file (plist-get file-entry :file)
:blocks
(mapcar
(lambda (block)
(list (plist-get block :index)
(plist-get block :sha256)
(plist-get block :read-status)
(plist-get block :read-detail)
(plist-get block :macroexpand-status)
(plist-get block :macroexpand-detail)
(plist-get block :load-status)
(plist-get block :load-reason)
(plist-get block :drift)))
(plist-get file-entry :blocks))))
(etaf-m0a-document-example-inventory directory)))
(defun etaf-m0a-inventory-json (&optional directory)
"Return the current M0a ledger and condition inventory as JSON.
DIRECTORY is forwarded to `etaf-m0a-condition-consumer-inventory'."
(json-encode
(list :schema-version 1
:contract-inventory (vconcat etaf-m0a-current-contract-inventory)
:condition-consumers
(vconcat (etaf-m0a-condition-consumer-inventory directory))
:document-examples
(vconcat
(mapcar
(lambda (entry)
(let ((copy (copy-sequence entry)))
(plist-put copy :blocks
(vconcat (plist-get copy :blocks)))))
(etaf-m0a-document-example-inventory directory))))))
(when noninteractive
(when (member "--etaf-m0a-print-inventory" command-line-args-left)
(setq command-line-args-left
(delete "--etaf-m0a-print-inventory" command-line-args-left))
(princ (etaf-m0a-inventory-json))
(terpri)))
(provide 'etaf-m0a-inventory)
;;; etaf-m0a-inventory.el ends here

284
tests/etaf-interaction-contract-tests.el Normal file
View File

@ -0,0 +1,284 @@
;;; etaf-interaction-contract-tests.el --- Interaction contract tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; Lock the M0b Action, Behavior, and local event composition contract.
;;; Code:
(require 'ert)
(require 'etaf)
(defun etaf-interaction-test--dispose-buffer (buffer-name)
"Unmount and kill BUFFER-NAME when either still exists."
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))
(ert-deftest etaf-interaction-duplicate-behavior-fails-before-install ()
"Reject duplicate names on one Host without running either installer."
(let ((buffer-name " *etaf-duplicate-behavior-contract*")
(installs 0))
(unwind-protect
(let ((first
(etaf-behavior-create
'duplicate
:install (lambda () (cl-incf installs) #'ignore)))
(second
(etaf-behavior-create
'duplicate
:install (lambda () (cl-incf installs) #'ignore))))
(should-error
(etaf-mount
buffer-name
(lambda ()
(etaf--view-call
'text (list :ref 'target :use (list first second))
(list "target"))))
:type 'etaf-behavior-error)
(should (zerop installs)))
(etaf-interaction-test--dispose-buffer buffer-name))))
(ert-deftest etaf-interaction-behaviors-compose-in-declaration-order ()
"Preserve installer/event order, first-wins props, and one cleanup each."
(let ((buffer-name " *etaf-behavior-order-contract*")
install-order event-order cleanup-counts)
(unwind-protect
(let* ((first
(etaf-behavior-create
'first
:class "first"
:on-press (lambda () (setq event-order
(append event-order '(first))))
:install (lambda ()
(setq install-order (append install-order '(first)))
(lambda () (push 'first cleanup-counts)))))
(second
(etaf-behavior-create
'second
:class "second"
:on-press (lambda () (setq event-order
(append event-order '(second))))
:install (lambda ()
(setq install-order (append install-order '(second)))
(lambda () (push 'second cleanup-counts))))))
(etaf-mount
buffer-name
(lambda ()
(etaf--view-call
'text
(list :ref 'target :use (list first second)
:on-press
(lambda () (setq event-order (append event-order '(host)))))
(list "target"))))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(should (equal install-order '(first second)))
(should (equal (plist-get
(etaf-runtime-host-props-for runtime 'target)
:class)
"first"))
(etaf-dispatch-event runtime 'target 'press)
(should (equal event-order '(host first second)))
(etaf-unmount runtime))
(should (= 1 (cl-count 'first cleanup-counts)))
(should (= 1 (cl-count 'second cleanup-counts))))
(etaf-interaction-test--dispose-buffer buffer-name))))
(ert-deftest etaf-interaction-callback-failure-short-circuits-behaviors ()
"Stop Behavior callbacks after an earlier callback signals."
(let ((buffer-name " *etaf-behavior-failure-contract*") trace)
(unwind-protect
(let ((first
(etaf-behavior-create
'first :on-press
(lambda () (push 'first trace) (error "first failed"))))
(second
(etaf-behavior-create
'second :on-press (lambda () (push 'second trace)))))
(etaf-mount
buffer-name
(lambda ()
(etaf--view-call
'text
(list :ref 'target :use (list first second)
:on-press (lambda () (push 'host trace) (error "host failed")))
(list "target"))))
(should-error
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'target 'press))
(should (equal trace '(host)))
(etaf-unmount (etaf-runtime-for-buffer buffer-name))
(setq trace nil)
(etaf-mount
buffer-name
(lambda ()
(etaf--view-call
'text
(list :ref 'target :use (list first second)
:on-press (lambda () (push 'host trace)))
(list "target"))))
(should-error
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'target 'press))
(should (equal trace '(first host))))
(etaf-interaction-test--dispose-buffer buffer-name))))
(ert-deftest etaf-interaction-stable-installer-identity-cleans-up-once ()
"Reuse an identical installer and run its cleanup exactly once."
(let ((buffer-name " *etaf-behavior-identity-contract*")
(trigger (etaf-ref 0))
(installs 0)
(cleanups 0))
(unwind-protect
(let* ((installer
(lambda ()
(cl-incf installs)
(lambda () (cl-incf cleanups))))
(behavior
(etaf-behavior-create 'stable :install installer)))
(etaf-mount
buffer-name
(lambda ()
(etaf--view-call
'text
(list :ref 'target :use behavior
:aria-label (format "version-%d" (etaf-value trigger)))
(list "target"))))
(should (= installs 1))
(setf (etaf-value trigger) 1)
(should (= installs 1))
(should (zerop cleanups))
(etaf-unmount (etaf-runtime-for-buffer buffer-name))
(should (= cleanups 1)))
(etaf-interaction-test--dispose-buffer buffer-name))))
(ert-deftest etaf-interaction-events-do-not-capture-or-bubble ()
"Dispatch only the callback owned by the exact Host reference."
(let ((buffer-name " *etaf-local-event-contract*") trace)
(unwind-protect
(progn
(etaf-mount
buffer-name
(lambda ()
(etaf--view-call
'column
(list :ref 'parent :on-press (lambda () (push 'parent trace)))
(list
(etaf--view-call
'text
(list :ref 'child :on-press (lambda () (push 'child trace)))
(list "child"))))))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-dispatch-event runtime 'child 'press)
(should (equal trace '(child)))
(setq trace nil)
(etaf-dispatch-event runtime 'parent 'press)
(should (equal trace '(parent)))))
(etaf-interaction-test--dispose-buffer buffer-name))))
(ert-deftest etaf-action-duplicate-registration-errors-by-default ()
"Keep the first Action when another application claims the same name."
(let ((name 'etaf-interaction-test-cross-app-action)
(first (lambda (_runtime) 'first))
(second (lambda (_runtime) 'second)))
(unwind-protect
(progn
(etaf-action-register name first)
(should-error (etaf-action-register name second)
:type 'etaf-action-error)
(should (eq first
(etaf-action-spec-function
(gethash name etaf--action-registry)))))
(etaf-action-undefine name))))
(ert-deftest etaf-action-redefine-boundary-affects-only-future-dispatch ()
"Replace name lookup explicitly without flushing a mounted Runtime."
(let ((buffer-name " *etaf-action-redefine-contract*")
(name 'etaf-interaction-test-future-action)
(first-calls 0)
(second-calls 0))
(unwind-protect
(progn
(etaf-action-register
name (lambda (_runtime) (cl-incf first-calls)))
(etaf-mount
buffer-name
(lambda ()
(etaf--view-call
'text
(list :ref 'target
:on-press (lambda () (etaf-dispatch name)))
(list "target"))))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime)))
(etaf-dispatch-event runtime 'target 'press)
(should (= first-calls 1))
(etaf-action-redefine-run
(lambda ()
(etaf-action-register
name (lambda (_runtime) (cl-incf second-calls)))))
(should (eq generation
(etaf-runtime-current-generation runtime)))
(should (= first-calls 1))
(should (zerop second-calls))
(etaf-dispatch-event runtime 'target 'press)
(should (= second-calls 1))))
(etaf-action-undefine name)
(etaf-interaction-test--dispose-buffer buffer-name))))
(ert-deftest etaf-action-reload-requires-explicit-redefine-boundary ()
"Make repeated authoring definitions explicit and dynamically scoped."
(let ((name 'etaf-interaction-test-reload-action)
(function-symbol 'etaf-interaction-test-reload-action--etaf-action))
(unwind-protect
(progn
(eval '(etaf-action-define etaf-interaction-test-reload-action
(_runtime)
'first)
t)
(should-error
(eval '(etaf-action-define etaf-interaction-test-reload-action
(_runtime)
'unintended)
t)
:type 'etaf-action-error)
(should
(eq 'first
(funcall
(etaf-action-spec-function
(gethash name etaf--action-registry))
nil)))
(etaf-action-redefine-run
(lambda ()
(eval '(etaf-action-define etaf-interaction-test-reload-action
(_runtime)
'second)
t)))
(should
(eq 'second
(funcall
(etaf-action-spec-function
(gethash name etaf--action-registry))
nil)))
(should-error
(eval '(etaf-action-define etaf-interaction-test-reload-action
(_runtime)
'unintended)
t)
:type 'etaf-action-error)
(should
(eq 'second
(funcall
(etaf-action-spec-function
(gethash name etaf--action-registry))
nil))))
(etaf-action-undefine name)
(when (fboundp function-symbol)
(fmakunbound function-symbol)))))
(provide 'etaf-interaction-contract-tests)
;;; etaf-interaction-contract-tests.el ends here

201
tests/etaf-m0a-current-characterization-tests.el Normal file
View File

@ -0,0 +1,201 @@
;;; etaf-m0a-current-characterization-tests.el --- M0a ETAF baseline -*- lexical-binding: t; -*-
;;; Code:
(require 'ert)
(require 'etaf)
(require 'etaf-m0a-inventory)
(define-error 'etaf-test-m0a-lifecycle-condition
"M0a lifecycle characterization condition")
(defconst etaf-test-m0a-condition-data
'(:phase updated
:payload ((account-id . 42) (tags alpha beta))
:retryable nil)
"Non-trivial raw condition data used by the M0a public update probe.")
(etaf-define-component etaf-test-m0a-dependency-only (&key source)
"Observe SOURCE while retaining equal rendered output."
:view (text (expr (progn (etaf-value source) "same"))))
(etaf-define-component etaf-test-m0a-lifecycle-failure (&key label)
"Publish LABEL, then signal a custom condition from the update lifecycle."
:setup
(progn
(etaf-on-updated
(lambda ()
(signal 'etaf-test-m0a-lifecycle-condition
etaf-test-m0a-condition-data)))
nil)
:view (text (expr label)))
(ert-deftest etaf-m0a-action-registration-requires-explicit-redefinition ()
"Duplicate Action registration fails outside the authoring boundary."
(let* ((name (make-symbol "etaf-m0a-action"))
(first (lambda (_runtime) 'first))
(second (lambda (_runtime) 'second)))
(unwind-protect
(progn
(etaf-action-register name first)
(should-error (etaf-action-register name second)
:type 'etaf-action-error)
(should (eq first
(etaf-action-spec-function
(gethash name etaf--action-registry))))
(etaf-action-redefine-run
(lambda () (etaf-action-register name second)))
(should (eq second
(etaf-action-spec-function
(gethash name etaf--action-registry)))))
(etaf-action-undefine name))))
(ert-deftest etaf-m0a-event-kind-normalizes-current-spellings ()
"Keyword, symbol, and string event spellings normalize to one symbol."
(dolist (spelling '(:press press on-press "press" "on-press"))
(should (eq 'press (etaf-event-kind spelling)))))
(ert-deftest etaf-m0a-dependency-only-skips-ebox-and-tp-publication ()
"An equal-output dependency update advances ETAF only, not Ebox or TP."
(let ((buffer-name " *etaf-m0a-dependency-only*")
(source (etaf-ref 0))
(ebox-commits 0))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view (etaf-test-m0a-dependency-only :source source)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(surface (with-current-buffer buffer-name
(car tp--buffer-surfaces)))
(generation (etaf-runtime-generation runtime))
(revision (tp-surface-revision surface))
(original-ebox-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-commit)
(lambda (&rest arguments)
(cl-incf ebox-commits)
(apply original-ebox-commit arguments))))
(setf (etaf-value source) 1))
(should (= (1+ generation) (etaf-runtime-generation runtime)))
(should (zerop ebox-commits))
(should (= revision (tp-surface-revision surface)))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-m0a-repeated-public-unmount-signals-runtime-error ()
"Calling the public unmount boundary twice signals runtime error."
(let ((buffer-name " *etaf-m0a-repeated-unmount*") runtime)
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (text "mounted")))
(setq runtime (etaf-runtime-for-buffer buffer-name))
(etaf-unmount runtime)
(should-error (etaf-unmount runtime) :type 'etaf-runtime-error))
(when (and runtime (etaf-runtime-mounted-p runtime))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-m0a-public-update-preserves-raw-condition-symbol-and-data ()
"A public update exposes the exact lifecycle condition symbol and payload."
(let ((buffer-name " *etaf-m0a-lifecycle-condition*")
(label (etaf-ref "A"))
captured)
(unwind-protect
(progn
(etaf-mount
buffer-name
(lambda ()
(etaf-view
(etaf-test-m0a-lifecycle-failure
:label (etaf-value label)))))
(condition-case condition
(setf (etaf-value label) "B")
(etaf-test-m0a-lifecycle-condition
(setq captured condition)))
(should
(equal captured
(cons 'etaf-test-m0a-lifecycle-condition
etaf-test-m0a-condition-data)))
(should (equal "B"
(with-current-buffer buffer-name
(buffer-string)))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-m0a-condition-consumer-inventory-is-machine-readable ()
"The source consumer inventory exactly matches its reviewed golden."
(let ((consumers (etaf-m0a-condition-consumer-inventory))
(golden-file
(expand-file-name "tests/fixtures/etaf-m0a-condition-consumers.sexp"
etaf-m0a-package-root)))
(should consumers)
(should (cl-find "etaf-runtime.el" consumers
:key (lambda (entry) (plist-get entry :file))
:test #'equal))
(should (cl-every (lambda (entry)
(and (stringp (plist-get entry :file))
(integerp (plist-get entry :line))
(symbolp (plist-get entry :form))
(proper-list-p (plist-get entry :conditions))
(symbolp (plist-get entry :owner))
(memq (plist-get entry :policy)
'(generic-containment
specific-compatibility))))
consumers))
(with-temp-buffer
(insert-file-contents golden-file)
(should (equal (read (current-buffer))
(etaf-m0a-condition-consumer-signatures)))
(skip-chars-forward " \t\r\n")
(should (eobp)))
(should (cl-find 'observed-baseline
etaf-m0a-current-contract-inventory
:key (lambda (entry)
(plist-get entry :evidence-mode))))
(let ((json (json-parse-string (etaf-m0a-inventory-json))))
(should (= 1 (gethash "schema-version" json)))
(should (= (length etaf-m0a-current-contract-inventory)
(length (gethash "contract-inventory" json))))
(should (= (length consumers)
(length (gethash "condition-consumers" json))))
(should (= (length etaf-m0a-document-example-files)
(length (gethash "document-examples" json)))))))
(ert-deftest etaf-m0a-document-example-inventory-matches-reviewed-golden ()
"Every user documentation block matches its reviewed M0a outcome."
(let* ((golden-file
(expand-file-name "tests/fixtures/etaf-m0a-document-examples.sexp"
etaf-m0a-package-root))
(inventory (etaf-m0a-document-example-inventory))
(blocks (apply #'append
(mapcar (lambda (entry)
(plist-get entry :blocks))
inventory)))
golden)
(with-temp-buffer
(insert-file-contents golden-file)
(setq golden (read (current-buffer)))
(skip-chars-forward " \t\r\n")
(should (eobp)))
(should (equal golden (etaf-m0a-document-example-signatures)))
(should (= 122 (length blocks)))
(should (= 0 (cl-count 'read-error blocks
:key (lambda (entry)
(plist-get entry :drift)))))
(should (= 4 (cl-count 'macroexpand-error blocks
:key (lambda (entry)
(plist-get entry :drift)))))
(should (cl-every
(lambda (entry)
(and (eq 'skipped-unsafe (plist-get entry :load-status))
(eq 'arbitrary-document-code
(plist-get entry :load-reason))))
blocks))))
(provide 'etaf-m0a-current-characterization-tests)
;;; etaf-m0a-current-characterization-tests.el ends here

1143
tests/etaf-tests.el
View File

File diff suppressed because it is too large Load Diff

20
tests/fixtures/etaf-m0a-condition-consumers.sexp vendored Normal file
View File

@ -0,0 +1,20 @@
((:file "etaf-data.el" :form condition-case :conditions (error) :owner etaf-data :policy generic-containment)
(:file "etaf-data.el" :form condition-case :conditions (error) :owner etaf-data :policy generic-containment)
(:file "etaf-observer.el" :form condition-case :conditions (error quit) :owner etaf-observer :policy generic-containment)
(:file "etaf-observer.el" :form condition-case :conditions (error quit) :owner etaf-observer :policy generic-containment)
(:file "etaf-observer.el" :form condition-case :conditions (error) :owner etaf-observer :policy generic-containment)
(:file "etaf-observer.el" :form condition-case :conditions (quit) :owner etaf-observer :policy generic-containment)
(:file "etaf-performance.el" :form condition-case :conditions (etaf-runtime-error) :owner etaf-performance :policy specific-compatibility)
(:file "etaf-performance.el" :form condition-case :conditions (error) :owner etaf-performance :policy generic-containment)
(:file "etaf-reactive.el" :form condition-case :conditions (error quit) :owner etaf-reactive :policy generic-containment)
(:file "etaf-reactive.el" :form condition-case :conditions (error quit) :owner etaf-reactive :policy generic-containment)
(:file "etaf-resource.el" :form condition-case :conditions (error) :owner etaf-resource :policy generic-containment)
(:file "etaf-resource.el" :form condition-case :conditions (error) :owner etaf-resource :policy generic-containment)
(:file "etaf-runtime.el" :form condition-case :conditions (error) :owner etaf-runtime :policy generic-containment)
(:file "etaf-runtime.el" :form condition-case :conditions (error) :owner etaf-runtime :policy generic-containment)
(:file "etaf-runtime.el" :form condition-case :conditions (quit) :owner etaf-runtime :policy generic-containment)
(:file "etaf-runtime.el" :form condition-case :conditions (error quit) :owner etaf-runtime :policy generic-containment)
(:file "etaf-runtime.el" :form condition-case :conditions (error quit) :owner etaf-runtime :policy generic-containment)
(:file "etaf-runtime.el" :form condition-case :conditions (error quit) :owner etaf-runtime :policy generic-containment)
(:file "etaf-runtime.el" :form condition-case :conditions (error quit) :owner etaf-runtime :policy generic-containment)
(:file "etaf-runtime.el" :form condition-case :conditions (error quit) :owner etaf-runtime :policy generic-containment))