fix: use display-buffer for playground previews
This commit is contained in:
Kinneyzhang
parent
238b58956e
commit
09ad2b5ae8
23
README.md
23
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.
|
||||
|
||||
@ -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；只有
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))))))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user