feat: compose Research Shelf with named slots

This commit is contained in:
Kinneyzhang 2026-08-26 00:47:04 +08:00
parent aeaaea1aba
commit 9df077f58c
2 changed files with 137 additions and 69 deletions

View File

@ -247,9 +247,11 @@ user's prior local additions cannot collide with the generated dataset."
"Return stable identity for a reading ROW." "Return stable identity for a reading ROW."
(plist-get row :id)) (plist-get row :id))
(defun etaf-research-shelf--create-model (&optional initial-result) (defun etaf-research-shelf--create-model (&optional initial-result database)
"Create the Research Shelf model, optionally from INITIAL-RESULT." "Create the Research Shelf model from DATABASE and INITIAL-RESULT.
(let* ((database (etaf-research-shelf--ensure-database)) DATABASE is bootstrapped by the root adapter exactly once before the App is
constructed. When omitted, initialize it for direct programmatic callers."
(let* ((database (or database (etaf-research-shelf--ensure-database)))
(controller (controller
(etaf-data-controller (etaf-data-controller
(etaf-sqlite-source database) (etaf-sqlite-source database)
@ -311,10 +313,6 @@ user's prior local additions cannot collide with the generated dataset."
(etaf-research-shelf--load (etaf-research-shelf--load
model (format "Showing %d rows per page" page-size)))) model (format "Showing %d rows per page" page-size))))
(defun etaf-research-shelf--items (model)
"Return loaded items for MODEL."
(etaf-value (etaf-data-items (etaf-research-shelf--controller model))))
(defun etaf-research-shelf--selected (model) (defun etaf-research-shelf--selected (model)
"Return MODEL's selected item through the Data Controller identity contract." "Return MODEL's selected item through the Data Controller identity contract."
(etaf-data-selected-item (etaf-research-shelf--controller model))) (etaf-data-selected-item (etaf-research-shelf--controller model)))
@ -411,14 +409,6 @@ user's prior local additions cannot collide with the generated dataset."
(:key :kind :label "Kind" :width 7)) (:key :kind :label "Kind" :width 7))
"Compact DataGrid columns for the Research Shelf list.") "Compact DataGrid columns for the Research Shelf list.")
(defun etaf-research-shelf--static-child (form tag)
"Return the first TAG child from inert FORM."
(etaf-playground-static-child form tag))
(defun etaf-research-shelf--static-value (form key default)
"Return KEY from inert FORM, or DEFAULT."
(etaf-playground-static-value form key default))
(defun etaf-research-shelf--status-label (status) (defun etaf-research-shelf--status-label (status)
"Return a readable status label for STATUS." "Return a readable status label for STATUS."
(pcase status (pcase status
@ -430,7 +420,7 @@ user's prior local additions cannot collide with the generated dataset."
(defun etaf-research-shelf--filter-label (form key fallback) (defun etaf-research-shelf--filter-label (form key fallback)
"Return the static FILTER label from FORM for KEY, or FALLBACK." "Return the static FILTER label from FORM for KEY, or FALLBACK."
(let ((entry (let ((entry
(etaf-research-shelf--static-child (etaf-playground-static-child
form 'research-shelf-filter-spec))) form 'research-shelf-filter-spec)))
(or (and entry (eq (plist-get (cdr entry) :key) key) (or (and entry (eq (plist-get (cdr entry) :key) key)
(plist-get (cdr entry) :label)) (plist-get (cdr entry) :label))
@ -508,7 +498,7 @@ user's prior local additions cannot collide with the generated dataset."
:bgcolor (etaf-theme-token :panel) :bgcolor (etaf-theme-token :panel)
(flex :width 'stretch :flex-wrap 'wrap :align-items 'center :gap '(1 (8)) (flex :width 'stretch :flex-wrap 'wrap :align-items 'center :gap '(1 (8))
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0 (column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
(label :text (etaf-research-shelf--static-value (label :text (etaf-playground-static-value
form :title "Reading queue") :face 'bold) form :title "Reading queue") :face 'bold)
(label :text (format "%d items · SQLite-backed" (label :text (format "%d items · SQLite-backed"
(or (etaf-value (etaf-data-total controller)) 0)) (or (etaf-value (etaf-data-total controller)) 0))
@ -550,7 +540,7 @@ user's prior local additions cannot collide with the generated dataset."
:padding '(2 2) :padding '(2 2)
:border (etaf-theme-token :line) :border (etaf-theme-token :line)
:bgcolor (etaf-theme-token :panel) :bgcolor (etaf-theme-token :panel)
(label :text (etaf-research-shelf--static-value form :title (label :text (etaf-playground-static-value form :title
"Selected item") "Selected item")
:color (etaf-theme-token :accent)) :color (etaf-theme-token :accent))
(text :face 'bold (text :face 'bold
@ -645,31 +635,103 @@ user's prior local additions cannot collide with the generated dataset."
(form (etaf-inject 'research-shelf-detail nil t))) (form (etaf-inject 'research-shelf-detail nil t)))
(lambda () (etaf-research-shelf--detail-view model form)))) (lambda () (etaf-research-shelf--detail-view model form))))
(etaf-define-component etaf-research-shelf-shell (etaf-define-component etaf-research-shelf-header ()
(&key static-form initial-result) "Render the default `header' slot from App Context."
"Compose the Research Shelf app and provide its model/theme Context." :setup
(let ((model (etaf-inject 'research-shelf-model nil t))
(root-spec (etaf-inject 'research-shelf-root-spec nil t))
(header-spec (etaf-inject 'research-shelf-header-spec nil t)))
(lambda ()
(etaf-view
(flex :class "research-shelf-header" :width 'stretch :min-width 0
:flex-wrap 'wrap :align-items 'center :gap '(1 (10))
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
(label :text (etaf-playground-static-value
header-spec :eyebrow "Research Shelf")
:color (etaf-theme-token :accent))
(label :text (etaf-playground-static-value
root-spec :title "Research Shelf") :face 'bold)
(label :text (etaf-playground-static-value
root-spec :subtitle
"A quiet place for unfinished ideas")
:color (etaf-theme-token :muted)))
(column :width 'max-content :min-width 0
:flex-grow 0 :flex-shrink 0
(checkbox :label "Dark" :ref 'research-shelf-theme-toggle
:checked (plist-get model :dark)
:on-change (lambda (value)
(setf (etaf-value (plist-get model :dark)) value)
(setf (etaf-value (plist-get model :toast))
(if value "Dark theme" "Light theme"))))))))))
(etaf-define-component etaf-research-shelf-footer ()
"Render the default `footer' slot from App Context."
:setup
(let ((model (etaf-inject 'research-shelf-model nil t))
(footer-spec (etaf-inject 'research-shelf-footer-spec nil t)))
(lambda ()
(etaf-view
(flex :class "research-shelf-footer" :width 'stretch
:flex-wrap 'wrap :gap '(1 (8))
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
(label :text (plist-get model :toast))
(label :text (etaf-playground-static-value
footer-spec :label "SQLite · saved locally")
:color (etaf-theme-token :muted)))
(label :text (file-name-nondirectory
(plist-get model :database-file))
:color (etaf-theme-token :muted)))))))
(etaf-define-component etaf-research-shelf-shell ()
"Pure responsive layout shell with named content slots.
The App supplies `header', `filters', `library', `detail', and `footer'; each
slot has a reusable built-in fallback for direct composition."
:view
(column :class "research-shelf-shell" :width '(viewport)
:height 'auto :min-height '(viewport-height)
:color (etaf-theme-token :ink)
:bgcolor (etaf-theme-token :paper)
(slot :name 'header
(etaf-research-shelf-header))
(flex :class "research-shelf-workspace" :width 'stretch
:flex-wrap 'wrap :align-items 'stretch :align-content 'start
:gap '(1 (6))
(slot :name 'filters
(etaf-research-shelf-filter-rail))
(slot :name 'library
(etaf-research-shelf-reading-list))
(slot :name 'detail
(etaf-research-shelf-detail-inspector)))
(slot :name 'footer
(etaf-research-shelf-footer))))
(etaf-define-component etaf-research-shelf-app
(&key static-form initial-result database)
"Own Research Shelf state and fill the pure Shell's named slots."
:setup :setup
(let* ((static-form (etaf-current-prop :static-form)) (let* ((static-form (etaf-current-prop :static-form))
(initial-result (etaf-current-prop :initial-result)) (initial-result (etaf-current-prop :initial-result))
(model (etaf-research-shelf--create-model initial-result)) (database (or (etaf-current-prop :database)
(etaf-research-shelf--ensure-database)))
(model (etaf-research-shelf--create-model initial-result database))
(theme (etaf-computed (theme (etaf-computed
(lambda () (lambda ()
(etaf-research-shelf--theme-defaults model)) (etaf-research-shelf--theme-defaults model))
:name 'research-shelf-theme)) :name 'research-shelf-theme))
(header (header
(etaf-research-shelf--static-child (etaf-playground-static-child
static-form 'research-shelf-header-spec)) static-form 'research-shelf-header-spec))
(filters (filters
(etaf-research-shelf--static-child (etaf-playground-static-child
static-form 'research-shelf-filter-specs)) static-form 'research-shelf-filter-specs))
(content (content
(etaf-research-shelf--static-child (etaf-playground-static-child
static-form 'research-shelf-content-spec)) static-form 'research-shelf-content-spec))
(library (library
(etaf-research-shelf--static-child (etaf-playground-static-child
content 'research-shelf-library-spec)) content 'research-shelf-library-spec))
(detail (detail
(etaf-research-shelf--static-child (etaf-playground-static-child
content 'research-shelf-detail-spec))) content 'research-shelf-detail-spec)))
(unless initial-result (unless initial-result
(etaf-on-mounted (etaf-on-mounted
@ -677,50 +739,29 @@ user's prior local additions cannot collide with the generated dataset."
(etaf-research-shelf--load model "✓ SQLite shelf ready")))) (etaf-research-shelf--load model "✓ SQLite shelf ready"))))
(etaf-theme-provide theme) (etaf-theme-provide theme)
(etaf-provide 'research-shelf-model model) (etaf-provide 'research-shelf-model model)
(etaf-provide 'research-shelf-root-spec static-form)
(etaf-provide 'research-shelf-header-spec header)
(etaf-provide 'research-shelf-filters filters) (etaf-provide 'research-shelf-filters filters)
(etaf-provide 'research-shelf-library library) (etaf-provide 'research-shelf-library library)
(etaf-provide 'research-shelf-detail detail) (etaf-provide 'research-shelf-detail detail)
(etaf-provide 'research-shelf-footer-spec
(etaf-playground-static-child
static-form 'research-shelf-footer-spec))
(lambda () (lambda ()
(etaf-view (etaf-view
(column :class "research-shelf-shell" :width '(viewport) ;; These are real ETAF named slot inputs; the `.etaf' manifest remains
:height 'auto :min-height '(viewport-height) ;; inert configuration and never pretends to be View syntax.
:color (etaf-theme-token :ink) (etaf-research-shelf-shell
:bgcolor (etaf-theme-token :paper) (slot :name 'header
(flex :class "research-shelf-header" :width 'stretch :min-width 0 (etaf-research-shelf-header))
:flex-wrap 'wrap :align-items 'center :gap '(1 (10)) (slot :name 'filters
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0 (etaf-research-shelf-filter-rail))
(label :text (etaf-research-shelf--static-value (slot :name 'library
header :eyebrow "Research Shelf") (etaf-research-shelf-reading-list))
:color (etaf-theme-token :accent)) (slot :name 'detail
(label :text (etaf-research-shelf--static-value (etaf-research-shelf-detail-inspector))
static-form :title "Research Shelf") :face 'bold) (slot :name 'footer
(label :text (etaf-research-shelf--static-value (etaf-research-shelf-footer)))))))
static-form :subtitle
"A quiet place for unfinished ideas")
:color (etaf-theme-token :muted)))
(column :width 'max-content :min-width 0
:flex-grow 0 :flex-shrink 0
(checkbox :label "Dark" :ref 'research-shelf-theme-toggle
:checked (plist-get model :dark)
:on-change (lambda (value)
(setf (etaf-value (plist-get model :dark)) value)
(setf (etaf-value (plist-get model :toast))
(if value
"Dark theme"
"Light theme"))))))
(flex :class "research-shelf-workspace" :width 'stretch
:flex-wrap 'wrap :align-items 'stretch :align-content 'start
:gap '(1 (6))
(etaf-research-shelf-filter-rail)
(etaf-research-shelf-reading-list)
(etaf-research-shelf-detail-inspector))
(flex :class "research-shelf-footer" :width 'stretch
:flex-wrap 'wrap :gap '(1 (8))
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
(label :text (plist-get model :toast)))
(label :text (file-name-nondirectory
(plist-get model :database-file))
:color (etaf-theme-token :muted))))))))
;;; --------------------------------------------------------------------------- ;;; ---------------------------------------------------------------------------
;;; ROOT / PLAYGROUND REGISTRATION ;;; ROOT / PLAYGROUND REGISTRATION
@ -730,7 +771,16 @@ user's prior local additions cannot collide with the generated dataset."
"Consume validated STATIC-FORM and ECSS-FORM as one root View." "Consume validated STATIC-FORM and ECSS-FORM as one root View."
(unless (eq (car static-form) 'research-shelf-shell) (unless (eq (car static-form) 'research-shelf-shell)
(error "Unsupported Research Shelf static root: %S" static-form)) (error "Unsupported Research Shelf static root: %S" static-form))
(etaf-component-set-styles 'etaf-research-shelf-shell ecss-form) ;; ECSS styles are scoped to a Component. Attach the same validated
;; companion stylesheet to each owning Component instead of relying on
;; selectors crossing a nested Component boundary.
(dolist (component '(etaf-research-shelf-shell
etaf-research-shelf-header
etaf-research-shelf-filter-rail
etaf-research-shelf-reading-list
etaf-research-shelf-detail-inspector
etaf-research-shelf-footer))
(etaf-component-set-styles component ecss-form))
(let* ((database (etaf-research-shelf--ensure-database)) (let* ((database (etaf-research-shelf--ensure-database))
(initial-result (initial-result
(condition-case nil (condition-case nil
@ -740,8 +790,10 @@ user's prior local additions cannot collide with the generated dataset."
(error nil)))) (error nil))))
(lambda () (lambda ()
(etaf-view (etaf-view
(research-shelf-shell (etaf-research-shelf-app
:static-form static-form :initial-result initial-result))))) :static-form static-form
:initial-result initial-result
:database database)))))
(etaf-playground-register-example (etaf-playground-register-example
"research-shelf" "research-shelf"

View File

@ -191,6 +191,22 @@ database and mounts a test buffer before running BODY."
(should-error (etaf-playground--validate-static-node unsafe tags) (should-error (etaf-playground--validate-static-node unsafe tags)
:type 'error)))) :type 'error))))
(ert-deftest etaf-playground-research-shelf-uses-runtime-named-slots ()
"The companion composes the Shell through ETAF's public named-slot API."
(let ((source (with-temp-buffer
(insert-file-contents "examples/research-shelf.el")
(buffer-string))))
(dolist (slot '("header" "filters" "library" "detail" "footer"))
(should (string-match-p
(format "(slot :name '%s" slot)
source)))
(should (string-match-p
"(etaf-define-component etaf-research-shelf-shell ()"
source))
(should (string-match-p
"(etaf-define-component etaf-research-shelf-app"
source))))
(ert-deftest etaf-playground-ecss-reader-is-inert-and-usable () (ert-deftest etaf-playground-ecss-reader-is-inert-and-usable ()
"Read the optional style companion as validated static Component styles." "Read the optional style companion as validated static Component styles."
(let ((form (etaf-playground-read-ecss "research-shelf"))) (let ((form (etaf-playground-read-ecss "research-shelf")))