diff --git a/README.md b/README.md index cd4fb23..61f11d0 100644 --- a/README.md +++ b/README.md @@ -19,6 +19,9 @@ into the right-hand preview. Saving a source file also refreshes by default. `etaf-playground-register-example` is available when a companion needs a non-conventional root or feature name. +ETAF Playground 0.2.1 declares ETAF 0.1.1, ETAF UI 0.1.0, and ETAF SQLite +0.1.0 so the bundled Research Shelf companion has a complete install closure. + Preview placement uses the standard Emacs `display-buffer` action stored in `etaf-playground-display-action`. The default is a right side window using half the frame: @@ -56,6 +59,11 @@ examples/research-shelf.ecss # inert style source examples/research-shelf.el # DATA / THEME / STATE / VIEW / ROOT sections ``` +Opening an inert `.etaf` or `.ecss` source loads only its lightweight editing +mode. The ETAF/Ebox/TP runtime is loaded when a preview is refreshed or +mounted. Runtime use requires TP 1.0.1 or newer so `tp-transaction.el` and the +Host final-accept contract are present. + The companion registers `:reload-on-refresh t`, so saving the `.el`, `.etaf`, or `.ecss` source and refreshing reloads the complete consumer before the next mount. diff --git a/README.zh-CN.md b/README.zh-CN.md index d4a23c7..5cc190c 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -18,6 +18,9 @@ ETAF Playground 是通用的应用构建工作区：左侧编辑同一个应用 也会刷新。若 root 或 feature 不遵循命名约定，可在 companion 中调用 `etaf-playground-register-example` 注册覆盖。 +ETAF Playground 0.2.1 会声明 ETAF 0.1.1、ETAF UI 0.1.0 与 ETAF SQLite +0.1.0，保证内置 Research Shelf companion 的安装依赖闭包完整。 + 预览位置使用标准 Emacs `display-buffer` action，由 `etaf-playground-display-action` 配置。默认在右侧使用一半 frame： @@ -55,6 +58,10 @@ examples/research-shelf.ecss # inert 样式 source examples/research-shelf.el # DATA / THEME / STATE / VIEW / ROOT 分区 ``` +直接打开 inert `.etaf` 或 `.ecss` source 时只加载轻量编辑 mode；刷新或 mount +preview 时才加载 ETAF/Ebox/TP runtime。运行 preview 需要 TP 1.0.1 或更高版本， +以保证 `tp-transaction.el` 与 Host final-accept contract 已安装。 + 该 companion 注册了 `:reload-on-refresh t`；保存 `.el`、`.etaf` 或 `.ecss` 后刷新 source，会在下一次 mount 前重新加载完整 consumer。 diff --git a/etaf-playground.el b/etaf-playground.el index 86ee101..cfc5374 100644 --- a/etaf-playground.el +++ b/etaf-playground.el @@ -3,8 +3,8 @@ ;; SPDX-License-Identifier: GPL-3.0-or-later ;; Author: ETAF contributors -;; Version: 0.2.0 -;; Package-Requires: ((emacs "29.1") (etaf "0.1.0")) +;; Version: 0.2.1 +;; Package-Requires: ((emacs "29.1") (etaf "0.1.1") (etaf-sqlite "0.1.0") (etaf-ui "0.1.0")) ;; Keywords: tools, convenience, ui ;;; Commentary: @@ -32,7 +32,21 @@ (require 'cl-lib) (require 'subr-x) (require 'button) -(require 'etaf) + +(define-error 'etaf-playground-dependency-error + "ETAF Playground requires TP 1.0.1 or newer with tp-transaction") + +(defun etaf-playground--ensure-runtime () + "Load ETAF runtime dependencies or report an actionable TP mismatch." + (condition-case condition + (require 'etaf) + (file-missing + (if (member "tp-transaction" condition) + (signal 'etaf-playground-dependency-error + (list :required-package '(tp "1.0.1") + :missing-feature 'tp-transaction + :original-condition condition)) + (signal (car condition) (cdr condition)))))) (defgroup etaf-playground nil "Authoring workspaces for ETAF applications." @@ -86,6 +100,11 @@ frame." (declare-function ebox-call-with-render-burst "ebox-buffer-backend" (function &rest arguments)) +(declare-function etaf-action-redefine-run "etaf-actions" (function)) +(declare-function etaf-component-redefine-run "etaf-component" (function)) +(declare-function etaf-mount "etaf-runtime" (buffer view &optional options)) +(declare-function etaf-runtime-for-buffer "etaf-runtime" (buffer)) +(declare-function etaf-unmount "etaf-runtime" (runtime)) (cl-defstruct (etaf-playground-session (:constructor etaf-playground--session-create)) @@ -510,6 +529,7 @@ source editors and side-by-side workspace around it. MOUNT-OPTIONS is forwarded to `etaf-mount', including an optional initial viewport. Source loading, root construction, ETAF publication, and Ebox rendering share one public framework render burst so GC cannot split an interactive mount." + (etaf-playground--ensure-runtime) (ebox-call-with-render-burst #'etaf-playground--mount-example-now buffer-name name session mount-options)) @@ -534,6 +554,7 @@ public framework render burst so GC cannot split an interactive mount." (let ((preview (etaf-playground-session-preview-buffer session))) (condition-case err (progn + (etaf-playground--ensure-runtime) (when-let* ((runtime (etaf-runtime-for-buffer preview))) (with-current-buffer preview (etaf-unmount runtime))) @@ -620,10 +641,12 @@ the preview instead of destroying the source workspace." (remove-hook 'after-change-functions #'etaf-playground--after-source-change t))) +;;;###autoload (define-derived-mode etaf-playground-etaf-mode emacs-lisp-mode "ETAF" "Major mode for inert ETAF structural source files." (etaf-playground-source-mode 1)) +;;;###autoload (define-derived-mode etaf-playground-ecss-mode emacs-lisp-mode "ECSS" "Major mode for inert ETAF ECSS style source files." (etaf-playground-source-mode 1)) @@ -634,7 +657,9 @@ the preview instead of destroying the source workspace." (setq-local buffer-read-only nil) (setq-local mode-line-process nil)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.etaf\\'" . etaf-playground-etaf-mode)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.ecss\\'" . etaf-playground-ecss-mode)) (defun etaf-playground--source-header () @@ -984,8 +1009,10 @@ default example there." (window-frame preview-window))) (configuration (etaf-playground-session-previous-window-configuration session))) - (when-let* ((runtime (and (buffer-live-p preview) - (etaf-runtime-for-buffer preview)))) + (when-let* ((runtime + (and (fboundp 'etaf-runtime-for-buffer) + (buffer-live-p preview) + (etaf-runtime-for-buffer preview)))) (with-current-buffer preview (etaf-unmount runtime))) (remhash (etaf-playground-session-name session) @@ -1013,7 +1040,8 @@ default example there." ((and (stringp target) (get-buffer target)) (get-buffer target)) ((null target) (current-buffer)))) - (runtime (and (buffer-live-p buffer) + (runtime (and (fboundp 'etaf-runtime-for-buffer) + (buffer-live-p buffer) (etaf-runtime-for-buffer buffer)))) (when runtime (with-current-buffer buffer diff --git a/scripts/benchmark-research-shelf.el b/scripts/benchmark-research-shelf.el index 77cd2f6..c28ef57 100644 --- a/scripts/benchmark-research-shelf.el +++ b/scripts/benchmark-research-shelf.el @@ -9,6 +9,7 @@ ;;; Code: (require 'cl-lib) (require 'seq) +(require 'etaf) (require 'etaf-playground) (require 'etaf-performance) (require 'ebox-native-reflow) diff --git a/tests/etaf-playground-tests.el b/tests/etaf-playground-tests.el index 7b988dd..dac11ee 100644 --- a/tests/etaf-playground-tests.el +++ b/tests/etaf-playground-tests.el @@ -8,15 +8,100 @@ ;;; Code: (require 'cl-lib) (require 'ert) +(require 'package) (require 'etaf-playground) (require 'etaf-performance) +(defconst etaf-playground-test--root + (file-name-directory + (directory-file-name + (file-name-directory (or load-file-name buffer-file-name)))) + "Absolute ETAF Playground repository path used by subprocess gates.") + +(defun etaf-playground-test--package-description (file) + "Return the package description parsed from FILE." + (with-temp-buffer + (insert-file-contents file) + (package-buffer-info))) + (defun etaf-playground-test--ensure-app-loaded () "Load the same-basename Research Shelf companion for test setup." (unless (featurep 'etaf-research-shelf) (load-file (expand-file-name "examples/research-shelf.el" default-directory)))) +(ert-deftest etaf-playground-etaf-source-mode-clean-loads-without-runtime () + "Opening research-shelf.etaf must not eagerly load ETAF or TP." + (let ((output (generate-new-buffer " *etaf-source-mode-clean-load*")) + (program (expand-file-name invocation-name invocation-directory)) + (package-file + (expand-file-name "etaf-playground.el" etaf-playground-test--root)) + (source-file + (expand-file-name "examples/research-shelf.etaf" + etaf-playground-test--root))) + (unwind-protect + (let ((status + (call-process + program nil output nil "-Q" "--batch" + "-L" etaf-playground-test--root + "-l" package-file + "--eval" + (format + "(progn (find-file %S) (unless (eq major-mode 'etaf-playground-etaf-mode) (kill-emacs 11)) (when (featurep 'etaf) (kill-emacs 12)) (princ \"ETAF source mode clean-load OK\\n\"))" + source-file)))) + (unless (zerop status) + (ert-fail + (with-current-buffer output (buffer-string)))) + (with-current-buffer output + (should (string-match-p "ETAF source mode clean-load OK" + (buffer-string))))) + (when (buffer-live-p output) (kill-buffer output))))) + +(ert-deftest etaf-playground-package-closure-requires-transaction-tp () + "Package metadata must reject TP snapshots without tp-transaction.el." + (let* ((workspace (file-name-directory + (directory-file-name etaf-playground-test--root))) + (tp (etaf-playground-test--package-description + (expand-file-name "tp/tp.el" workspace))) + (ebox (etaf-playground-test--package-description + (expand-file-name "ebox/ebox.el" workspace))) + (etaf (etaf-playground-test--package-description + (expand-file-name "etaf/etaf.el" workspace))) + (playground (etaf-playground-test--package-description + (expand-file-name + "etaf-playground/etaf-playground.el" workspace)))) + (should (equal (package-desc-version tp) '(1 0 1))) + (should (equal (package-desc-version ebox) '(2 0 1))) + (should (member '(tp (1 0 1)) (package-desc-reqs ebox))) + (should (equal (package-desc-version etaf) '(0 1 1))) + (should (member '(ebox (2 0 1)) (package-desc-reqs etaf))) + (should (member '(tp (1 0 1)) (package-desc-reqs etaf))) + (should (equal (package-desc-version playground) '(0 2 1))) + (should (member '(etaf (0 1 1)) (package-desc-reqs playground))) + (should (member '(etaf-ui (0 1 0)) + (package-desc-reqs playground))) + (should (member '(etaf-sqlite (0 1 0)) + (package-desc-reqs playground))))) + +(ert-deftest etaf-playground-stale-tp-error-is-actionable () + "A stale TP install reports its required package instead of file-missing." + (let ((original-require (symbol-function 'require))) + (cl-letf (((symbol-function 'require) + (lambda (feature &optional filename noerror) + (if (eq feature 'etaf) + (signal 'file-missing + '("Cannot open load file" + "No such file or directory" + "tp-transaction")) + (funcall original-require feature filename noerror))))) + (let ((condition + (should-error (etaf-playground--ensure-runtime) + :type 'etaf-playground-dependency-error))) + (should (equal (plist-get (cdr condition) :required-package) + '(tp "1.0.1"))) + (should (eq (plist-get (cdr condition) :missing-feature) + 'tp-transaction)))))) + (defun etaf-playground-test--text (buffer) "Return BUFFER's plain rendered text." (with-current-buffer buffer