370 lines
16 KiB
EmacsLisp
370 lines
16 KiB
EmacsLisp
;;; ebox-canonical.el --- Typed canonical Ebox nodes -*- lexical-binding: t; -*-
|
|
|
|
;;; Commentary:
|
|
;; Owns the typed programmatic boundary between normalized author input and
|
|
;; Ebox's current runtime representation. Canonical kind, layout, source, and
|
|
;; child facts remain explicit even when the runtime reuses an existing box
|
|
;; encoding for rendering. This module does not parse the `.ebox' DSL or
|
|
;; perform measurement, layout, paint, or buffer publication.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'subr-x)
|
|
(require 'ebox-layout-config)
|
|
(require 'ebox-style)
|
|
(require 'ebox-node-factory)
|
|
(require 'ebox-child-range)
|
|
|
|
(defun ebox-canonical--validate-plist (plist context)
|
|
"Validate PLIST shape for error CONTEXT and return PLIST."
|
|
(unless (proper-list-p plist)
|
|
(error "%s properties must be a proper plist: %S" context plist))
|
|
(unless (zerop (% (length plist) 2))
|
|
(error "%s property is missing a value: %S" context (car (last plist))))
|
|
(cl-loop for key in plist by #'cddr
|
|
unless (keywordp key)
|
|
do (error "%s property name must be a keyword: %S" context key))
|
|
plist)
|
|
|
|
(defun ebox-canonical--without-keys (plist keys)
|
|
"Return PLIST without entries whose keys occur in KEYS."
|
|
(cl-loop for (key value) on plist by #'cddr
|
|
unless (memq key keys)
|
|
append (list key value)))
|
|
|
|
(defun ebox-canonical--field-values (plist field)
|
|
"Return every FIELD value from PLIST in source order."
|
|
(cl-loop for (key value) on plist by #'cddr
|
|
when (eq key field)
|
|
collect value))
|
|
|
|
(defun ebox-canonical--required-field (plist field context)
|
|
"Return exactly one required FIELD from PLIST for error CONTEXT."
|
|
(let ((values (ebox-canonical--field-values plist field)))
|
|
(unless (= (length values) 1)
|
|
(error "%s requires %S exactly once" context field))
|
|
(car values)))
|
|
|
|
(defun ebox-canonical--optional-field (plist field context)
|
|
"Return `(PRESENT . VALUE)' for optional FIELD in PLIST and CONTEXT."
|
|
(let ((values (ebox-canonical--field-values plist field)))
|
|
(when (> (length values) 1)
|
|
(error "%s accepts %S at most once" context field))
|
|
(and values (cons t (car values)))))
|
|
|
|
(defconst ebox-canonical--source-metadata-fields
|
|
'(:source-handle :key :class :id)
|
|
"Source facts accepted by both canonical Text and Box constructors.")
|
|
|
|
(defvar ebox-canonical--declaration-fact-cache
|
|
(make-hash-table :test #'eq :weakness 'key)
|
|
"Declaration-identity keyed validated canonical node facts.")
|
|
|
|
(defun ebox-canonical--source-metadata (plist context)
|
|
"Return detached source metadata from PLIST for CONTEXT.
|
|
Every metadata field is optional but may occur at most once."
|
|
(let (metadata)
|
|
(dolist (field ebox-canonical--source-metadata-fields)
|
|
(when-let* ((entry (ebox-canonical--optional-field
|
|
plist field context)))
|
|
(setq metadata
|
|
(append metadata (list field (cdr entry))))))
|
|
metadata))
|
|
|
|
(defun ebox-canonical--apply-source-metadata (node metadata)
|
|
"Attach canonical source METADATA to runtime NODE and return NODE."
|
|
(while metadata
|
|
(let ((field (pop metadata))
|
|
(value (pop metadata)))
|
|
(plist-put node
|
|
(pcase field
|
|
(:source-handle :ebox-source-handle)
|
|
(_ field))
|
|
value)
|
|
;; `:host-ref' is the private retained-geometry projection of the
|
|
;; source-owned handle. It is not a second public identity field.
|
|
(when (and (eq field :source-handle) value)
|
|
(plist-put node :host-ref value))))
|
|
node)
|
|
|
|
(defun ebox-canonical--text-measurement-property-p (property)
|
|
"Return non-nil when PROPERTY belongs to canonical Text measurement."
|
|
(eq (plist-get property :group) 'typography))
|
|
|
|
(defun ebox-canonical--box-frame-property-p (property)
|
|
"Return non-nil when PROPERTY belongs to Box geometry or participation."
|
|
(let ((contexts (plist-get property :contexts))
|
|
(group (plist-get property :group)))
|
|
(or (memq 'item contexts)
|
|
(and (memq 'box contexts)
|
|
(not (memq group '(paint typography)))))))
|
|
|
|
(defun ebox-canonical--node-properties
|
|
(props declarations-field predicate context tag)
|
|
"Return declarations, engine props, and projection need for one node.
|
|
PROPS are direct typed inputs. DECLARATIONS-FIELD is an optional normalized
|
|
author fact set. PREDICATE selects canonical node-owned values for CONTEXT
|
|
and author TAG."
|
|
(if declarations-field
|
|
(progn
|
|
(when props
|
|
(error "%s cannot mix normalized declarations with direct properties"
|
|
context))
|
|
(let* ((declarations (cdr declarations-field))
|
|
(by-tag
|
|
(or (gethash declarations
|
|
ebox-canonical--declaration-fact-cache)
|
|
(let ((table (make-hash-table :test #'eq)))
|
|
(puthash declarations table
|
|
ebox-canonical--declaration-fact-cache)
|
|
table)))
|
|
(missing (make-symbol "ebox-canonical-facts-missing"))
|
|
(cached (gethash tag by-tag missing)))
|
|
(if (not (eq cached missing))
|
|
cached
|
|
(ebox-style-validate-form-declarations tag declarations)
|
|
(let ((facts
|
|
(list declarations
|
|
(ebox-style-declaration-properties
|
|
declarations
|
|
(lambda (property)
|
|
(or (funcall predicate property)
|
|
(memq (plist-get property :group)
|
|
'(paint typography)))))
|
|
(ebox-style-declarations-require-projection-p
|
|
declarations
|
|
(lambda (property)
|
|
(or (funcall predicate property)
|
|
(memq (plist-get property :group)
|
|
'(paint typography))
|
|
(and (memq tag '(flex grid))
|
|
(memq tag
|
|
(plist-get property
|
|
:contexts)))))))))
|
|
(setf (nth 1 facts)
|
|
(ebox-style-expand-ebox-plist (nth 1 facts)))
|
|
(puthash tag facts by-tag)
|
|
facts))))
|
|
(let ((declarations
|
|
(if (null props)
|
|
nil
|
|
(condition-case err
|
|
(ebox-style-compile-declarations props t)
|
|
(error
|
|
(error "%s rejected properties: %s"
|
|
context (error-message-string err)))))))
|
|
(cl-loop for (id _value) on declarations by #'cddr
|
|
for property = (or (ebox-style--property id)
|
|
(error "Missing canonical Ebox property: %S"
|
|
id))
|
|
unless (funcall predicate property)
|
|
do (error "%s does not accept %S"
|
|
context (plist-get property :name)))
|
|
(list declarations
|
|
(ebox-style-expand-ebox-plist
|
|
(ebox-style-declaration-properties
|
|
declarations
|
|
(lambda (property)
|
|
(or (funcall predicate property)
|
|
(memq (plist-get property :group)
|
|
'(paint typography))))))
|
|
nil))))
|
|
|
|
(defun ebox-node-kind (node)
|
|
"Return canonical NODE kind, or nil for a legacy runtime node."
|
|
(and (listp node) (plist-get node :ebox-kind)))
|
|
|
|
(defun ebox-text-node-p (node)
|
|
"Return non-nil when NODE is a canonical TextNode."
|
|
(eq (ebox-node-kind node) 'text))
|
|
|
|
(defun ebox-box-node-p (node)
|
|
"Return non-nil when NODE is a canonical BoxNode."
|
|
(eq (ebox-node-kind node) 'box))
|
|
|
|
(defun ebox-node-source-handle (node)
|
|
"Return canonical NODE's opaque source handle."
|
|
(and (listp node) (plist-get node :ebox-source-handle)))
|
|
|
|
(defun ebox-text-node-value (node)
|
|
"Return canonical TextNode NODE's string payload."
|
|
(unless (ebox-text-node-p node)
|
|
(error "Expected canonical TextNode, got %S" node))
|
|
(plist-get node :ebox-text-value))
|
|
|
|
(defun ebox-box-node-layout (node)
|
|
"Return canonical BoxNode NODE's typed layout config."
|
|
(unless (ebox-box-node-p node)
|
|
(error "Expected canonical BoxNode, got %S" node))
|
|
(ebox-layout-config--copy (plist-get node :ebox-layout-config)))
|
|
|
|
(defun ebox-box-node-children (node)
|
|
"Return canonical BoxNode NODE's material Text/Box children."
|
|
(unless (ebox-box-node-p node)
|
|
(error "Expected canonical BoxNode, got %S" node))
|
|
(if (plist-member node :children)
|
|
(plist-get node :children)
|
|
(when-let* ((sequence (plist-get node :ebox-child-sequence)))
|
|
(ebox-child-range--flatten sequence))))
|
|
|
|
(defun ebox-box-node-range-anchors (node)
|
|
"Return transparent Range anchors retained by canonical BoxNode NODE."
|
|
(unless (ebox-box-node-p node)
|
|
(error "Expected canonical BoxNode, got %S" node))
|
|
(let ((sequence (plist-get node :ebox-child-sequence))
|
|
(offset 0)
|
|
anchors)
|
|
(when sequence
|
|
(dotimes (index (ebox-child-range--sequence-count sequence))
|
|
(let* ((segment (ebox-child-range--segment-at sequence index))
|
|
(payload (ebox-child-range--segment-payload segment))
|
|
(after (+ offset (length payload))))
|
|
(when-let* ((ref (ebox-child-range--segment-ref segment)))
|
|
(push (list :ref ref :before offset :after after) anchors))
|
|
(setq offset after))))
|
|
(nreverse anchors)))
|
|
|
|
(defun ebox-canonical--normalize-children (children)
|
|
"Return material children and optional Range sequence for CHILDREN."
|
|
(let (material segments range-p)
|
|
(dolist (entry children)
|
|
(if (ebox-child-range--descriptor-p entry)
|
|
(let ((items (ebox-child-range--descriptor-items entry)))
|
|
(unless (cl-every (lambda (item)
|
|
(or (ebox-text-node-p item)
|
|
(ebox-box-node-p item)))
|
|
items)
|
|
(error "Ebox Box Range items must be canonical Text/Box nodes: %S"
|
|
items))
|
|
(setq range-p t)
|
|
(push (cons (ebox-child-range--descriptor-ref entry) items)
|
|
segments)
|
|
(dolist (item items)
|
|
(push item material)))
|
|
(unless (or (ebox-text-node-p entry) (ebox-box-node-p entry))
|
|
(error "Ebox Box children must be canonical Text/Box nodes or Ranges: %S"
|
|
children))
|
|
(push (cons nil (list entry)) segments)
|
|
(push entry material)))
|
|
(list (nreverse material)
|
|
(and range-p
|
|
(ebox-child-range--build (nreverse segments) nil t)))))
|
|
|
|
;;;###autoload
|
|
(defun ebox-text-create (&rest plist)
|
|
"Create a canonical TextNode from evaluated PLIST.
|
|
|
|
`:value' is required and must be one string. `:source-handle', `:key',
|
|
`:class', and `:id' are optional source facts. Direct properties are limited
|
|
to text measurement. `:declarations' may carry one already-normalized Text
|
|
author fact set so paint is projected without reparsing."
|
|
(ebox-canonical--validate-plist plist "ebox-text-create")
|
|
(let* ((value (ebox-canonical--required-field
|
|
plist :value "Ebox Text"))
|
|
(declarations-field (ebox-canonical--optional-field
|
|
plist :declarations "Ebox Text"))
|
|
(source-metadata (ebox-canonical--source-metadata plist "Ebox Text"))
|
|
(props (ebox-canonical--without-keys
|
|
plist (append '(:value :declarations)
|
|
ebox-canonical--source-metadata-fields))))
|
|
(unless (stringp value)
|
|
(error "Ebox Text :value must be a string: %S" value))
|
|
(pcase-let* ((`(,declarations ,engine-props ,style-required-p)
|
|
(ebox-canonical--node-properties
|
|
props declarations-field
|
|
#'ebox-canonical--text-measurement-property-p
|
|
"Ebox Text" 'text))
|
|
(node
|
|
(ebox-node-factory--create-text-expanded
|
|
(append engine-props (list :content value))
|
|
declarations)))
|
|
(plist-put node :ebox-kind 'text)
|
|
(plist-put node :ebox-text-value value)
|
|
(ebox-canonical--apply-source-metadata node source-metadata)
|
|
(plist-put node :display '(inline flow))
|
|
(plist-put node :ebox-author-style-count
|
|
(if style-required-p 1 0))
|
|
(when style-required-p
|
|
(plist-put node :ebox-author-style-required-p t))
|
|
node)))
|
|
|
|
;;;###autoload
|
|
(defun ebox-box-create (&rest plist)
|
|
"Create a canonical BoxNode from evaluated PLIST.
|
|
|
|
`:layout' must occur exactly once as an `ebox-layout-config'.
|
|
`:children' is a list of canonical nodes. Every Layout accepts zero or more
|
|
children according to its own formatting algorithm. `:declarations' may
|
|
carry one already-normalized Box author fact set."
|
|
(ebox-canonical--validate-plist plist "ebox-box-create")
|
|
(let* ((layout (ebox-canonical--required-field
|
|
plist :layout "Ebox Box"))
|
|
(children-field (ebox-canonical--optional-field
|
|
plist :children "Ebox Box"))
|
|
(declarations-field (ebox-canonical--optional-field
|
|
plist :declarations "Ebox Box"))
|
|
(outer-field (ebox-canonical--optional-field
|
|
plist :outer "Ebox Box"))
|
|
(source-metadata (ebox-canonical--source-metadata plist "Ebox Box"))
|
|
(children (if children-field (cdr children-field) nil))
|
|
child-sequence
|
|
(outer (if outer-field (cdr outer-field) 'block))
|
|
(props (ebox-canonical--without-keys
|
|
plist (append '(:layout :children :outer :declarations)
|
|
ebox-canonical--source-metadata-fields))))
|
|
(unless (ebox-layout-config-p layout)
|
|
(error "Ebox Box :layout must be a typed layout config: %S"
|
|
layout))
|
|
(setq layout (ebox-layout-config--copy layout))
|
|
(unless (memq outer '(inline block))
|
|
(error "Ebox Box :outer must be inline or block: %S" outer))
|
|
(unless (proper-list-p children)
|
|
(error "Ebox Box :children must be a proper list: %S" children))
|
|
(pcase-let ((`(,material-children ,normalized-sequence)
|
|
(ebox-canonical--normalize-children children)))
|
|
(setq children material-children)
|
|
(setq child-sequence normalized-sequence))
|
|
(unless (memq (ebox-layout-config-kind layout)
|
|
'(normal row column flex grid))
|
|
(error "Ebox Box Layout is not implemented: %S"
|
|
(ebox-layout-config-kind layout)))
|
|
(pcase-let* ((tag (if (eq (ebox-layout-config-kind layout) 'normal)
|
|
'box
|
|
(ebox-layout-config-kind layout)))
|
|
(`(,declarations ,engine-props ,style-required-p)
|
|
(ebox-canonical--node-properties
|
|
props declarations-field
|
|
#'ebox-canonical--box-frame-property-p
|
|
"Ebox Box" tag))
|
|
(node (ebox-node-factory--create-expanded
|
|
engine-props declarations)))
|
|
(plist-put node :ebox-kind 'box)
|
|
(plist-put node :ebox-layout-config layout)
|
|
(plist-put node :children children)
|
|
(when child-sequence
|
|
(plist-put node :ebox-child-sequence child-sequence))
|
|
(ebox-canonical--apply-source-metadata node source-metadata)
|
|
(plist-put node :display
|
|
(list outer
|
|
(pcase (ebox-layout-config-kind layout)
|
|
('normal 'flow)
|
|
(kind kind))))
|
|
(let ((style-count
|
|
(+ (if style-required-p 1 0)
|
|
(cl-loop for child in children
|
|
sum (or (plist-get child
|
|
:ebox-author-style-count)
|
|
(if (plist-get
|
|
child :ebox-author-style-required-p)
|
|
1
|
|
0))))))
|
|
(plist-put node :ebox-author-style-count style-count)
|
|
(when (> style-count 0)
|
|
(plist-put node :ebox-author-style-required-p t)))
|
|
node)))
|
|
|
|
(provide 'ebox-canonical)
|
|
|
|
;;; ebox-canonical.el ends here
|