diff --git a/ebox-canonical.el b/ebox-canonical.el index 413fd1f..1a2aeff 100644 --- a/ebox-canonical.el +++ b/ebox-canonical.el @@ -141,6 +141,7 @@ (plist-put node :ebox-kind 'text) (plist-put node :ebox-text-value value) (plist-put node :ebox-source-handle source-handle) + (plist-put node :display '(inline flow)) node))) ;;;###autoload @@ -148,8 +149,8 @@ "Create a canonical BoxNode from evaluated PLIST. `:layout' must occur exactly once as an `ebox-layout-config'. -`:children' is a list of canonical nodes. Normal layout accepts zero or one -child. Row and Column layouts accept any number of children." +`:children' is a list of canonical nodes. Every Layout accepts zero or more +children according to its own formatting algorithm." (ebox-canonical--validate-plist plist "ebox-box-create") (let* ((layout (ebox-canonical--required-field plist :layout "Ebox Box")) @@ -182,9 +183,6 @@ child. Row and Column layouts accept any number of children." '(normal row column flex grid)) (error "Ebox Box Layout is not implemented: %S" (ebox-layout-config-kind layout))) - (when (and (eq (ebox-layout-config-kind layout) 'normal) - (> (length children) 1)) - (error "Ebox Box Normal layout currently accepts at most one child")) (ebox-canonical--assert-property-role props #'ebox-canonical--box-frame-property-p "Ebox Box") (let ((node (apply #'ebox-create props))) diff --git a/ebox-layout-config.el b/ebox-layout-config.el index cee5c0b..9988d0b 100644 --- a/ebox-layout-config.el +++ b/ebox-layout-config.el @@ -8,6 +8,7 @@ ;;; Code: (require 'cl-lib) +(require 'seq) (declare-function ebox-flex-layout-config-props-p "ebox-flex" (props)) @@ -21,6 +22,41 @@ kind props) +(defconst ebox-layout-config--simple-cross-align-values + '(start center end stretch) + "Canonical Row/Column cross-axis alignment values.") + +(defun ebox-layout-config--simple-axis-props-p (props) + "Return non-nil when PROPS is canonical Row/Column config data." + (and (equal (mapcar #'car (seq-partition props 2)) + '(:item-gap :cross-align)) + (let ((gap (plist-get props :item-gap)) + (align (plist-get props :cross-align))) + (and (integerp gap) (>= gap 0) + (memq align ebox-layout-config--simple-cross-align-values))))) + +(defun ebox-layout-config--simple-axis-create (kind plist) + "Return validated simple-axis KIND LayoutConfig from PLIST." + (unless (and (proper-list-p plist) (zerop (% (length plist) 2))) + (error "Ebox %S LayoutConfig requires an even plist: %S" kind plist)) + (let ((seen (make-hash-table :test #'eq))) + (cl-loop for (key _value) on plist by #'cddr + unless (memq key '(:item-gap :cross-align)) + do (error "Ebox %S LayoutConfig does not accept %S" kind key) + do (when (gethash key seen) + (error "Duplicate Ebox %S LayoutConfig property: %S" kind key)) + do (puthash key t seen))) + (let ((props + (list :item-gap (if (plist-member plist :item-gap) + (plist-get plist :item-gap) + 0) + :cross-align (if (plist-member plist :cross-align) + (plist-get plist :cross-align) + 'stretch)))) + (unless (ebox-layout-config--simple-axis-props-p props) + (error "Invalid Ebox %S LayoutConfig properties: %S" kind props)) + (ebox-layout-config--create :kind kind :props props))) + (defun ebox-layout-config-validate (config) "Return CONFIG after revalidating its variant-owned properties." (unless (ebox-layout-config-p config) @@ -29,7 +65,9 @@ (props (ebox-layout-config-props config)) (valid-p (pcase kind - ((or 'normal 'row 'column) (null props)) + ('normal (null props)) + ((or 'row 'column) + (ebox-layout-config--simple-axis-props-p props)) ('flex (and (fboundp 'ebox-flex-layout-config-props-p) (ebox-flex-layout-config-props-p props))) @@ -55,14 +93,14 @@ (ebox-layout-config--create :kind 'normal :props nil)) ;;;###autoload -(defun ebox-row-layout-create () - "Return the canonical Row layout config." - (ebox-layout-config--create :kind 'row :props nil)) +(defun ebox-row-layout-create (&rest plist) + "Return canonical RowConfig from evaluated PLIST." + (ebox-layout-config--simple-axis-create 'row plist)) ;;;###autoload -(defun ebox-column-layout-create () - "Return the canonical Column layout config." - (ebox-layout-config--create :kind 'column :props nil)) +(defun ebox-column-layout-create (&rest plist) + "Return canonical ColumnConfig from evaluated PLIST." + (ebox-layout-config--simple-axis-create 'column plist)) (provide 'ebox-layout-config) diff --git a/ebox-layout.el b/ebox-layout.el index 65f12b4..31344be 100644 --- a/ebox-layout.el +++ b/ebox-layout.el @@ -942,6 +942,142 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values." (not (eq (and (listp node) (plist-get node :ebox-type)) 'box))) content)) +(defun ebox--normal-text-units (string) + "Return word/space/break units for inline Text STRING." + (let ((lines (ebox-string-lines string)) units) + (cl-loop for line in lines + for line-tail on lines + do (let ((position 0) + (limit (length line))) + (while (< position limit) + (let* ((space-p + (not (null + (memq (aref line position) '(?\s ?\t))))) + (end position)) + (while (and (< end limit) + (eq (not (null + (memq (aref line end) + '(?\s ?\t)))) + space-p)) + (setq end (1+ end))) + (let ((part (substring line position end))) + (push (list :kind (if space-p 'space 'word) + :rendered part + :width (ebox--string-pixel-width part)) + units)) + (setq position end)))) + unless (null (cdr line-tail)) + do (push '(:kind break) units)) + (nreverse units))) + +(defun ebox--render-normal-box-children (box children) + "Render canonical CHILDREN without flattening inline Box boundaries." + (let* ((resolved-width (ebox--wrapper-content-viewport-pixel box)) + (content-width (and resolved-width (> resolved-width 0) + resolved-width)) + (line-width 0) + pending-empty-line + line-parts segments) + (cl-labels + ((flush-line + () + (when line-parts + (push (apply #'ebox--lines-concat-horizontal + (nreverse line-parts)) + segments) + (setq line-parts nil line-width 0))) + (append-atomic + (rendered width) + (when (and content-width line-parts + (> (+ line-width width) content-width)) + (flush-line)) + (push rendered line-parts) + (setq line-width (+ line-width width) + pending-empty-line nil)) + (append-word + (rendered width) + (if (or (null content-width) (<= width content-width)) + (append-atomic rendered width) + (let ((parts (ebox--wrap-line rendered content-width 'char))) + (cl-loop for part in parts + for tail on parts + do (append-atomic + part (ebox--string-pixel-width part)) + unless (null (cdr tail)) do (flush-line))))) + (append-display-space + (rendered width) + (let ((remaining width) + (properties + (cl-loop for (key value) on (text-properties-at 0 rendered) + by #'cddr + unless (eq key 'display) + append (list key value)))) + (while (> remaining 0) + (let* ((chunk (min remaining content-width)) + (piece (ebox-pixel-space chunk))) + (when properties + (add-text-properties 0 (length piece) properties piece)) + (append-atomic piece chunk) + (setq remaining (- remaining chunk)) + (when (> remaining 0) (flush-line)))))) + (force-break + () + (if line-parts + (flush-line) + (push "" segments)) + (setq pending-empty-line t)) + (append-unit + (unit) + (pcase (plist-get unit :kind) + ('break (force-break)) + ('space + (let ((width (plist-get unit :width))) + (cond + ((and content-width (> width content-width)) + (let ((rendered (plist-get unit :rendered))) + (if (and (= (length rendered) 1) + (get-text-property 0 'display rendered)) + (append-display-space rendered width) + (append-word rendered width)))) + ((null line-parts) + (append-atomic (plist-get unit :rendered) width)) + ((and content-width (> (+ line-width width) content-width)) + (flush-line)) + (t (append-atomic (plist-get unit :rendered) width))))) + ('word + (append-word (plist-get unit :rendered) + (plist-get unit :width))) + ('box + (append-atomic (plist-get unit :rendered) + (plist-get unit :width))))) + (render-child + (child) + (let ((inline-p (eq (ebox-tree-display-outer child) 'inline)) + (rendered + (let ((ebox--inline-auto-width-intrinsic-p + (eq (ebox-tree-display-outer child) 'inline))) + (ebox--render-with-cache child)))) + (if (not inline-p) + (progn + (flush-line) + (setq pending-empty-line nil) + (push rendered segments)) + (if (eq (plist-get child :ebox-kind) 'text) + (dolist (unit (ebox--normal-text-units rendered)) + (append-unit unit)) + (append-unit + (list :kind 'box :rendered rendered + :width (ebox--string-max-pixel-width rendered)))))))) + (ebox--call-with-box-content-context + box (lambda () (dolist (child children) (render-child child)))) + (when pending-empty-line + (push "" segments) + (setq pending-empty-line nil)) + (flush-line)) + (if segments + (apply #'ebox--lines-stack-vertical (nreverse segments)) + ""))) + (defun ebox--render-box-layout-children (box) "Render canonical BOX children through its typed LayoutConfig." (let* ((kind (ebox--box-layout-kind box)) @@ -952,15 +1088,21 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values." (lambda () (pcase kind ('normal - (if children - (ebox--render-node-as-box-content (car children) box) - "")) + (ebox--render-normal-box-children box children)) ('row (ebox--call-with-box-content-context - box (lambda () (ebox--render-row-children children)))) + box (lambda () + (ebox--render-row-children + children + (ebox-layout-config-props + (plist-get box :ebox-layout-config)))))) ('column (ebox--call-with-box-content-context - box (lambda () (ebox--render-column-children children)))) + box (lambda () + (ebox--render-column-children + children + (ebox-layout-config-props + (plist-get box :ebox-layout-config)))))) ('flex (ebox--render-flex-box-children box @@ -975,7 +1117,8 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values." children)) (_ (error "Ebox Box has unsupported LayoutConfig: %S" kind))))))) (ebox--record-box-content-width-exact - box content (memq kind '(row column flex grid))) + box content (or (memq kind '(row column flex grid)) + (consp (cdr children)))) content)) (defun ebox--box-content (box) @@ -1769,13 +1912,19 @@ A sole child Range keeps a material row parent so the Range stays addressable." :display '(block row) :children nodes)))) -(defun ebox--render-row-children (children) - "Render flat row CHILDREN to one multi-line string. +(defun ebox--render-row-children (children &optional config) + "Render flat row CHILDREN with optional typed Row CONFIG. Auto-width children are rendered at intrinsic inline size while explicit viewport/definite widths keep their containing-block semantics. Shorter children are padded with blank lines so all reach the same height before horizontal concatenation." - (let* ((rendered + (let* ((gap (or (plist-get config :item-gap) 0)) + (cross-align (or (plist-get config :cross-align) 'stretch)) + (vertical-align (pcase cross-align + ('center 'center) + ('end 'bottom) + (_ 'top))) + (rendered (mapcar (lambda (child) ;; A row owns the horizontal concatenation. Its auto ;; width children must therefore measure intrinsically; @@ -1787,13 +1936,17 @@ horizontal concatenation." (max-h (if rendered (apply #'max (mapcar #'ebox-string-height rendered)) 0)) - (line-lists - (mapcar (lambda (string) - (ebox-string-lines - (ebox--height-pad string max-h))) - rendered))) - (if line-lists - (ebox-lines-join (apply #'cl-mapcar #'concat line-lists)) + pieces) + (cl-loop for string in rendered + for tail on rendered + do (push (ebox--lines-align-vertical + string max-h vertical-align) + pieces) + unless (null (cdr tail)) + do (when (> gap 0) + (push (ebox--pixel-blank gap max-h) pieces))) + (if pieces + (apply #'ebox--lines-concat-horizontal (nreverse pieces)) ""))) (defun ebox--render-concat (node) @@ -3145,8 +3298,8 @@ only used for incomplete lazy prefixes." formatted-lines (seq-take formatted-lines target-lines)))))))))) -(defun ebox--render-column-children (children) - "Render flat column CHILDREN to one multi-line string. +(defun ebox--render-column-children (children &optional config) + "Render flat column CHILDREN with optional typed Column CONFIG. Stack leaves are rendered independently. When a containing-block viewport is bound, narrower rows are padded to that available width, while wider definite @@ -3155,7 +3308,13 @@ intrinsic measurement, descendants still receive the containing block but the stack itself uses its natural max child width. A stack used as an intrinsic inline child follows the same natural-width rule and does not consume the ambient horizontal viewport." - (let* ((rendered-items + (let* ((gap (or (plist-get config :item-gap) 0)) + (cross-align (or (plist-get config :cross-align) 'stretch)) + (horizontal-align (pcase cross-align + ('center 'center) + ('end 'right) + (_ 'left))) + (rendered-items (mapcar (lambda (leaf) (let ((rendered (ebox--render-with-cache leaf))) (cons rendered @@ -3168,15 +3327,23 @@ ambient horizontal viewport." ebox--inline-auto-width-intrinsic-p) max-w (or (ebox--viewport-pixel-width nil) max-w)))) - (let ((rendered - (apply #'ebox--lines-stack-vertical - (mapcar (lambda (item) - (let ((rendered (car item)) - (width (cdr item))) - (if (< width target-w) - (ebox--width-pad rendered (- target-w width)) - rendered))) - rendered-items)))) + (let (pieces) + (cl-loop for item in rendered-items + for tail on rendered-items + do (push (let ((rendered (car item)) + (width (cdr item))) + (if (< width target-w) + (ebox--lines-justify + rendered target-w horizontal-align) + rendered)) + pieces) + unless (null (cdr tail)) + do (when (> gap 0) + (push (ebox--pixel-blank target-w gap) pieces))) + (let ((rendered + (if pieces + (apply #'ebox--lines-stack-vertical (nreverse pieces)) + ""))) ;; When no child overflows the containing block, stack padding proves ;; every output line already has the exact target width. A wrapping box ;; can then preserve this preformatted content without measuring every @@ -3184,7 +3351,7 @@ ambient horizontal viewport." ;; and therefore must not publish uniform-width metadata. (if (<= max-w target-w) (ebox--record-rendered-uniform-width rendered target-w) - rendered)))) + rendered))))) (defun ebox--render-stack (node) "Render a legacy stack NODE to a string." diff --git a/ebox-style.el b/ebox-style.el index 8c054e2..8af23c7 100644 --- a/ebox-style.el +++ b/ebox-style.el @@ -1312,23 +1312,30 @@ SNAPSHOT reuses a previously detached ECSS values snapshot when supplied." (defun ebox-style--apply-display-axes (node style snapshot) "Apply computed display and public axes from STYLE SNAPSHOT to NODE." - (when (ebox-style--snapshot-active-p snapshot :display) - (plist-put node :display - (ebox-style-computed-value style :display))) - (let* ((outer-specified-p + (let* ((display-specified-p + (ebox-style--specified-property-p style 'ebox/display)) + (outer-specified-p (ebox-style--specified-property-p style 'ebox/outer)) (layout-specified-p (ebox-style--specified-property-p style 'ebox/layout))) - (when (or outer-specified-p layout-specified-p) - (let* ((display (or (plist-get node :display) '(block flow))) - (outer (if outer-specified-p - (ebox-style-computed-value style :outer) - (car display))) - (layout (if layout-specified-p - (ebox-style-computed-value style :layout) - (cadr display)))) + (if (eq (plist-get node :ebox-kind) 'text) + (progn + (when (or display-specified-p outer-specified-p layout-specified-p) + (error "Ebox Text is fixed inline and rejects display axes")) + (plist-put node :display '(inline flow))) + (when (ebox-style--snapshot-active-p snapshot :display) (plist-put node :display - (list outer (if (eq layout 'normal) 'flow layout)))))) + (ebox-style-computed-value style :display))) + (when (or outer-specified-p layout-specified-p) + (let* ((display (or (plist-get node :display) '(block flow))) + (outer (if outer-specified-p + (ebox-style-computed-value style :outer) + (car display))) + (layout (if layout-specified-p + (ebox-style-computed-value style :layout) + (cadr display)))) + (plist-put node :display + (list outer (if (eq layout 'normal) 'flow layout))))))) node) (defun ebox-style-apply-computed (node style) diff --git a/tests/ebox-dsl-tests.el b/tests/ebox-dsl-tests.el index bbb6cd2..850385c 100644 --- a/tests/ebox-dsl-tests.el +++ b/tests/ebox-dsl-tests.el @@ -164,32 +164,104 @@ (ebox-text-create :value "A" :source-handle 'a :source-handle 'b) :type 'error)) -(ert-deftest ebox-canonical-normal-box-renders-one-typed-text-child () - "A canonical BoxNode should retain typed Layout and child source facts." +(ert-deftest ebox-canonical-normal-box-renders-inline-runs-and-blocks () + "Normal should retain typed children and honor inline/block boundaries." (let* ((text (ebox-text-create :value "A" :source-handle 'source-text)) + (second-text (ebox-text-create :value "B")) + (inline + (ebox-box-create + :layout (ebox-normal-layout-create) :outer 'inline + :width '(100) + :children (list (ebox-text-create :value "A B")))) + (block + (ebox-box-create + :layout (ebox-normal-layout-create) + :children (list (ebox-text-create :value "C")))) + (tail (ebox-text-create :value "D")) (layout (ebox-normal-layout-create)) (box (ebox-box-create :layout layout - :children (list text) - :source-handle 'source-box))) + :children (list text second-text inline block tail) + :source-handle 'source-box + :width '(50) :overflow 'visible)) + (rendered (ebox-render box)) + (rendered-lines (ebox-string-lines rendered)) + (lines (mapcar (lambda (line) + (string-trim-right + (substring-no-properties line))) + rendered-lines))) (should (ebox-box-node-p box)) (should-not (ebox-text-node-p box)) (should (eq (ebox-node-source-handle box) 'source-box)) (should (eq (ebox-layout-config-kind (ebox-box-node-layout box)) 'normal)) - (should (equal (ebox-box-node-children box) (list text))) - (should (string= (ebox-dsl-test--plain box) "A")))) + (should (equal (ebox-box-node-children box) + (list text second-text inline block tail))) + (should (equal (ebox--computed-display text) '(inline flow))) + (should (equal lines '("AB" "A B" "C" "D"))) + (should (>= (ebox--string-pixel-width (nth 1 rendered-lines)) 100)) + (let ((ebox-style-stylesheet (ecss-stylesheet-create))) + (plist-put text :class "fixed-inline-text") + (ebox-style-add-rule ".fixed-inline-text" (list :outer 'block)) + (should-error (ebox-render box) :type 'error)) + (cl-labels + ((normal-lines + (value &optional width) + (mapcar #'substring-no-properties + (ebox-string-lines + (ebox-render + (apply #'ebox-box-create + :layout (ebox-normal-layout-create) + :children (list (ebox-text-create :value value)) + (when width + (list :width (list width) + :overflow 'visible)))))))) + (dolist (case '(("A\n\nB" ("A" "" "B")) + ("\nA" ("" "A")) + ("A\n" ("A" "")) + ("\n" ("" "")))) + (should (equal (mapcar #'string-trim-right + (normal-lines (car case))) + (cadr case)))) + (should (equal (normal-lines " A") '(" A"))) + (should (equal (normal-lines " ") '(" "))) + (should + (equal (mapcar #'string-trim-right + (normal-lines + "abcdef x" (* 5 (ebox--string-pixel-width "a")))) + '("abcde" "f x"))) + (should + (= (length + (normal-lines + (make-string 10 ?\s) + (* 5 (ebox--string-pixel-width " ")))) + 2)) + (should (= (length (normal-lines "word" 0)) 1)) + (should (= (length (normal-lines " " 0)) 1)) + (let* ((inline-zero + (ebox-box-create + :layout (ebox-normal-layout-create) :outer 'inline + :width '(10) + :children (list (ebox-text-create :value "I")))) + (zero-parent + (ebox-box-create + :layout (ebox-normal-layout-create) :width '(0) + :overflow 'visible :children (list inline-zero)))) + (should (= (ebox-string-height (ebox-render zero-parent)) 1)))))) (ert-deftest ebox-canonical-row-box-retains-and-renders-typed-children () "A Row Box should retain one Box identity around all typed children." (let* ((left (ebox-text-create :value "A" :source-handle 'left)) - (right (ebox-text-create :value "B" :source-handle 'right)) - (box (ebox-box-create :layout (ebox-row-layout-create) + (right (ebox-text-create :value "B\nB\nB" :source-handle 'right)) + (box (ebox-box-create :layout (ebox-row-layout-create + :item-gap 5 :cross-align 'center) :children (list left right) :source-handle 'row))) (should (ebox-box-node-p box)) (should (eq (ebox-node-source-handle box) 'row)) (should (eq (ebox-layout-config-kind (ebox-box-node-layout box)) 'row)) + (should (equal (ebox-layout-config-props (ebox-box-node-layout box)) + '(:item-gap 5 :cross-align center))) (should (equal (ebox-box-node-children box) (list left right))) (should (eq (ebox-tree-node-children box) (ebox-box-node-children box))) @@ -197,16 +269,26 @@ (should (= (ebox-dsl-test--tree-count box #'ebox-node-kind) 3)) (should-not (plist-member box :ebox-content-node)) (should (equal (ebox--computed-display box) '(block row))) - (should (string= (ebox-dsl-test--plain box) "AB")))) + (let* ((rendered (ebox-render box)) + (lines (ebox-string-lines rendered)) + (middle (nth 1 lines))) + (should-not (string-match-p "A" (substring-no-properties (car lines)))) + (should (string-match-p "A.*B" (substring-no-properties middle))) + (should (= (ebox--string-pixel-width middle) + (+ (ebox--string-pixel-width "A") 5 + (ebox--string-pixel-width "B"))))))) (ert-deftest ebox-canonical-column-box-retains-and-renders-typed-children () "A Column Box should retain one Box identity around all typed children." (let* ((top (ebox-text-create :value "A")) - (bottom (ebox-text-create :value "B")) - (box (ebox-box-create :layout (ebox-column-layout-create) + (bottom (ebox-text-create :value "BBB")) + (box (ebox-box-create :layout (ebox-column-layout-create + :item-gap 1 :cross-align 'end) :children (list top bottom)))) (should (ebox-box-node-p box)) (should (eq (ebox-layout-config-kind (ebox-box-node-layout box)) 'column)) + (should (equal (ebox-layout-config-props (ebox-box-node-layout box)) + '(:item-gap 1 :cross-align end))) (should (equal (ebox-box-node-children box) (list top bottom))) (should (eq (ebox-tree-node-children box) (ebox-box-node-children box))) @@ -214,7 +296,21 @@ (should (= (ebox-dsl-test--tree-count box #'ebox-node-kind) 3)) (should-not (plist-member box :ebox-content-node)) (should (equal (ebox--computed-display box) '(block column))) - (should (string= (ebox-dsl-test--plain box) "A\nB")))) + (should (= (ebox-string-height (ebox-render box)) 3)) + (let ((lines (ebox-string-lines (ebox-render box)))) + (should (string-prefix-p " " (substring-no-properties (car lines)))) + (should (= (ebox--string-pixel-width (car lines)) + (ebox--string-pixel-width (nth 2 lines))))))) + +(ert-deftest ebox-canonical-simple-axis-config-validates-closed-schema () + "Row/Column configs should distinguish defaults from invalid explicit values." + (dolist (constructor '(ebox-row-layout-create ebox-column-layout-create)) + (should (equal (ebox-layout-config-props (funcall constructor)) + '(:item-gap 0 :cross-align stretch))) + (dolist (plist '((:item-gap nil) (:item-gap -1) + (:cross-align nil) (:cross-align bogus) + (:gap 1) (:item-gap 1 :item-gap 2))) + (should-error (apply constructor plist) :type 'error)))) (ert-deftest ebox-canonical-flex-box-uses-one-box-identity-and-child-list () "A FlexConfig should select the Box algorithm without a Flex runtime node."