tp/examples/retained-dashboard.el

;;; retained-dashboard.el --- Public TP retained content dashboard example -*- lexical-binding: t; -*-

;; Copyright (C) 2026 Geekinney
;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Commentary:

;; A compact retained dashboard example with additive/removable/reordered
;; keyed entries.  It uses:
;; - `tp-surface-mount`
;; - `tp-surface-update`
;; - `tp-surface-unmount`
;; - `tp-surface-inspect`
;; - `tp-object-resolve`
;;
;; No stack/render/managed runtime APIs are used.

;;; Code:

(require 'tp)

(defun tp-example-dashboard--entry-label (entry)
  "Return a display label for ENTRY.

ENTRY is a plist with keys `:id` and `:label`."
  (concat " " (or (plist-get entry :label) (prin1-to-string (plist-get entry :id))) " "))

(defun tp-example-dashboard--entry-face (entry theme)
  "Return a native face declaration for ENTRY.

ENTRY may include `:active` (`t` / nil).
THEME is symbol `light` or `dark`."
  (let* ((light-active '(:weight bold :foreground "#0f6fff"))
         (light-idle '(:foreground "#657b83"))
         (dark-active '(:weight bold :foreground "#83a598"))
         (dark-idle '(:foreground "#d3d3d3"))
         (palette (if (eq theme 'dark) (cons dark-active dark-idle)
                    (cons light-active light-idle))))
    (if (plist-get entry :active)
        (car palette)
      (cdr palette))))

(defvar tp-example-dashboard-entry-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "RET") #'ignore)
    map)
  "Keymap installed on each retained dashboard entry.")

(defun tp-example-dashboard--entry-button (entry)
  "Return a BUTTON property for ENTRY."
  (format "entry:%s" (or (plist-get entry :id) "item")))

(defun tp-example-dashboard--entry-theme (state)
  "Return the active dashboard theme symbol from STATE."
  (tp-signal-read (plist-get state :theme)))

(defun tp-example-retained-dashboard--build-producer (state entries)
  "Return a dashboard producer function bound to STATE and ENTRIES.

STATE owns the theme signal.  ENTRIES is candidate content captured by the
producer and becomes committed state only after publication succeeds."
  (lambda (context)
    (let* ((theme (tp-example-dashboard--entry-theme state))
           (root (tp-object-ensure context nil 'dashboard 'group))
           (children
             (mapcar
              (lambda (entry)
                (let ((id (plist-get entry :id)))
                  (tp-object-ensure context root id 'entry)
                  (when (plist-get entry :force-failure)
                    (error "Dashboard update failure"))
                  (tp-surface-plan-create
                   :key id
                   :kind 'entry
                   :text (tp-example-dashboard--entry-label entry)
                   :props (list
                           'face (tp-example-dashboard--entry-face entry theme)
                           'keymap tp-example-dashboard-entry-keymap
                           'button (tp-example-dashboard--entry-button entry))
                   :capability 'content)))
              entries)))
      (tp-surface-plan-create
       :key 'dashboard
       :kind 'column
       :children children
       :capability 'content))))

(defun tp-example-retained-dashboard-mount (buffer &optional entries)
  "Mount a retained dashboard in BUFFER and return its control plist.

ENTRIES defaults to three sample entries and is expected to be a list of
plist records `(:id <symbol> :label <string> :active <t/nil>)`."
  (let* ((target (get-buffer-create buffer))
         (state (list :entries (or entries
                                  '((:id alpha :label "Alpha" :active t)
                                    (:id beta :label "Beta")
                                    (:id gamma :label "Gamma"))
                                  )
                      :theme (tp-signal-create 'light)
                      :buffer target))
         (producer (tp-example-retained-dashboard--build-producer
                    state (plist-get state :entries)))
         (surface (tp-surface-mount target producer
                                    '(:capability content))))
    (list :buffer target
          :surface surface
          :producer producer
          :state state)))

(defun tp-example-retained-dashboard-update (dashboard entries)
  "Update DASHBOARD with ENTRIES and run a scoped mount publication.

Return `tp-surface-report`."
  (let ((surface (plist-get dashboard :surface))
        (state (plist-get dashboard :state)))
    (let* ((producer (tp-example-retained-dashboard--build-producer
                      state entries))
           (report (tp-surface-update surface producer)))
      (setf (plist-get state :entries) entries)
      (setf (plist-get dashboard :producer) producer)
      report)))

(defun tp-example-retained-dashboard-set-theme (dashboard theme)
  "Set DASHBOARD to THEME and return its resulting surface report.

THEME must be `light` or `dark`."
  (let ((state (plist-get dashboard :state)))
    (tp-signal-set (plist-get state :theme) theme)
    (tp-surface-report (plist-get dashboard :surface))))

(defun tp-example-retained-dashboard-report (dashboard)
  "Return DASHBOARD's current surface report."
  (tp-surface-report (plist-get dashboard :surface)))

(defun tp-example-retained-dashboard-remove (dashboard)
  "Unmount DASHBOARD, dispose its signal, and return the commit report."
  (let* ((surface (plist-get dashboard :surface))
         (state (plist-get dashboard :state))
         (theme (plist-get state :theme))
         (report (when (tp-surface-live-p surface)
                   (tp-surface-unmount surface))))
    (when (tp-signal-live-p theme)
      (tp-signal-dispose theme))
    report))

(defun tp-example-retained-dashboard-entry-handle (dashboard id)
  "Resolve retained object HANDLE for dashboard ID in DASHBOARD.

Return nil when ID has no committed object."
  (tp-object-resolve (plist-get dashboard :surface)
                     (list 'dashboard id)))

(defun tp-example-retained-dashboard-text (dashboard)
  "Return DASHBOARD's plain text from its host buffer."
  (with-current-buffer (plist-get dashboard :buffer)
    (buffer-substring-no-properties (point-min) (point-max))))

(provide 'retained-dashboard)

;;; retained-dashboard.el ends here