592 lines
26 KiB
EmacsLisp
592 lines
26 KiB
EmacsLisp
;;; ebox-playground-tests.el --- Public Ebox example tests -*- lexical-binding: t; -*-
|
|
|
|
(require 'ert)
|
|
(require 'cl-lib)
|
|
(require 'ebox-playground)
|
|
|
|
(defconst ebox-playground-test--fixtures
|
|
'("basic.ebox" "comprehensive.ebox" "flex-reference.ebox"
|
|
"responsive-reference.ebox" "grid-reference.ebox")
|
|
"Migrated and maintained `.ebox' fixtures in the playground package.")
|
|
|
|
(defun ebox-playground-test--dynamic-width ()
|
|
"Return a list-valued width from executable DSL property code."
|
|
'(240))
|
|
|
|
(defun ebox-playground-test--dynamic-color ()
|
|
"Return a color from executable DSL property code."
|
|
"#123456")
|
|
|
|
(defun ebox-playground-test--boxes (form)
|
|
"Return every nested BOX form in FORM."
|
|
(when (consp form)
|
|
(append (when (eq (car form) 'box)
|
|
(list form))
|
|
(cl-mapcan #'ebox-playground-test--boxes form))))
|
|
|
|
(defun ebox-playground-test--forms-named (name form)
|
|
"Return every nested DSL form in FORM whose head is NAME."
|
|
(when (consp form)
|
|
(append (when (eq (car form) name)
|
|
(list form))
|
|
(cl-mapcan (lambda (child)
|
|
(ebox-playground-test--forms-named name child))
|
|
form))))
|
|
|
|
(defun ebox-playground-test--line-widths (text)
|
|
"Return rendered pixel widths for every line in TEXT."
|
|
(mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines text)))
|
|
|
|
(defun ebox-playground-test--max-line-width (text)
|
|
"Return the widest rendered pixel line in TEXT."
|
|
(apply #'max (ebox-playground-test--line-widths text)))
|
|
|
|
(defconst ebox-playground-test--grid-value-forms
|
|
'(":grid-template-columns '(auto auto)"
|
|
":grid-template-columns '((120) (74))"
|
|
":padding '(0 (2))"
|
|
":grid-template-columns '((192))"
|
|
":grid-template-columns '((88) (88))"
|
|
":grid-template-columns '(1fr 2fr)"
|
|
":grid-template-columns '((fr 1) (fr 2))"
|
|
":grid-template-columns '((minmax"
|
|
":grid-template-columns '((repeat"
|
|
":grid-template-rows '(auto auto)"
|
|
":grid-template-rows '(1fr 2fr)"
|
|
":grid-auto-columns '((64))"
|
|
":grid-auto-columns 'auto"
|
|
":grid-auto-columns '1fr"
|
|
":grid-auto-columns '((minmax"
|
|
":grid-auto-rows 2"
|
|
":grid-auto-rows 'auto"
|
|
":grid-auto-rows '1fr"
|
|
":grid-auto-rows '((minmax"
|
|
":grid-auto-flow 'row"
|
|
":grid-auto-flow 'column"
|
|
":gap 1"
|
|
":gap '(1 (14))"
|
|
":row-gap 2"
|
|
":column-gap '(28)"
|
|
":grid-row-gap 2"
|
|
":grid-column-gap '(28)"
|
|
":grid-column 2"
|
|
":grid-row 2"
|
|
":grid-column '(1 :span 2)"
|
|
":grid-row '(1 :span 2)"
|
|
":grid-column '(1 3)"
|
|
":grid-row '(1 3)"
|
|
":grid-column-span 2"
|
|
":grid-row-span 2"
|
|
":justify-items 'start"
|
|
":justify-items 'center"
|
|
":justify-items 'end"
|
|
":justify-items 'stretch"
|
|
":justify-items 'normal"
|
|
":align-items 'start"
|
|
":align-items 'center"
|
|
":align-items 'end"
|
|
":align-items 'stretch"
|
|
":align-items 'normal"
|
|
":justify-content 'start"
|
|
":justify-content 'center"
|
|
":justify-content 'end"
|
|
":justify-content 'space-between"
|
|
":justify-content 'space-around"
|
|
":justify-content 'space-evenly"
|
|
":justify-content 'stretch"
|
|
":justify-content 'normal"
|
|
":align-content 'start"
|
|
":align-content 'center"
|
|
":align-content 'end"
|
|
":align-content 'space-between"
|
|
":align-content 'space-around"
|
|
":align-content 'space-evenly"
|
|
":align-content 'stretch"
|
|
":align-content 'normal")
|
|
"Public Grid property/value fragments required in the reference fixture.")
|
|
|
|
(ert-deftest ebox-playground-tinted-content-has-explicit-ink ()
|
|
"Every tinted content box in the public fixtures should set its text color."
|
|
(dolist (file (append ebox-playground-test--fixtures
|
|
'("public-layout-gallery.ebox")))
|
|
(let ((form (ebox-playground--read-file
|
|
(expand-file-name (concat "examples/" file)
|
|
ebox-playground-directory))))
|
|
(dolist (box (ebox-playground-test--boxes form))
|
|
(let ((properties (cdr box)))
|
|
(when (and (memq :content properties)
|
|
(memq :bgcolor properties))
|
|
(should (memq :color properties))))))))
|
|
|
|
(ert-deftest ebox-playground-uses-only-public-layout-apis ()
|
|
"The example should build and render through the public Ebox entry point."
|
|
(let* ((node (ebox-playground-view))
|
|
(rendered (substring-no-properties (ebox-render node))))
|
|
(should (eq (plist-get node :ebox-type) 'stack))
|
|
(dolist (label '("Ebox Playground" "FIXED + FRACTIONAL"
|
|
"EXPLICIT PLACEMENT" "PUBLIC COMPOSITION"))
|
|
(should (string-match-p (regexp-quote label) rendered)))))
|
|
|
|
(ert-deftest ebox-playground-keeps-layout-in-ebox-source ()
|
|
"Keep concrete gallery content out of the generic Elisp runner."
|
|
(let ((runner (with-temp-buffer
|
|
(insert-file-contents
|
|
(expand-file-name "ebox-playground.el"
|
|
ebox-playground-directory))
|
|
(buffer-string))))
|
|
(should (file-readable-p ebox-playground-default-file))
|
|
(should (string-suffix-p ".ebox" ebox-playground-default-file))
|
|
(should-not (string-match-p "FIXED TRACK" runner))
|
|
(should-not (string-match-p "PUBLIC COMPOSITION" runner))
|
|
(should-not (string-match-p "GRID TOOLKIT" runner))))
|
|
|
|
(ert-deftest ebox-playground-migrated-fixtures-render-at-the-canvas-width ()
|
|
"Every migrated fixture should render through the generic file boundary."
|
|
(let ((ebox-viewport-width 720))
|
|
(dolist (file ebox-playground-test--fixtures)
|
|
(let* ((path (expand-file-name (concat "examples/" file)
|
|
ebox-playground-directory))
|
|
(text (substring-no-properties
|
|
(ebox-render (ebox-playground-view path))))
|
|
(widths (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines text))))
|
|
(should (file-readable-p path))
|
|
(should (stringp text))
|
|
(should (cl-every (lambda (width) (<= width 720)) widths))))))
|
|
|
|
(ert-deftest ebox-playground-flex-reference-uses-a-compact-default-viewport ()
|
|
"The public Flex file entry point should use the compact default viewport."
|
|
(let ((path (expand-file-name "examples/flex-reference.ebox"
|
|
ebox-playground-directory))
|
|
(name " *ebox-playground-flex-viewport-test*"))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground-open-file path name)
|
|
(with-current-buffer name
|
|
(let ((widths (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines (buffer-string)))))
|
|
(should (cl-every (lambda (width) (<= width 720)) widths)))))
|
|
(ebox-playground-close name))))
|
|
|
|
(ert-deftest ebox-playground-flex-reference-owns-document-scrolling ()
|
|
"The Flex reference root must expose one line-oriented Ebox scroll owner."
|
|
(let ((path (expand-file-name "examples/flex-reference.ebox"
|
|
ebox-playground-directory))
|
|
(name " *ebox-playground-flex-scroll-owner-test*"))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 720)
|
|
(ebox-viewport-height 36))
|
|
(ebox-playground-open-file path name)
|
|
(with-current-buffer name
|
|
(let* ((state (ebox--buffer-render-state (current-buffer)))
|
|
(table (plist-get state :scroll-state-table))
|
|
(region-id
|
|
(car
|
|
(sort (copy-sequence
|
|
(plist-get state :scroll-region-ids))
|
|
(lambda (left right)
|
|
(> (- (length (plist-get
|
|
(gethash left table)
|
|
:content-lines))
|
|
(plist-get (gethash left table)
|
|
:content-height))
|
|
(- (length (plist-get
|
|
(gethash right table)
|
|
:content-lines))
|
|
(plist-get (gethash right table)
|
|
:content-height))))))))
|
|
(should region-id)
|
|
(should (= (ebox--scroll-region-by region-id 1 1) 1))
|
|
(setq table
|
|
(plist-get (ebox--buffer-render-state (current-buffer))
|
|
:scroll-state-table))
|
|
(should (= (plist-get (gethash region-id table) :scroll-offset)
|
|
1)))))
|
|
(ebox-playground-close name))))
|
|
|
|
(ert-deftest ebox-playground-effective-viewport-prefers-window-text-width ()
|
|
"Interactive viewport resolution should prefer the window text width."
|
|
(let ((ebox-viewport-width nil))
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) 987))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(should (= (ebox-playground--effective-viewport-width
|
|
(selected-window))
|
|
971)))))
|
|
|
|
(ert-deftest ebox-playground-window-viewport-uses-ebox-sampler ()
|
|
"A preview and the Ebox resize controller share one viewport sample."
|
|
(cl-letf (((symbol-function 'ebox-viewport-window-width)
|
|
(lambda (_window) 979)))
|
|
(should (= (ebox-playground--window-viewport-width (selected-window))
|
|
979))))
|
|
|
|
(ert-deftest ebox-playground-dsl-render-uses-window-width-for-viewport ()
|
|
"C-c C-c should build viewport-dependent roots at the preview width."
|
|
(let ((preview "*Ebox Preview: /tmp/ebox-playground-viewport-render.ebox*")
|
|
(window-width 987))
|
|
(unwind-protect
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) window-width))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(with-temp-buffer
|
|
(setq buffer-file-name "/tmp/ebox-playground-viewport-render.ebox")
|
|
(insert "(box :content \"viewport\" :width '(viewport) :height 1)")
|
|
(ebox-dsl-mode)
|
|
(ebox-dsl-render)
|
|
(with-current-buffer preview
|
|
(should (= (ebox-playground-test--max-line-width
|
|
(buffer-string))
|
|
(- window-width 16))))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-dsl-render-grid-reference-fits-preview-viewport ()
|
|
"C-c C-c should render the real Grid reference inside the preview viewport."
|
|
(let* ((path (expand-file-name "examples/grid-reference.ebox"
|
|
ebox-playground-directory))
|
|
(preview (format "*Ebox Preview: %s*" path))
|
|
(window-width 699)
|
|
(viewport 683))
|
|
(unwind-protect
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) window-width))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(delete-other-windows)
|
|
(with-temp-buffer
|
|
(setq buffer-file-name path)
|
|
(insert-file-contents path)
|
|
(ebox-dsl-mode)
|
|
(ebox-dsl-render)
|
|
(with-current-buffer preview
|
|
(should (cl-every
|
|
(lambda (width) (<= width viewport))
|
|
(ebox-playground-test--line-widths
|
|
(buffer-string)))))))
|
|
(delete-other-windows)
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-dsl-render-keeps-source-left-of-preview ()
|
|
"C-c C-c should keep the source left of its rendered preview."
|
|
(let ((preview "*Ebox Preview: /tmp/ebox-playground-two-window.ebox*")
|
|
source)
|
|
(unwind-protect
|
|
(progn
|
|
(delete-other-windows)
|
|
(with-temp-buffer
|
|
(setq source (current-buffer)
|
|
buffer-file-name "/tmp/ebox-playground-two-window.ebox")
|
|
(insert "(box :content \"two windows\" :width '(viewport) :height 1)")
|
|
(ebox-dsl-mode)
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) 987))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(ebox-dsl-render))
|
|
(let* ((windows
|
|
(sort (copy-sequence (window-list nil 'no-minibuf))
|
|
(lambda (left right)
|
|
(< (window-left-column left)
|
|
(window-left-column right)))))
|
|
(left (car windows))
|
|
(right (cadr windows)))
|
|
(should (= (length windows) 2))
|
|
(should (eq (window-buffer left) source))
|
|
(should (eq (window-buffer right) (get-buffer preview))))))
|
|
(delete-other-windows)
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-preview-resizes-through-ebox-viewport-update ()
|
|
"A preview resize should publish an incremental Ebox viewport update."
|
|
(let ((preview "*Ebox Preview: /tmp/ebox-playground-viewport-resize.ebox*")
|
|
(window-width 987))
|
|
(unwind-protect
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) window-width))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(with-temp-buffer
|
|
(setq buffer-file-name "/tmp/ebox-playground-viewport-resize.ebox")
|
|
(insert "(box :content \"viewport\" :width '(viewport) :height 1)")
|
|
(ebox-dsl-mode)
|
|
(ebox-dsl-render)
|
|
(setq window-width 1234)
|
|
(with-current-buffer preview
|
|
(let ((window (get-buffer-window (current-buffer))))
|
|
(should (memq #'ebox--window-size-change
|
|
window-size-change-functions))
|
|
(let ((noninteractive nil))
|
|
(ebox--window-size-change (window-frame window)))))
|
|
(with-current-buffer preview
|
|
(should (= (ebox-playground-test--max-line-width
|
|
(buffer-string))
|
|
(- window-width 16)))
|
|
(let ((report (ebox-buffer-update-report (current-buffer))))
|
|
(should (eq (plist-get report :constraint-source) 'viewport))
|
|
(should (eq (plist-get report :strategy) 'owner-rerender))))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-flex-reference-retains-stable-scroll-reflow ()
|
|
"The Flex reference should retain scroll state when its subtree is stable."
|
|
(let* ((ebox-runtime-idle-prewarm nil)
|
|
(ebox-runtime-idle-reflow-cache-prewarm nil)
|
|
(path (expand-file-name "examples/flex-reference.ebox"
|
|
ebox-playground-directory))
|
|
(name " *ebox-playground-flex-scroll-reflow-test*"))
|
|
(unwind-protect
|
|
(let* ((buffer (ebox-render-to-buffer
|
|
name (ebox-playground-view path 720)))
|
|
(old-state (ebox--buffer-render-state buffer))
|
|
(old-root-object
|
|
(plist-get (plist-get old-state :root-node)
|
|
:surface-object))
|
|
(old-scroll-ids (copy-sequence
|
|
(plist-get old-state :scroll-region-ids)))
|
|
(old-scroll-offsets
|
|
(mapcar
|
|
(lambda (region-id)
|
|
(plist-get
|
|
(gethash region-id
|
|
(plist-get old-state :scroll-state-table))
|
|
:scroll-offset))
|
|
old-scroll-ids))
|
|
(report (ebox-rerender-buffer-with-context buffer 326 36))
|
|
(new-state (ebox--buffer-render-state buffer))
|
|
(new-root-object
|
|
(plist-get (plist-get new-state :root-node)
|
|
:surface-object))
|
|
(widths
|
|
(ebox-playground-test--line-widths
|
|
(with-current-buffer buffer
|
|
(buffer-string)))))
|
|
(should (eq (plist-get report :projection-kind)
|
|
'viewport-reflow))
|
|
(should (plist-get report :runtime-published))
|
|
(should (eq old-root-object new-root-object))
|
|
(should (cl-every
|
|
(lambda (region-id)
|
|
(member region-id
|
|
(plist-get new-state :scroll-region-ids)))
|
|
old-scroll-ids))
|
|
(should (equal old-scroll-offsets
|
|
(mapcar
|
|
(lambda (region-id)
|
|
(plist-get
|
|
(gethash region-id
|
|
(plist-get new-state
|
|
:scroll-state-table))
|
|
:scroll-offset))
|
|
old-scroll-ids)))
|
|
(should (cl-every (lambda (width) (<= width 326)) widths)))
|
|
(when (get-buffer name)
|
|
(kill-buffer name)))))
|
|
|
|
(ert-deftest ebox-playground-preview-uses-canvas-redisplay-settings ()
|
|
"A preview should suppress text-editor redisplay artifacts."
|
|
(let ((preview " *ebox-playground-preview-settings-test*"))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground--render-node-to-buffer preview "preview" 240)
|
|
(with-current-buffer preview
|
|
(should truncate-lines)
|
|
(should-not (assq 'truncation fringe-indicator-alist))
|
|
(should-not (assq 'continuation fringe-indicator-alist))
|
|
(should-not bidi-display-reordering)
|
|
(should (eq bidi-paragraph-direction 'left-to-right))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-preview-display-settings-roll-back-on-render-error ()
|
|
"A failed preview render should restore its prior display settings."
|
|
(let ((preview " *ebox-playground-preview-settings-rollback-test*"))
|
|
(unwind-protect
|
|
(progn
|
|
(with-current-buffer (get-buffer-create preview)
|
|
(setq-local truncate-lines nil)
|
|
(setq-local face-remapping-alist
|
|
'((default (:background "#111111")))))
|
|
(cl-letf (((symbol-function 'ebox-render-to-buffer)
|
|
(lambda (&rest _)
|
|
(error "Injected preview render failure"))))
|
|
(should-error
|
|
(ebox-playground--render-to-preview-buffer
|
|
preview (ebox-create :content "rollback"))))
|
|
(with-current-buffer preview
|
|
(should-not truncate-lines)
|
|
(should (equal face-remapping-alist
|
|
'((default (:background "#111111")))))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-flex-reference-paints-root-canvas ()
|
|
"The Flex reference should carry its canvas color into the preview face."
|
|
(let ((preview " *ebox-playground-flex-canvas-test*")
|
|
(path (expand-file-name "examples/flex-reference.ebox"
|
|
ebox-playground-directory)))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground--render-node-to-buffer
|
|
preview (ebox-playground-view path 720) 720)
|
|
(with-current-buffer preview
|
|
(should (equal face-remapping-alist
|
|
'((default (:background "#FAF7F0")))))
|
|
(let ((display-signature (ebox--current-display-signature))
|
|
(matching-cache-entry-p nil)
|
|
(render-cache
|
|
(plist-get (ebox--buffer-render-state (current-buffer))
|
|
:render-cache)))
|
|
(maphash
|
|
(lambda (effective-key _entry)
|
|
(let ((signature (cadr effective-key)))
|
|
(when (and (consp signature)
|
|
(equal display-signature (car signature)))
|
|
(setq matching-cache-entry-p t))))
|
|
render-cache)
|
|
(should matching-cache-entry-p))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-grid-reference-fits-preview-widths ()
|
|
"The Grid reference should stay inside split-preview width."
|
|
(let* ((viewport 691)
|
|
(path (expand-file-name "examples/grid-reference.ebox"
|
|
ebox-playground-directory))
|
|
(text (substring-no-properties
|
|
(ebox-render (ebox-playground-view path viewport)))))
|
|
(should (cl-every (lambda (width) (<= width viewport))
|
|
(ebox-playground-test--line-widths text)))))
|
|
|
|
(ert-deftest ebox-playground-grid-reference-spacers-paint-the-viewport ()
|
|
"Grid reference separators should fill the active viewport canvas."
|
|
(let ((path (expand-file-name "examples/grid-reference.ebox"
|
|
ebox-playground-directory)))
|
|
(let ((spacers (ebox-playground-test--forms-named
|
|
'spacer (ebox-playground--read-file path))))
|
|
(should (= (length spacers) 11))
|
|
(dolist (spacer spacers)
|
|
(should (equal (plist-get (cdr spacer) :width)
|
|
'(quote (viewport))))
|
|
(should (equal (plist-get (cdr spacer) :bgcolor) "#FAF7F0"))))
|
|
(dolist (viewport '(691 720))
|
|
(let* ((ebox-viewport-width viewport)
|
|
(lines (ebox-string-lines
|
|
(ebox-render (ebox-playground-view path viewport))))
|
|
(spacer-lines
|
|
(cl-remove-if-not
|
|
(lambda (line)
|
|
(equal (get-text-property 0 'display line)
|
|
`(space :width (,viewport))))
|
|
lines)))
|
|
(should (= (length spacer-lines) 11))
|
|
(dolist (line spacer-lines)
|
|
(should (equal (get-text-property 0 'display line)
|
|
`(space :width (,viewport))))
|
|
(should (= (ebox-string-pixel-width line) viewport))
|
|
(should (equal (get-text-property 0 'face line)
|
|
'(:background "#FAF7F0"))))))))
|
|
|
|
(ert-deftest ebox-playground-public-layout-gallery-fixed-spacers-paint-the-canvas ()
|
|
"The default public gallery fixed separators should keep canvas coverage."
|
|
(let* ((path (expand-file-name "examples/public-layout-gallery.ebox"
|
|
ebox-playground-directory))
|
|
(lines (ebox-string-lines
|
|
(ebox-render (ebox-playground-view path))))
|
|
(separators 0))
|
|
(dolist (line lines)
|
|
(when (equal (get-text-property 0 'display line)
|
|
'(space :width (720)))
|
|
(setq separators (1+ separators))
|
|
(should (equal (get-text-property 0 'face line)
|
|
'(:background "#FAF7F0")))))
|
|
(should (> separators 0))))
|
|
|
|
(ert-deftest ebox-playground-grid-reference-covers-public-properties ()
|
|
"The Grid reference should cover every public property and supported value form."
|
|
(let ((source (with-temp-buffer
|
|
(insert-file-contents
|
|
(expand-file-name "examples/grid-reference.ebox"
|
|
ebox-playground-directory))
|
|
(buffer-string))))
|
|
(dolist (property '(:grid-template-columns :grid-template-rows
|
|
:grid-auto-columns :grid-auto-rows :grid-auto-flow
|
|
:grid-row-gap :grid-column-gap :gap :row-gap
|
|
:column-gap
|
|
:justify-items :align-items :justify-content
|
|
:align-content :grid-column :grid-row
|
|
:grid-column-span :grid-row-span))
|
|
(should (string-match-p (regexp-quote (symbol-name property)) source)))
|
|
(dolist (fragment ebox-playground-test--grid-value-forms)
|
|
(should (string-match-p (regexp-quote fragment) source)))))
|
|
|
|
(ert-deftest ebox-playground-opens-and-closes-buffer ()
|
|
"The public open and close commands should own their buffer lifecycle."
|
|
(let ((name " *ebox-playground-test*"))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground-open name)
|
|
(should (buffer-live-p (get-buffer name)))
|
|
(with-current-buffer name
|
|
(should (string-match-p "Ebox Playground" (buffer-string)))))
|
|
(ebox-playground-close name))))
|
|
|
|
(ert-deftest ebox-playground-fits-a-compact-gui-window ()
|
|
"Keep the gallery wide enough to teach Grid without crossing 800 px frames."
|
|
(let* ((node (ebox-playground-view))
|
|
(gallery-width (plist-get (car (plist-get node :children)) :width))
|
|
(rendered (ebox-render node))
|
|
(widths (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines rendered)))
|
|
(maximum (apply #'max widths)))
|
|
(should (= maximum gallery-width))
|
|
(should (<= gallery-width 760))))
|
|
|
|
(ert-deftest ebox-playground-registers-ebox-file-mode ()
|
|
"Open Ebox DSL files in the package-owned major mode."
|
|
(with-temp-buffer
|
|
(setq buffer-file-name "/tmp/ebox-playground-mode-test.ebox")
|
|
(set-auto-mode)
|
|
(should (eq major-mode 'ebox-dsl-mode))
|
|
(should (eq (key-binding (kbd "C-c C-c")) #'ebox-dsl-render))
|
|
(should (string-match-p "C-c C-c" header-line-format))))
|
|
|
|
(ert-deftest ebox-playground-renders-ebox-file-mode-source ()
|
|
"Render a file-mode buffer through the public Ebox build path."
|
|
(let ((preview "*Ebox Preview: /tmp/ebox-playground-render-test.ebox*"))
|
|
(unwind-protect
|
|
(with-temp-buffer
|
|
(setq buffer-file-name "/tmp/ebox-playground-render-test.ebox")
|
|
(insert "(box :content \"Rendered from .ebox\" :width '(240))")
|
|
(ebox-dsl-mode)
|
|
(ebox-dsl-render)
|
|
(should (eq (window-buffer (selected-window)) (current-buffer)))
|
|
(should (get-buffer-window (get-buffer preview)))
|
|
(with-current-buffer preview
|
|
(should (string-match-p "Rendered from .ebox" (buffer-string)))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-evaluates-property-expressions ()
|
|
"Evaluate executable property values while preserving quoted constants."
|
|
(let* ((form (ebox-playground--evaluate-form
|
|
'(box :content "Dynamic property values"
|
|
:width (ebox-playground-test--dynamic-width)
|
|
:color (ebox-playground-test--dynamic-color)
|
|
:padding '(0 (4))
|
|
:text-align 'center)))
|
|
(node (ebox-build form)))
|
|
(should (equal (plist-get node :width) 240))
|
|
(should (equal (plist-get node :color) "#123456"))
|
|
(should (equal (plist-get node :padding-left-pixel) 4))
|
|
(should (eq (plist-get node :text-align) 'center))))
|
|
|
|
(provide 'ebox-playground-tests)
|
|
|
|
;;; ebox-playground-tests.el ends here
|