diff --git a/README.md b/README.md index 06795d4..28dc8eb 100644 --- a/README.md +++ b/README.md @@ -19,6 +19,29 @@ 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. +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: + +```elisp +;; Right preview using 40% of the frame. +(setq etaf-playground-display-action + '((display-buffer-in-side-window) + (side . right) + (window-width . 0.4))) + +;; Right preview fixed at 100 columns. +(setq etaf-playground-display-action + '((display-buffer-in-side-window) + (side . right) + (window-width . 100))) + +;; Preview in its own frame. +(setq etaf-playground-display-action + '((display-buffer-pop-up-frame) + (pop-up-frame-parameters . ((width . 120) (height . 45))))) +``` + The low-level `etaf-playground-mount-example` API remains available for batch tests and consumers that only need a preview buffer. Business Components, database schemas, palettes, refs, and handlers stay in the example companion. diff --git a/README.zh-CN.md b/README.zh-CN.md index 47954e2..dc15ffe 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -18,9 +18,32 @@ ETAF Playground 是通用的应用构建工作区：左侧编辑同一个应用 也会刷新。若 root 或 feature 不遵循命名约定，可在 companion 中调用 `etaf-playground-register-example` 注册覆盖。 +预览位置使用标准 Emacs `display-buffer` action，由 +`etaf-playground-display-action` 配置。默认在右侧使用一半 frame： + +```elisp +;; 右侧预览占 frame 的 40%。 +(setq etaf-playground-display-action + '((display-buffer-in-side-window) + (side . right) + (window-width . 0.4))) + +;; 右侧预览固定为 100 列。 +(setq etaf-playground-display-action + '((display-buffer-in-side-window) + (side . right) + (window-width . 100))) + +;; 使用独立 frame。 +(setq etaf-playground-display-action + '((display-buffer-pop-up-frame) + (pop-up-frame-parameters . ((width . 120) (height . 45))))) +``` + `etaf-playground-mount-example` 仍作为低层 batch/consumer API 保留。业务 Component、数据库 schema、palette、refs 和 handlers 都应该留在 example companion -中；Playground 只提供 source/preview 会话、读文件、窗口切换与生命周期。 +中；Playground 只提供 source/preview 会话、读文件、标准 `display-buffer` 展示与 +生命周期。 Research Shelf 本身还没有复杂到需要 feature 目录，所以完整的可执行 companion 集中在一个 `.el` 文件里，用注释区分 DATA / THEME / STATE / VIEW / ROOT；只有 diff --git a/etaf-playground.el b/etaf-playground.el index 456a4ce..2429035 100644 --- a/etaf-playground.el +++ b/etaf-playground.el @@ -67,9 +67,17 @@ :type 'boolean :group 'etaf-playground) -(defcustom etaf-playground-window-layout 'side-by-side - "Window layout used by `etaf-playground-open-example'." - :type '(choice (const side-by-side) (const stacked)) +(defcustom etaf-playground-display-action + '((display-buffer-in-side-window) + (side . right) + (slot . 0) + (window-width . 0.5)) + "Standard `display-buffer' action used for the preview buffer. +The default shows the preview in a right side window using half the frame. +Set `window-width' to a float for a ratio or an integer for a fixed column +count. Use `display-buffer-pop-up-frame' to place the preview in its own +frame." + :type 'sexp :group 'etaf-playground) ;; `read' consults this dynamically scoped safety switch. Declaring it also @@ -83,6 +91,8 @@ spec source-buffers preview-buffer + preview-window + source-frame active-extension owned-source-buffers companion-dirty-p @@ -503,6 +513,29 @@ forwarded to `etaf-mount', including an optional initial viewport." (format " ETAF Preview %s | ERROR | g retry q close" (etaf-playground-session-name session))))))) +(defun etaf-playground--refresh-session (session) + "Refresh the single mounted preview owned by SESSION." + (let ((preview (etaf-playground-session-preview-buffer session))) + (condition-case err + (progn + (when-let ((runtime (etaf-runtime-for-buffer preview))) + (with-current-buffer preview + (etaf-unmount runtime))) + (with-current-buffer preview + (setq-local buffer-read-only nil)) + (etaf-playground-mount-example + preview (etaf-playground-session-name session) session) + (with-current-buffer preview + (setq-local buffer-read-only t + header-line-format + (format " ETAF Preview %s | g refresh q close" + (etaf-playground-session-name session)))) + (force-mode-line-update t) + preview) + ((error quit) + (etaf-playground--render-error session err) + nil)))) + (defun etaf-playground-refresh (&optional target) "Refresh the preview associated with TARGET or the current source buffer. @@ -512,38 +545,22 @@ is mounted again from the Playground's perspective. Errors stay visible in the preview instead of destroying the source workspace." (interactive) (let ((session (etaf-playground--session-for-target target))) - ;; Make `C-c C-c' useful when the user opened a source file directly - ;; instead of entering through `etaf-playground-open'. - (unless session - (when-let* ((source (cond ((bufferp target) target) - ((and (stringp target) (get-buffer target)) - (get-buffer target)) - (t (current-buffer)))) - (name (etaf-playground--source-example-name source))) + (if session + (etaf-playground--refresh-session session) + ;; Make `C-c C-c' useful when the user opened a source file directly. + ;; `etaf-playground-open-example' creates, displays, and refreshes the + ;; session once, so this outer entry only returns its mounted preview. + (let* ((source (cond ((bufferp target) target) + ((and (stringp target) (get-buffer target)) + (get-buffer target)) + (t (current-buffer)))) + (name (etaf-playground--source-example-name source))) + (unless name + (user-error + "No ETAF Playground workspace is associated with this buffer")) (etaf-playground-open-example name) - (setq session (etaf-playground--session-for-target name)))) - (unless session - (user-error "No ETAF Playground workspace is associated with this buffer")) - (let ((preview (etaf-playground-session-preview-buffer session))) - (condition-case err - (progn - (when-let ((runtime (etaf-runtime-for-buffer preview))) - (with-current-buffer preview - (etaf-unmount runtime))) - (with-current-buffer preview - (setq-local buffer-read-only nil)) - (etaf-playground-mount-example - preview (etaf-playground-session-name session) session) - (with-current-buffer preview - (setq-local buffer-read-only t - header-line-format - (format " ETAF Preview %s | g refresh q close" - (etaf-playground-session-name session)))) - (force-mode-line-update t) - preview) - ((error quit) - (etaf-playground--render-error session err) - nil))))) + (setq session (etaf-playground--session-for-target name)) + (and session (etaf-playground-session-preview-buffer session)))))) ;;; Source modes and navigation @@ -854,30 +871,22 @@ the preview instead of destroying the source workspace." session)))) (defun etaf-playground--show-session (session) - "Display SESSION in a left-source/right-preview layout." + "Display SESSION through standard `display-buffer' policy." (unless noninteractive (unless (etaf-playground-session-previous-window-configuration session) (setf (etaf-playground-session-previous-window-configuration session) (current-window-configuration))) - (delete-other-windows) - (let* ((window-min-width 1) - (window-min-height 1) - (left (selected-window)) - (right (if (eq etaf-playground-window-layout 'stacked) - (progn (set-window-buffer - left - (etaf-playground--source-buffer - session - (etaf-playground-session-active-extension session))) - (split-window-below)) - (split-window-right))) - (source (etaf-playground--source-buffer + (setf (etaf-playground-session-source-frame session) (selected-frame)) + (let* ((source (etaf-playground--source-buffer session (etaf-playground-session-active-extension session))) (preview (etaf-playground-session-preview-buffer session))) - (set-window-buffer left source) - (set-window-buffer right preview) - (select-window left)))) + (switch-to-buffer source) + (let ((window (display-buffer preview etaf-playground-display-action))) + (unless (window-live-p window) + (error "ETAF Playground display action did not return a live window")) + (setf (etaf-playground-session-preview-window session) window) + window)))) (defun etaf-playground--active-source-buffer (session) "Return SESSION's active source buffer." @@ -950,6 +959,13 @@ default example there." (interactive) (if-let ((session (etaf-playground--session-for-target target))) (let* ((preview (etaf-playground-session-preview-buffer session)) + (preview-window + (etaf-playground-session-preview-window session)) + (source-frame + (etaf-playground-session-source-frame session)) + (preview-frame + (and (window-live-p preview-window) + (window-frame preview-window))) (configuration (etaf-playground-session-previous-window-configuration session))) (when-let ((runtime (and (buffer-live-p preview) @@ -965,6 +981,13 @@ default example there." etaf-playground-source-extension nil)))) (dolist (buffer (etaf-playground-session-owned-source-buffers session)) (when (buffer-live-p buffer) (kill-buffer buffer))) + (when (window-live-p preview-window) + (if (and (frame-live-p preview-frame) + (frame-live-p source-frame) + (not (eq preview-frame source-frame)) + (= (length (window-list preview-frame 'no-minibuf)) 1)) + (delete-frame preview-frame) + (quit-window nil preview-window))) (when (buffer-live-p preview) (kill-buffer preview)) (when (and configuration (window-configuration-p configuration)) diff --git a/tests/etaf-playground-tests.el b/tests/etaf-playground-tests.el index 0e2446d..f7226fc 100644 --- a/tests/etaf-playground-tests.el +++ b/tests/etaf-playground-tests.el @@ -173,6 +173,52 @@ database and mounts a test buffer before running BODY." (should (equal (etaf-playground-read-ecss "research-shelf" session) (etaf-component-styles 'etaf-research-shelf-shell))))))) +(ert-deftest etaf-playground-show-session-uses-display-buffer-action () + "Workspace display delegates preview placement to standard `display-buffer'." + (let* ((source (get-buffer-create " *etaf-display-source*")) + (preview (get-buffer-create " *etaf-display-preview*")) + (session + (etaf-playground--session-create + :name "display-test" + :source-buffers (list (cons ".etaf" source)) + :preview-buffer preview + :active-extension ".etaf")) + (action '((display-buffer-in-side-window) + (side . right) + (window-width . 0.4))) + calls) + (unwind-protect + (let ((noninteractive nil) + (etaf-playground-display-action action)) + (cl-letf (((symbol-function 'current-window-configuration) + (lambda () 'saved-window-configuration)) + ((symbol-function 'switch-to-buffer) + (lambda (buffer) + (push (list 'source buffer) calls) + buffer)) + ((symbol-function 'display-buffer) + (lambda (buffer supplied-action) + (push (list 'preview buffer supplied-action) calls) + (selected-window))) + ((symbol-function 'delete-other-windows) + (lambda (&rest _) + (ert-fail "Workspace must not delete user windows"))) + ((symbol-function 'split-window-right) + (lambda (&rest _) + (ert-fail "Workspace must not split windows directly"))) + ((symbol-function 'split-window-below) + (lambda (&rest _) + (ert-fail "Workspace must not split windows directly")))) + (should (windowp (etaf-playground--show-session session)))) + (should + (equal + (list (list 'source source) (list 'preview preview action)) + (nreverse calls))) + (should (eq (etaf-playground-session-preview-window session) + (selected-window)))) + (when (buffer-live-p source) (kill-buffer source)) + (when (buffer-live-p preview) (kill-buffer preview))))) + (ert-deftest etaf-playground-source-tabs-have-buttons-and-shortcuts () "Source tabs work through both header buttons and keyboard shortcuts." (etaf-playground-test--with-app (buffer database) @@ -217,15 +263,24 @@ database and mounts a test buffer before running BODY." default-directory)))) (ignore etaf-research-shelf-database-file) (unwind-protect - (with-current-buffer source - (should (eq #'etaf-playground-refresh - (key-binding (kbd "C-c C-c")))) - (should (etaf-playground-refresh source)) - (let ((session (buffer-local-value 'etaf-playground-session source))) - (should (etaf-playground-session-p session)) - (should (etaf-runtime-p - (etaf-runtime-for-buffer - (etaf-playground-session-preview-buffer session)))))) + (let ((mount-count 0) + (original-mount + (symbol-function 'etaf-playground-mount-example))) + (cl-letf (((symbol-function 'etaf-playground-mount-example) + (lambda (&rest arguments) + (cl-incf mount-count) + (apply original-mount arguments)))) + (with-current-buffer source + (should (eq #'etaf-playground-refresh + (key-binding (kbd "C-c C-c")))) + (should (etaf-playground-refresh source)) + (let ((session + (buffer-local-value 'etaf-playground-session source))) + (should (etaf-playground-session-p session)) + (should (etaf-runtime-p + (etaf-runtime-for-buffer + (etaf-playground-session-preview-buffer session))))))) + (should (= mount-count 1))) (when (buffer-live-p source) (etaf-playground-close source))))))