tp/examples/reactive-status.el

;;; reactive-status.el --- Public TP reactive status watch example -*- lexical-binding: t; -*-

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

;;; Commentary:

;; Reactive status example built only from public APIs:
;; - `tp-signal-create`
;; - `tp-signal-set`
;; - `tp-watch`
;;
;; The watch surface only owns a fixed range and updates properties when the
;; status signal changes.

;;; Code:

(require 'tp)

(defconst tp-example-reactive-status-tag "STATUS"
  "Fixed status label shown by this example.")

(defun tp-example-reactive-status-mount (buffer)
  "Mount a status watch on BUFFER and return its control state plist.

The returned state has keys:

- `:buffer`   target buffer
- `:surface`  retained properties surface returned by `tp-watch`
- `:status`   status signal controlling foreground color
- `:noise`    unrelated signal used to demonstrate sparse updates
- `:range`    watched region"
  (let* ((target (get-buffer-create buffer))
         (status (tp-signal-create 'ready))
         (noise (tp-signal-create 0))
         (surface nil))
    (with-current-buffer target
      (erase-buffer)
      (insert "STATUS")
      (setq surface
            (tp-watch target 1 7
                      (lambda ()
                        (list
                         'face
                         (if (eq (tp-signal-read status) 'ready)
                             '(:foreground "ForestGreen")
                           '(:foreground "IndianRed"))
                         'help-echo
                         (tp-computed
                          (lambda ()
                            (format "status=%s"
                                    (tp-signal-read status))))))))
      (list :buffer target
            :surface surface
            :status status
            :noise noise
            :range '(1 . 7)))))

(defun tp-example-reactive-status-dispose (state)
  "Unmount reactive status STATE and dispose internal signals."
  (when-let ((surface (plist-get state :surface)))
    (when (tp-surface-live-p surface)
      (tp-surface-unmount surface))
    (setf (plist-get state :surface) nil))
  (when-let ((status (plist-get state :status)))
    (when (tp-signal-live-p status)
      (tp-signal-dispose status))
    (setf (plist-get state :status) nil))
  (when-let ((noise (plist-get state :noise)))
    (when (tp-signal-live-p noise)
      (tp-signal-dispose noise))
    (setf (plist-get state :noise) nil)))

(defun tp-example-reactive-status-set (state value)
  "Set status STATE to VALUE.

STATE must come from `tp-example-reactive-status-mount`."
  (tp-signal-set (plist-get state :status) value))

(defun tp-example-reactive-status-poke (state value)
  "Set an unrelated signal in STATE to VALUE.

This must not affect watched STATUS rendering."
  (tp-signal-set (plist-get state :noise) value))

(defun tp-example-reactive-status-clear-reactive-counters ()
  "Reset TP reactive scheduler counters.

Useful before measuring sparse update behavior."
  (tp-reactive-reset-counters))

(defun tp-example-reactive-status-watch-report (state)
  "Return `tp-surface-report` for STATE."
  (tp-surface-report (plist-get state :surface)))

(defun tp-example-reactive-status-color (state)
  "Return the effective face color on STATE's watched range.

If called outside STATE's buffer, returns nil."
  (with-current-buffer (plist-get state :buffer)
    (plist-get (tp-at 1 'face) :foreground)))

(defun tp-example-reactive-content--producer (state)
  "Return a retained content producer bound to STATE."
  (lambda (context)
    (let* ((object (tp-object-ensure context nil 'status 'text))
           (branch
            (tp-bind
             object '(example . branch)
             (lambda ()
               (if (tp-signal-read (plist-get state :enabled))
                   (cons 'primary
                         (tp-signal-read (plist-get state :primary)))
                 (cons 'fallback
                       (tp-signal-read (plist-get state :fallback)))))))
           (label
            (tp-bind
             object '(example . label)
             (lambda ()
               (pcase-let ((`(,source . ,value) (tp-binding-read branch)))
                 (format "%s:%s" source value))))))
      (tp-surface-plan-create
       :key 'status :kind 'text :text (tp-binding-read label)
       :props '(face bold) :capability 'content))))

(defun tp-example-reactive-content-mount (buffer)
  "Mount a conditional retained status in BUFFER and return its state."
  (let* ((target (get-buffer-create buffer))
         (state (list :buffer target
                      :enabled (tp-signal-create t)
                      :primary (tp-signal-create "ready")
                      :fallback (tp-signal-create "offline")))
         (producer (tp-example-reactive-content--producer state))
         (surface (tp-surface-mount
                   target producer '(:capability content))))
    (setf (plist-get state :producer) producer
          (plist-get state :surface) surface)
    state))

(defun tp-example-reactive-content-set-enabled (state enabled)
  "Set STATE's conditional branch to ENABLED and return its report."
  (tp-signal-set (plist-get state :enabled) enabled)
  (tp-surface-report (plist-get state :surface)))

(defun tp-example-reactive-content-set-primary (state value)
  "Set STATE's primary status to VALUE and return its report."
  (tp-signal-set (plist-get state :primary) value)
  (tp-surface-report (plist-get state :surface)))

(defun tp-example-reactive-content-set-fallback (state value)
  "Set STATE's fallback status to VALUE and return its report."
  (tp-signal-set (plist-get state :fallback) value)
  (tp-surface-report (plist-get state :surface)))

(defun tp-example-reactive-content-batch-primary (state values)
  "Set STATE's primary status through VALUES in one transaction."
  (tp-with-transaction
    (dolist (value values)
      (tp-signal-set (plist-get state :primary) value)))
  (tp-surface-report (plist-get state :surface)))

(defun tp-example-reactive-content-text (state)
  "Return plain retained status text from STATE."
  (with-current-buffer (plist-get state :buffer)
    (buffer-substring-no-properties (point-min) (point-max))))

(defun tp-example-reactive-content-dispose (state)
  "Unmount STATE and dispose all signals it owns."
  (when (tp-surface-live-p (plist-get state :surface))
    (tp-surface-unmount (plist-get state :surface)))
  (dolist (key '(:enabled :primary :fallback))
    (let ((signal (plist-get state key)))
      (when (tp-signal-live-p signal)
        (tp-signal-dispose signal)))))

(provide 'reactive-status)

;;; reactive-status.el ends here