749 lines
34 KiB
EmacsLisp
749 lines
34 KiB
EmacsLisp
;;; research-shelf.el --- Research Shelf application -*- lexical-binding: t; -*-
|
||
|
||
;;; Commentary:
|
||
|
||
;; This deliberately compact companion keeps the small application's complete
|
||
;; behavior in one file. The sections make the boundaries visible without
|
||
;; introducing a feature directory. The neighboring .etaf and .ecss files
|
||
;; remain the Playground's inert authoring sources.
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
(require 'etaf)
|
||
(require 'etaf-ui)
|
||
(require 'etaf-sqlite)
|
||
(require 'etaf-theme-tp)
|
||
(require 'etaf-playground)
|
||
|
||
;;; ---------------------------------------------------------------------------
|
||
;;; DATA / SQLITE SOURCE
|
||
;;; ---------------------------------------------------------------------------
|
||
|
||
(defcustom etaf-research-shelf-database-file
|
||
(expand-file-name "research-shelf.sqlite" user-emacs-directory)
|
||
"SQLite file used by the Research Shelf application."
|
||
:type 'file
|
||
:group 'etaf)
|
||
|
||
(defcustom etaf-research-shelf-fixture-size 256
|
||
"Minimum deterministic records installed in the Playground database."
|
||
:type 'natnum
|
||
:group 'etaf)
|
||
|
||
(defcustom etaf-research-shelf-page-size 12
|
||
"Number of records shown on one Research Shelf page."
|
||
:type 'positive-integer
|
||
:group 'etaf)
|
||
|
||
(defconst etaf-research-shelf-seed-records
|
||
'((:id 1 :title "The Shape of Tools" :author "M. Abramson"
|
||
:kind "Essay" :status "reading" :progress 64 :priority "High"
|
||
:starred 1 :note "The best tools make attention feel larger, not more fragmented." :updated "Today")
|
||
(:id 2 :title "Ways of Seeing" :author "John Berger"
|
||
:kind "Book" :status "unread" :progress 0 :priority "Medium"
|
||
:starred 0 :note "Look again at the relationship between image and power." :updated "Yesterday")
|
||
(:id 3 :title "The Cathedral and the Bazaar" :author "Eric S. Raymond"
|
||
:kind "Paper" :status "finished" :progress 100 :priority "Low"
|
||
:starred 1 :note "A useful contrast between closed and open production." :updated "Mon")
|
||
(:id 4 :title "Designing for Calm" :author "A. Ito"
|
||
:kind "Notes" :status "reading" :progress 32 :priority "High"
|
||
:starred 0 :note "Reduce decisions before asking for attention." :updated "Sun")
|
||
(:id 5 :title "The Craftsman" :author "Richard Sennett"
|
||
:kind "Book" :status "unread" :progress 0 :priority "Medium"
|
||
:starred 1 :note "A long-form companion for making and revising." :updated "Sat")
|
||
(:id 6 :title "How Buildings Learn" :author "Stewart Brand"
|
||
:kind "Book" :status "reading" :progress 78 :priority "Medium"
|
||
:starred 0 :note "Change is a property of useful systems." :updated "Fri")
|
||
(:id 7 :title "The Interface Is the Message" :author "N. Hara"
|
||
:kind "Essay" :status "finished" :progress 100 :priority "Low"
|
||
:starred 0 :note "A short note on visible constraints." :updated "Thu")
|
||
(:id 8 :title "Notes on Attention" :author "Simone Weil"
|
||
:kind "Notes" :status "unread" :progress 0 :priority "High"
|
||
:starred 1 :note "Attention is not force; it is patient availability." :updated "Wed"))
|
||
"Seed records installed into a new Research Shelf database once.")
|
||
|
||
(defconst etaf-research-shelf--generated-titles
|
||
'("A Pattern Language" "The Craftsman" "How Buildings Learn"
|
||
"The Interface Is the Message" "Notes on Attention"
|
||
"Ways of Making" "The Timeless Way of Building"
|
||
"Designing for the Real World" "The Practice of Everyday Life"
|
||
"Small Tools, Large Consequences")
|
||
"Stable title vocabulary for generated fixture records.")
|
||
|
||
(defconst etaf-research-shelf--generated-authors
|
||
'("C. Alexander" "Richard Sennett" "Stewart Brand" "N. Hara"
|
||
"Simone Weil" "M. Ito" "A. Ito" "V. Papanek" "M. de Certeau"
|
||
"You")
|
||
"Stable author vocabulary for generated fixture records.")
|
||
|
||
(defun etaf-research-shelf--generated-record (id index)
|
||
"Return deterministic generated record ID at INDEX."
|
||
(let* ((status (nth (mod index 4) '("reading" "unread" "finished" "reading")))
|
||
(progress (pcase status
|
||
("finished" 100)
|
||
("reading" (+ 10 (* 8 (mod index 12))))
|
||
(_ 0)))
|
||
(kind (nth (mod index 4) '("Essay" "Book" "Paper" "Notes"))))
|
||
(list :id id
|
||
:title (format "%s · %03d"
|
||
(nth (mod index (length etaf-research-shelf--generated-titles))
|
||
etaf-research-shelf--generated-titles)
|
||
(1+ index))
|
||
:author (nth (mod index (length etaf-research-shelf--generated-authors))
|
||
etaf-research-shelf--generated-authors)
|
||
:kind kind :status status :progress progress
|
||
:priority (nth (mod index 3) '("High" "Medium" "Low"))
|
||
:starred (if (zerop (% index 5)) 1 0)
|
||
:note (format "Generated fixture note %03d for paging and update checks."
|
||
(1+ index))
|
||
:updated (format "D-%03d" (1+ index)))))
|
||
|
||
(defun etaf-research-shelf--fixture-records ()
|
||
"Return the deterministic fixture set sized by the user configuration."
|
||
(let* ((target (max 0 etaf-research-shelf-fixture-size))
|
||
(base (copy-tree etaf-research-shelf-seed-records))
|
||
(base-count (length base)))
|
||
(if (<= target base-count)
|
||
(cl-subseq base 0 target)
|
||
(append base
|
||
(cl-loop for id from (1+ base-count) to target
|
||
for index from 0
|
||
collect (etaf-research-shelf--generated-record id index))))))
|
||
|
||
(defun etaf-research-shelf--database ()
|
||
"Return the typed Research Shelf SQLite database description."
|
||
(etaf-sqlite-database
|
||
etaf-research-shelf-database-file
|
||
(etaf-sqlite-table
|
||
'reading_items
|
||
(list (etaf-sqlite-column :id "id" :type 'integer :primary t)
|
||
(etaf-sqlite-column :title "title" :type 'text)
|
||
(etaf-sqlite-column :author "author" :type 'text)
|
||
(etaf-sqlite-column :kind "kind" :type 'text)
|
||
(etaf-sqlite-column :status "status" :type 'text)
|
||
(etaf-sqlite-column :progress "progress" :type 'integer)
|
||
(etaf-sqlite-column :priority "priority" :type 'text)
|
||
(etaf-sqlite-column :starred "starred" :type 'integer)
|
||
(etaf-sqlite-column :note "note" :type 'text)
|
||
(etaf-sqlite-column :updated "updated" :type 'text))
|
||
:id)))
|
||
|
||
(defun etaf-research-shelf--ensure-database ()
|
||
"Initialize SQLite and top up the deterministic Playground fixture.
|
||
|
||
Existing records are preserved. Missing fixture rows receive fresh IDs so a
|
||
user's prior local additions cannot collide with the generated dataset."
|
||
(let* ((database (etaf-research-shelf--database))
|
||
(source (etaf-sqlite-source database))
|
||
(load (plist-get source :load))
|
||
(mutate (plist-get source :mutate))
|
||
(target-records (etaf-research-shelf--fixture-records))
|
||
(target (length target-records)))
|
||
(etaf-sqlite-initialize database)
|
||
(let* ((current (funcall load nil 1 (max 1 target)))
|
||
(total (plist-get current :total))
|
||
(existing-items (plist-get current :items))
|
||
(next-id (1+ (if existing-items
|
||
(apply #'max
|
||
(mapcar (lambda (row)
|
||
(or (plist-get row :id) 0))
|
||
existing-items))
|
||
0))))
|
||
(when (< total target)
|
||
(dolist (record (nthcdr total target-records))
|
||
(let ((copy (copy-sequence record)))
|
||
(plist-put copy :id next-id)
|
||
(funcall mutate 'insert copy)
|
||
(setq next-id (1+ next-id))))))
|
||
database))
|
||
|
||
;;; ---------------------------------------------------------------------------
|
||
;;; THEME / PALETTE CONTRACT
|
||
;;; ---------------------------------------------------------------------------
|
||
|
||
(etaf-theme-define-palette etaf-research-shelf-ink
|
||
:fg ("#172033" . "#F4F7FF"))
|
||
(etaf-theme-define-palette etaf-research-shelf-paper
|
||
:bg ("#F7F3EA" . "#111827"))
|
||
(etaf-theme-define-palette etaf-research-shelf-panel
|
||
:bg ("#FFFDF8" . "#182235"))
|
||
(etaf-theme-define-palette etaf-research-shelf-line
|
||
:border ("#D9D4C9" . "#34435A"))
|
||
(etaf-theme-define-palette etaf-research-shelf-muted
|
||
:fg ("#6D7482" . "#AAB5C8"))
|
||
(etaf-theme-define-palette etaf-research-shelf-accent
|
||
:fg ("#3657D6" . "#8EA7FF"))
|
||
(etaf-theme-define-palette etaf-research-shelf-mint
|
||
:fg ("#3E9B8F" . "#76D6C3")
|
||
:bg ("#DCEBDD" . "#1B4721"))
|
||
(etaf-theme-define-palette etaf-research-shelf-coral
|
||
:fg ("#D86B5D" . "#FF9A8E"))
|
||
(etaf-theme-define-palette etaf-research-shelf-amber
|
||
:fg ("#C58A3A" . "#F0C36A"))
|
||
(etaf-theme-define-palette etaf-research-shelf-soft
|
||
:bg ("#F1EEE7" . "#202C42"))
|
||
|
||
(defconst etaf-research-shelf--palette-bindings
|
||
'(:ink (etaf-research-shelf-ink . :fg)
|
||
:paper (etaf-research-shelf-paper . :bg)
|
||
:panel (etaf-research-shelf-panel . :bg)
|
||
:line (etaf-research-shelf-line . :border)
|
||
:muted (etaf-research-shelf-muted . :fg)
|
||
:accent (etaf-research-shelf-accent . :fg)
|
||
:mint (etaf-research-shelf-mint . :fg)
|
||
:mint-bg (etaf-research-shelf-mint . :bg)
|
||
:coral (etaf-research-shelf-coral . :fg)
|
||
:amber (etaf-research-shelf-amber . :fg)
|
||
:soft (etaf-research-shelf-soft . :bg))
|
||
"Mapping from product roles to the optional TP palette adapter.")
|
||
|
||
(defun etaf-research-shelf--theme (model)
|
||
"Return MODEL's current semantic product palette."
|
||
(etaf-theme-from-tp-palettes
|
||
etaf-research-shelf--palette-bindings
|
||
(if (etaf-value (plist-get model :dark)) 'dark 'light)))
|
||
|
||
(defun etaf-research-shelf--theme-defaults (model)
|
||
"Return MODEL palette plus the public ETAF UI semantic token contract."
|
||
(let* ((palette (etaf-research-shelf--theme model))
|
||
(ink (plist-get palette :ink))
|
||
(paper (plist-get palette :paper))
|
||
(panel (plist-get palette :panel))
|
||
(line (plist-get palette :line))
|
||
(muted (plist-get palette :muted))
|
||
(accent (plist-get palette :accent))
|
||
(mint (plist-get palette :mint))
|
||
(mint-bg (plist-get palette :mint-bg))
|
||
(coral (plist-get palette :coral))
|
||
(soft (plist-get palette :soft)))
|
||
(append
|
||
palette
|
||
(list
|
||
:ui-fg ink :ui-bg paper :ui-border line :ui-muted-fg muted
|
||
:ui-danger-fg coral :ui-success-fg mint
|
||
:ui-disabled-fg muted :ui-disabled-bg soft
|
||
:ui-disabled-border line
|
||
:ui-button-primary-fg paper :ui-button-primary-bg accent
|
||
:ui-button-primary-border accent
|
||
:ui-button-secondary-fg ink :ui-button-secondary-bg mint
|
||
:ui-button-secondary-border mint
|
||
:ui-button-ghost-fg ink :ui-button-ghost-bg panel
|
||
:ui-button-ghost-border line
|
||
:ui-checkbox-enabled-fg ink :ui-checkbox-enabled-bg mint
|
||
:ui-checkbox-enabled-border mint
|
||
:ui-checkbox-disabled-fg muted :ui-checkbox-disabled-bg soft
|
||
:ui-checkbox-disabled-border line
|
||
:ui-grid-border line :ui-grid-selected-fg mint
|
||
:ui-grid-selected-bg mint-bg
|
||
:ui-grid-error-fg coral :ui-pagination-muted-fg muted
|
||
:ui-panel-fg ink :ui-panel-bg panel :ui-panel-border line))))
|
||
|
||
;;; ---------------------------------------------------------------------------
|
||
;;; STATE / DATA CONTROLLER / ACTIONS
|
||
;;; ---------------------------------------------------------------------------
|
||
|
||
(defun etaf-research-shelf--item-id (row)
|
||
"Return stable identity for a reading ROW."
|
||
(plist-get row :id))
|
||
|
||
(defun etaf-research-shelf--create-model (&optional initial-result)
|
||
"Create the Research Shelf model, optionally from INITIAL-RESULT."
|
||
(let* ((database (etaf-research-shelf--ensure-database))
|
||
(controller
|
||
(etaf-data-controller
|
||
(etaf-sqlite-source database)
|
||
:page-size etaf-research-shelf-page-size
|
||
:initial-result initial-result
|
||
:auto-load nil :item-key #'etaf-research-shelf--item-id
|
||
:name 'etaf-research-shelf))
|
||
(filter (etaf-ref 'all :name 'research-shelf-filter))
|
||
(dark (etaf-ref nil :name 'research-shelf-dark-theme))
|
||
(toast (etaf-ref (if initial-result
|
||
"✓ SQLite shelf ready"
|
||
"Ready to read.")
|
||
:name 'research-shelf-toast)))
|
||
(list :database database
|
||
:database-file etaf-research-shelf-database-file
|
||
:controller controller :filter filter :dark dark :toast toast)))
|
||
|
||
(defun etaf-research-shelf--controller (model)
|
||
"Return MODEL's Data Controller."
|
||
(plist-get model :controller))
|
||
|
||
(defun etaf-research-shelf--query (filter)
|
||
"Translate a product FILTER into an allowlisted equality query."
|
||
(pcase filter
|
||
('reading '(:status "reading"))
|
||
('unread '(:status "unread"))
|
||
('finished '(:status "finished"))
|
||
('starred '(:starred 1))
|
||
(_ nil)))
|
||
|
||
(defun etaf-research-shelf--load (model &optional message)
|
||
"Load MODEL and expose a visible success/error MESSAGE."
|
||
(let ((controller (etaf-research-shelf--controller model)))
|
||
(condition-case err
|
||
(progn
|
||
(etaf-data-load controller)
|
||
(setf (etaf-value (plist-get model :toast))
|
||
(or message "✓ Saved locally")))
|
||
(error
|
||
(setf (etaf-value (plist-get model :toast))
|
||
(format "⚠ Storage issue: %s" (error-message-string err)))))))
|
||
|
||
(defun etaf-research-shelf--set-filter (model filter)
|
||
"Set MODEL FILTER and reload the SQLite-backed list."
|
||
(let ((controller (etaf-research-shelf--controller model)))
|
||
(setf (etaf-value (plist-get model :filter)) filter)
|
||
(etaf-data-set-query controller (etaf-research-shelf--query filter))
|
||
(etaf-data-set-page controller 1)
|
||
(etaf-research-shelf--load
|
||
model (format "Showing %s" (capitalize (symbol-name filter))))))
|
||
|
||
(defun etaf-research-shelf--set-page-size (model page-size)
|
||
"Apply PAGE-SIZE to MODEL and reload from page one."
|
||
(unless (and (integerp page-size) (<= 1 page-size 100))
|
||
(user-error "Rows per page must be an integer from 1 to 100"))
|
||
(let ((controller (etaf-research-shelf--controller model)))
|
||
(etaf-data-set-page-size controller page-size)
|
||
(etaf-data-set-page controller 1)
|
||
(etaf-research-shelf--load
|
||
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)
|
||
"Return MODEL's selected item through the Data Controller identity contract."
|
||
(etaf-data-selected-item (etaf-research-shelf--controller model)))
|
||
|
||
(defun etaf-research-shelf--mutate (model operation payload message)
|
||
"Apply OPERATION PAYLOAD for MODEL and show MESSAGE on success."
|
||
(let ((controller (etaf-research-shelf--controller model)))
|
||
(condition-case err
|
||
(prog1
|
||
(etaf-data-mutate controller operation payload)
|
||
(setf (etaf-value (plist-get model :toast)) message))
|
||
(error
|
||
(setf (etaf-value (plist-get model :toast))
|
||
(format "⚠ Could not save: %s" (error-message-string err)))))))
|
||
|
||
(defun etaf-research-shelf--update-selected (model fields message)
|
||
"Update selected MODEL record with FIELDS and show MESSAGE."
|
||
(when-let ((row (etaf-research-shelf--selected model)))
|
||
(etaf-research-shelf--mutate
|
||
model 'update
|
||
(append (list :id (plist-get row :id)) fields)
|
||
message)))
|
||
|
||
;; Named Actions keep product mutations out of View callbacks. The View layer
|
||
;; only dispatches these stable application commands with the current model.
|
||
(etaf-action-define etaf-research-shelf-filter (runtime model filter)
|
||
"Apply FILTER to MODEL."
|
||
(ignore runtime)
|
||
(etaf-research-shelf--set-filter model filter))
|
||
|
||
(etaf-action-define etaf-research-shelf-reload (runtime model)
|
||
"Reload MODEL's data source."
|
||
(ignore runtime)
|
||
(etaf-research-shelf--load model "✓ Library reloaded"))
|
||
|
||
(etaf-action-define etaf-research-shelf-page-size (runtime model page-size)
|
||
"Apply MODEL's page size from the controlled number input."
|
||
(ignore runtime)
|
||
(etaf-research-shelf--set-page-size model page-size))
|
||
|
||
(etaf-action-define etaf-research-shelf-add (runtime model)
|
||
"Insert a new reading into MODEL."
|
||
(ignore runtime)
|
||
(etaf-research-shelf--mutate
|
||
model 'insert
|
||
'(:title "New reading" :author "You" :kind "Notes"
|
||
:status "unread" :progress 0 :priority "Medium"
|
||
:starred 0 :note "A new note waiting for your attention."
|
||
:updated "Just now")
|
||
"✓ Added to your shelf"))
|
||
|
||
(etaf-action-define etaf-research-shelf-progress (runtime model)
|
||
"Advance the selected reading by ten percent."
|
||
(ignore runtime)
|
||
(when-let* ((current (etaf-research-shelf--selected model))
|
||
(value (or (plist-get current :progress) 0)))
|
||
(etaf-research-shelf--update-selected
|
||
model (list :progress (min 100 (+ value 10))
|
||
:status (if (>= (+ value 10) 100) "finished" "reading")
|
||
:updated "Just now")
|
||
"✓ Progress saved")))
|
||
|
||
(etaf-action-define etaf-research-shelf-finish (runtime model)
|
||
"Mark the selected reading finished."
|
||
(ignore runtime)
|
||
(etaf-research-shelf--update-selected
|
||
model '(:progress 100 :status "finished" :updated "Just now")
|
||
"✓ Marked finished"))
|
||
|
||
(etaf-action-define etaf-research-shelf-star (runtime model)
|
||
"Toggle the selected reading's star."
|
||
(ignore runtime)
|
||
(when-let ((current (etaf-research-shelf--selected model)))
|
||
(let ((starred (= 1 (or (plist-get current :starred) 0))))
|
||
(etaf-research-shelf--update-selected
|
||
model (list :starred (if starred 0 1) :updated "Just now")
|
||
(if starred "Removed star" "★ Starred locally")))))
|
||
|
||
(etaf-action-define etaf-research-shelf-archive (runtime model)
|
||
"Archive the selected reading."
|
||
(ignore runtime)
|
||
(etaf-research-shelf--update-selected
|
||
model '(:status "archived" :updated "Just now") "↗ Archived"))
|
||
|
||
;;; ---------------------------------------------------------------------------
|
||
;;; VIEW / COMPONENTS / COMPOSITION
|
||
;;; ---------------------------------------------------------------------------
|
||
|
||
(defconst etaf-research-shelf--grid-columns
|
||
'((:key :title :label "Title" :width 21)
|
||
(:key :author :label "Author" :width 12)
|
||
(:key :status :label "Status" :width 10)
|
||
(:key :progress :label "Progress" :width 8)
|
||
(:key :kind :label "Kind" :width 7))
|
||
"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)
|
||
"Return a readable status label for STATUS."
|
||
(pcase status
|
||
("reading" "◷ In progress")
|
||
("finished" "✓ Finished")
|
||
("archived" "↗ Archived")
|
||
(_ "○ Unread")))
|
||
|
||
(defun etaf-research-shelf--filter-label (form key fallback)
|
||
"Return the static FILTER label from FORM for KEY, or FALLBACK."
|
||
(let ((entry (etaf-research-shelf--static-child form 'filter)))
|
||
(or (and entry (eq (plist-get (cdr entry) :key) key)
|
||
(plist-get (cdr entry) :label))
|
||
(let ((entry (cl-find-if
|
||
(lambda (item)
|
||
(and (consp item) (eq (car item) 'filter)
|
||
(eq (plist-get (cdr item) :key) key)))
|
||
(cdr form))))
|
||
(or (and entry (plist-get (cdr entry) :label)) fallback)))))
|
||
|
||
(etaf-define-component etaf-research-shelf-filter-button
|
||
(&key filter-key fallback ref)
|
||
"Render one filter Button from inherited model and static filter Context."
|
||
:setup
|
||
(let ((model (etaf-inject 'research-shelf-model nil t))
|
||
(form (etaf-inject 'research-shelf-filters nil t))
|
||
(filter-key (etaf-current-prop :filter-key))
|
||
(fallback (etaf-current-prop :fallback))
|
||
(ref (etaf-current-prop :ref)))
|
||
(lambda ()
|
||
(let ((active (eq filter-key (etaf-value (plist-get model :filter)))))
|
||
(etaf-view
|
||
(button :label
|
||
(let ((label (etaf-research-shelf--filter-label
|
||
form filter-key fallback)))
|
||
(if active (concat "● " label) label))
|
||
:ref ref :variant (if active 'secondary 'ghost)
|
||
:on-press (lambda ()
|
||
(etaf-dispatch 'etaf-research-shelf-filter
|
||
model filter-key))))))))
|
||
|
||
(defun etaf-research-shelf--filter-view (model)
|
||
"Return the filter rail for MODEL and inherited filter Context."
|
||
(etaf-view
|
||
(column :class "research-shelf-filter-rail" :width 'stretch :min-width 0
|
||
:flex-grow 1 :flex-shrink 1 :flex-basis '(220)
|
||
:padding '(1 1)
|
||
:border (etaf-theme-token :line)
|
||
:color (etaf-theme-token :ink)
|
||
:bgcolor (etaf-theme-token :panel)
|
||
(label :text "Library" :face 'bold)
|
||
(label :text "VIEWS" :color (etaf-theme-token :muted))
|
||
(etaf-research-shelf-filter-button
|
||
:filter-key 'all :fallback "All" :ref 'research-shelf-filter-all)
|
||
(etaf-research-shelf-filter-button
|
||
:filter-key 'reading :fallback "In progress"
|
||
:ref 'research-shelf-filter-reading)
|
||
(etaf-research-shelf-filter-button
|
||
:filter-key 'unread :fallback "Unread" :ref 'research-shelf-filter-unread)
|
||
(etaf-research-shelf-filter-button
|
||
:filter-key 'finished :fallback "Finished"
|
||
:ref 'research-shelf-filter-finished)
|
||
(etaf-research-shelf-filter-button
|
||
:filter-key 'starred :fallback "★ Starred"
|
||
:ref 'research-shelf-filter-starred)
|
||
(spacer :height 1)
|
||
(label :text "STORAGE" :color (etaf-theme-token :muted))
|
||
(label :text (file-name-nondirectory
|
||
(plist-get model :database-file)))
|
||
(button :label "↻ Reload library" :ref 'research-shelf-reload
|
||
:variant 'ghost
|
||
:on-press (lambda ()
|
||
(etaf-dispatch 'etaf-research-shelf-reload
|
||
model))))))
|
||
|
||
(defun etaf-research-shelf--reading-list-view (model form)
|
||
"Return the reading list for MODEL and static MAIN FORM."
|
||
(let ((controller (etaf-research-shelf--controller model)))
|
||
(etaf-view
|
||
(column :class "research-shelf-list" :width 'stretch :min-width 0
|
||
:flex-grow 4 :flex-shrink 1 :flex-basis '(620)
|
||
:padding '(1 2)
|
||
:border (etaf-theme-token :line)
|
||
:bgcolor (etaf-theme-token :panel)
|
||
(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
|
||
(label :text (etaf-research-shelf--static-value
|
||
form :title "Reading queue") :face 'bold)
|
||
(label :text (format "%d items · SQLite-backed"
|
||
(or (etaf-value (etaf-data-total controller)) 0))
|
||
:color (etaf-theme-token :muted)))
|
||
(number-input :label "Rows"
|
||
:value (etaf-value (etaf-data-page-size controller))
|
||
:ref 'research-shelf-page-size :min 1 :max 100
|
||
:on-change
|
||
(lambda (next)
|
||
(etaf-dispatch 'etaf-research-shelf-page-size
|
||
model next)))
|
||
(button :label "＋ Add reading" :ref 'research-shelf-add
|
||
:variant 'secondary
|
||
:on-press (lambda ()
|
||
(etaf-dispatch 'etaf-research-shelf-add model))))
|
||
(data-grid
|
||
:controller controller
|
||
:columns etaf-research-shelf--grid-columns
|
||
:row-key #'etaf-research-shelf--item-id
|
||
:row-ref (lambda (row)
|
||
(intern (format "research-shelf-row-%s"
|
||
(etaf-research-shelf--item-id row))))
|
||
:on-row-press
|
||
(lambda (row)
|
||
(etaf-data-select-one controller
|
||
(etaf-research-shelf--item-id row)))
|
||
:loading-label "◷ Loading library…"
|
||
:error-label "⚠ Could not read the shelf. Use Reload.")
|
||
(etaf-pagination :controller controller
|
||
:previous-ref 'research-shelf-page-previous
|
||
:next-ref 'research-shelf-page-next
|
||
:color (etaf-theme-token :ink))))))
|
||
|
||
(defun etaf-research-shelf--detail-view (model form)
|
||
"Return the selected record inspector for MODEL and static FORM."
|
||
(etaf-view
|
||
(column :class "research-shelf-detail" :width 'stretch :min-width 0
|
||
:flex-grow 2 :flex-shrink 1 :flex-basis '(340)
|
||
:padding '(2 2)
|
||
:border (etaf-theme-token :line)
|
||
:bgcolor (etaf-theme-token :panel)
|
||
(label :text (etaf-research-shelf--static-value form :title
|
||
"Selected item")
|
||
:color (etaf-theme-token :accent))
|
||
(text :face 'bold
|
||
(expr :value
|
||
(if-let ((row (etaf-research-shelf--selected model)))
|
||
(plist-get row :title)
|
||
"Choose a record")))
|
||
(text :color (etaf-theme-token :muted)
|
||
(expr :value
|
||
(if-let ((row (etaf-research-shelf--selected model)))
|
||
(format "%s · %s" (plist-get row :author)
|
||
(plist-get row :kind))
|
||
"Select one row to inspect it.")))
|
||
(spacer :height 1)
|
||
(text :face 'bold
|
||
(expr :value
|
||
(if-let ((row (etaf-research-shelf--selected model)))
|
||
(etaf-research-shelf--status-label (plist-get row :status))
|
||
"○ No selection")))
|
||
(text
|
||
(expr :value
|
||
(if-let ((row (etaf-research-shelf--selected model)))
|
||
(format "Progress %d%% · Priority %s"
|
||
(or (plist-get row :progress) 0)
|
||
(plist-get row :priority))
|
||
"Progress — · Priority —")))
|
||
(text :color (etaf-theme-token :accent)
|
||
(expr :value
|
||
(let* ((row (etaf-research-shelf--selected model))
|
||
(progress (or (and row (plist-get row :progress)) 0))
|
||
(filled (max 0 (min 10 (/ progress 10)))))
|
||
(format "%s %s" (make-string filled ?█)
|
||
(make-string (- 10 filled) ?░)))))
|
||
(spacer :height 1)
|
||
(text :color (etaf-theme-token :muted)
|
||
(expr :value
|
||
(if-let ((row (etaf-research-shelf--selected model)))
|
||
(concat "“" (or (plist-get row :note) "No note yet.") "”")
|
||
"Your notes and actions will appear here.")))
|
||
(spacer :height 1)
|
||
(etaf-research-shelf-detail-actions))))
|
||
|
||
(etaf-define-component etaf-research-shelf-detail-actions ()
|
||
"Render selected-record actions from the inherited Research Shelf model."
|
||
:setup
|
||
(let ((model (etaf-inject 'research-shelf-model nil t)))
|
||
(lambda ()
|
||
(let* ((row (etaf-research-shelf--selected model))
|
||
(progress (or (and row (plist-get row :progress)) 0))
|
||
(finished (and row (equal (plist-get row :status) "finished")))
|
||
(archived (and row (equal (plist-get row :status) "archived"))))
|
||
(etaf-view
|
||
(flex :width 'stretch :flex-wrap 'wrap :gap '(1 (6))
|
||
(button :label "+ 10%" :ref 'research-shelf-progress
|
||
:variant 'secondary
|
||
:disabled (or (null row) archived (>= progress 100))
|
||
:on-press (lambda ()
|
||
(etaf-dispatch 'etaf-research-shelf-progress
|
||
model)))
|
||
(button :label "✓ Finish" :ref 'research-shelf-finish
|
||
:variant 'secondary :disabled (or (null row) finished archived)
|
||
:on-press (lambda ()
|
||
(etaf-dispatch 'etaf-research-shelf-finish
|
||
model)))
|
||
(button :label "★ Star" :ref 'research-shelf-star
|
||
:variant 'ghost :disabled (null row)
|
||
:on-press (lambda ()
|
||
(etaf-dispatch 'etaf-research-shelf-star model)))
|
||
(button :label "Archive" :ref 'research-shelf-archive
|
||
:variant 'ghost :disabled (or (null row) archived)
|
||
:on-press (lambda ()
|
||
(etaf-dispatch 'etaf-research-shelf-archive
|
||
model)))))))))
|
||
|
||
(etaf-define-component etaf-research-shelf-filter-rail ()
|
||
"Render the Research Shelf filter rail from inherited Context."
|
||
:setup
|
||
(let ((model (etaf-inject 'research-shelf-model nil t)))
|
||
(lambda () (etaf-research-shelf--filter-view model))))
|
||
|
||
(etaf-define-component etaf-research-shelf-reading-list ()
|
||
"Render the Research Shelf reading list from inherited Context."
|
||
:setup
|
||
(let ((model (etaf-inject 'research-shelf-model nil t))
|
||
(form (etaf-inject 'research-shelf-library nil t)))
|
||
(lambda () (etaf-research-shelf--reading-list-view model form))))
|
||
|
||
(etaf-define-component etaf-research-shelf-detail-inspector ()
|
||
"Render the Research Shelf detail inspector from inherited Context."
|
||
:setup
|
||
(let ((model (etaf-inject 'research-shelf-model nil t))
|
||
(form (etaf-inject 'research-shelf-detail nil t)))
|
||
(lambda () (etaf-research-shelf--detail-view model form))))
|
||
|
||
(etaf-define-component etaf-research-shelf-shell
|
||
(&key static-form initial-result)
|
||
"Compose the Research Shelf app and provide its model/theme Context."
|
||
:setup
|
||
(let* ((static-form (etaf-current-prop :static-form))
|
||
(initial-result (etaf-current-prop :initial-result))
|
||
(model (etaf-research-shelf--create-model initial-result))
|
||
(theme (etaf-computed
|
||
(lambda ()
|
||
(etaf-research-shelf--theme-defaults model))
|
||
:name 'research-shelf-theme))
|
||
(header (etaf-research-shelf--static-child static-form 'header))
|
||
(filters (etaf-research-shelf--static-child static-form 'filters))
|
||
(main (etaf-research-shelf--static-child static-form 'main))
|
||
(library (etaf-research-shelf--static-child main 'library))
|
||
(detail (etaf-research-shelf--static-child main 'detail)))
|
||
(unless initial-result
|
||
(etaf-on-mounted
|
||
(lambda ()
|
||
(etaf-research-shelf--load model "✓ SQLite shelf ready"))))
|
||
(etaf-theme-provide theme)
|
||
(etaf-provide 'research-shelf-model model)
|
||
(etaf-provide 'research-shelf-filters filters)
|
||
(etaf-provide 'research-shelf-library library)
|
||
(etaf-provide 'research-shelf-detail detail)
|
||
(lambda ()
|
||
(etaf-view
|
||
(column :class "research-shelf-shell" :width '(viewport)
|
||
:height '(viewport-height)
|
||
:color (etaf-theme-token :ink)
|
||
:bgcolor (etaf-theme-token :paper)
|
||
(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-research-shelf--static-value
|
||
header :eyebrow "Research Shelf")
|
||
:color (etaf-theme-token :accent))
|
||
(label :text (etaf-research-shelf--static-value
|
||
static-form :title "Research Shelf") :face 'bold)
|
||
(label :text (etaf-research-shelf--static-value
|
||
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
|
||
;;; ---------------------------------------------------------------------------
|
||
|
||
(defun etaf-research-shelf-root (static-form &optional ecss-form)
|
||
"Consume validated STATIC-FORM and ECSS-FORM as one root View."
|
||
(unless (eq (car static-form) 'research-shelf-shell)
|
||
(error "Unsupported Research Shelf static root: %S" static-form))
|
||
(etaf-component-set-styles 'etaf-research-shelf-shell ecss-form)
|
||
(let* ((database (etaf-research-shelf--ensure-database))
|
||
(initial-result
|
||
(condition-case nil
|
||
(etaf-data-source-load-page
|
||
(etaf-sqlite-source database)
|
||
nil 1 etaf-research-shelf-page-size)
|
||
(error nil))))
|
||
(lambda ()
|
||
(etaf-view
|
||
(research-shelf-shell
|
||
:static-form static-form :initial-result initial-result)))))
|
||
|
||
(etaf-playground-register-example
|
||
"research-shelf"
|
||
:root #'etaf-research-shelf-root
|
||
:feature 'etaf-research-shelf
|
||
:reload-on-refresh t)
|
||
|
||
;;;###autoload
|
||
(defun etaf-research-shelf-open (&optional buffer-name)
|
||
"Mount the Research Shelf, optionally displaying it in BUFFER-NAME."
|
||
(interactive)
|
||
(if buffer-name
|
||
(etaf-playground-open-example "research-shelf" buffer-name)
|
||
(etaf-playground-open-example "research-shelf")))
|
||
|
||
(provide 'etaf-research-shelf)
|
||
;;; research-shelf.el ends here
|