;;; ebox-dsl.el --- DSL compiler facade for Ebox -*- lexical-binding: t; -*- ;;; Commentary: ;; Owns `.ebox` DSL compilation and compatibility sugar over the Ebox element ;; and style models. It does not own core render or buffer patch execution. ;;; Code: (require 'cl-lib) (require 'ebox-style) (require 'ebox-tree) (require 'ebox-flex) (require 'ebox-grid) (require 'ebox-canonical) (declare-function ebox-create "ebox" (&rest plist)) (defconst ebox-dsl--outer-values '(inline block) "Valid outer participation values for the canonical Box DSL.") (defconst ebox-dsl--layout-values '(normal row column flex grid) "Valid child layout values for the canonical Box DSL.") (defun ebox--dsl-unquote-value (value) "Unquote one static DSL property VALUE when it is quoted data." (if (and (consp value) (eq (car value) 'quote) (null (cddr value))) (cadr value) value)) (defun ebox--dsl-unquote-properties (items) "Unquote static property values in top-level DSL ITEMS. Structural child forms remain untouched; only values immediately following keyword properties are normalized." (let (result) (while items (let ((item (pop items))) (if (keywordp item) (progn (unless items (error "ebox-build: missing value for %S" item)) (push item result) (push (ebox--dsl-unquote-value (pop items)) result)) (push item result)))) (nreverse result))) (defun ebox-dsl--axis-value (props property default allowed) "Return PROPS PROPERTY or DEFAULT after validating it against ALLOWED." (let ((value (if (plist-member props property) (plist-get props property) default))) (unless (memq value allowed) (error "ebox-build: invalid %S value %S" property value)) value)) (defun ebox-dsl--with-display (node outer layout) "Return a shallow copy of NODE with canonical OUTER and LAYOUT display." (let ((copy (copy-sequence node))) (plist-put copy :display (list outer (if (eq layout 'normal) 'flow layout))) copy)) (defun ebox--build-children-layout (children) "Build a vertical default layout from CHILDREN." (setq children (delq nil children)) (cond ((null children) nil) ((null (cdr children)) (ebox-dsl-build (car children))) (t (apply #'ebox-column (mapcar #'ebox-dsl-build children))))) (defun ebox--build-box-content (children &optional _props) "Return content or child layout represented by DSL CHILDREN. The first value is string content. The second value is a lazy child node." (setq children (delq nil children)) (cond ((null children) (cl-values nil nil)) ((cl-every #'stringp children) (cl-values (string-join children "\n") nil)) (t (cl-values nil (ebox--build-children-layout children))))) (defun ebox--build-box (items) "Build a box node from DSL ITEMS." (let* ((split (ebox--build-split-attrs items)) (props (car split)) (children (cdr split))) (cl-multiple-value-bind (content child-node) (ebox--build-box-content children props) (when (and (or content child-node) (plist-member props :content)) (error "ebox-build: box cannot combine :content with child nodes")) (apply #'ebox-create (append (if child-node (ebox--preformatted-box-props props) props) (when content (list :content content)) (when child-node (list :ebox-content-node child-node))))))) (defun ebox--build-text (items) "Build one canonical TextNode from DSL ITEMS." (let* ((split (ebox--build-split-attrs items)) (props (car split)) (payloads (delq nil (cdr split)))) (when props (error "Ebox build: Text author properties are not implemented in this slice")) (unless (= (length payloads) 1) (error "ebox-build: text requires exactly one string payload")) (unless (stringp (car payloads)) (error "ebox-build: text payload must be a string: %S" (car payloads))) (apply #'ebox-text-create (append props (list :value (car payloads)))))) (defun ebox--build-wrap-layout (tag props layout) "Wrap LAYOUT with box PROPS for DSL TAG, or return LAYOUT unchanged." (if (null props) layout (when (plist-member props :content) (error "ebox-build: %S cannot combine :content with child nodes" tag)) (apply #'ebox-create (append (ebox--preformatted-box-props props) (list :display '(block flow) :ebox-content-node layout))))) (defun ebox--build-layout (tag constructor items) "Build a row/column layout TAG with CONSTRUCTOR from DSL ITEMS." (let* ((split (ebox--build-split-attrs items)) (props (car split)) (children (cdr split)) (layout (apply constructor (mapcar (lambda (child) (if (ebox-child-range--descriptor-p child) child (ebox-dsl-build child))) (delq nil children))))) (ebox--build-wrap-layout tag props layout))) (defun ebox--build-flex (items) "Build a flex node from DSL ITEMS." (let* ((split (ebox--build-split-attrs items)) (props (car split)) (children (mapcar #'ebox-dsl-build (delq nil (cdr split))))) (apply #'ebox-flex (append props children)))) (defun ebox--build-flex-item (items) "Build a flex item wrapper from DSL ITEMS." (let* ((split (ebox--build-split-attrs items)) (props (car split)) (children (cdr split)) (item-props (ebox--plist-keep-keys props ebox--flex-item-prop-keys)) (box-props (ebox--plist-remove-keys props ebox--flex-item-prop-keys))) (unless children (error "ebox-build: item requires a child node")) (let ((child (ebox--flex-wrap-node-with-box-props 'item (ebox--build-children-layout children) box-props))) (dolist (key ebox--flex-item-prop-keys) (when (plist-member item-props key) (plist-put child key (plist-get item-props key)))) (apply #'ebox-flex-item child item-props)))) (defun ebox--build-grid (items) "Build a grid node from DSL ITEMS." (let* ((split (ebox-grid--split-attrs items)) (props (car split)) (children (mapcar #'ebox-dsl-build (delq nil (cdr split))))) (apply #'ebox-grid (append props children)))) (defun ebox--build-spacer (items) "Build a spacer node from DSL ITEMS." (let* ((split (ebox--build-split-attrs items)) (props (car split)) (children (cdr split))) (when children (error "ebox-build: spacer cannot have child nodes")) (when (plist-member props :content) (error "ebox-build: spacer cannot set :content")) (apply #'ebox-spacer props))) (defun ebox--build-canonical-box (items) "Build canonical Box ITEMS with orthogonal outer and layout axes." (let* ((split (ebox--build-split-attrs items)) (props (car split)) (children (cdr split)) (outer (ebox-dsl--axis-value props :outer 'block ebox-dsl--outer-values)) (layout (ebox-dsl--axis-value props :layout 'normal ebox-dsl--layout-values)) (box-props (ebox--plist-remove-keys props '(:outer :layout))) node) (setq node (pcase layout ('normal (ebox--build-box (append box-props children))) ('row (ebox--build-layout 'box #'ebox-row (append box-props children))) ('column (ebox--build-layout 'box #'ebox-column (append box-props children))) ('flex (ebox--build-flex (append box-props children))) ('grid (ebox--build-grid (append box-props children))))) (ebox-dsl--with-display node outer layout))) (defun ebox-dsl-build (dsl) "Build an Ebox node from an ETML-style list DSL. Supported forms: (box :content \"Hello\" :width (160)) (box :content \"Fits preview\" :width (viewport)) (box :width (240) (row (box \"A\") (box \"B\"))) (row (box :content \"Left\") (spacer :width (16)) (box :content \"Right\")) (column (box :content \"Top\") (box :content \"Bottom\")) (grid :grid-template-columns ((80) (80)) (box :grid-column (1 :span 2) \"Header\")) (flex :width (320) :gap (1 (12)) (item :flex 1 (box \"A\"))) `box' and `ebox' create `ebox-create' nodes. `row', `column', `flex', and `spacer' compile to existing Ebox layout helpers. `row' and `column' may also receive box properties; those properties wrap the child layout in a box using the rendered child layout as content." (cond ((ebox--node-p dsl) dsl) ((stringp dsl) (ebox-text-create :value dsl)) ((not (and (consp dsl) (symbolp (car dsl)))) (error "ebox-build: invalid DSL node %S" dsl)) (t (let ((tag (car dsl)) (items (ebox--dsl-unquote-properties (cdr dsl)))) (pcase tag ('text (ebox--build-text items)) ('box (ebox--build-canonical-box items)) ('ebox (ebox--build-box items)) ('row (ebox--build-layout tag #'ebox-row items)) ('column (ebox--build-layout tag #'ebox-column items)) ('flex (ebox--build-flex items)) ('item (ebox--build-flex-item items)) ('spacer (ebox--build-spacer items)) ('grid (ebox--build-grid items)) (_ (error "ebox-build: unknown DSL tag %S" tag))))))) (provide 'ebox-dsl) ;;; ebox-dsl.el ends here