0d35358e05
Replace the legacy managed layer renderer with one independent retained/reactive text runtime. TP now owns exact dependencies, stable objects, marker-backed mounts, property contribution composition, atomic publication, rollback, and direct text-property facades without ECSS or Ebox dependencies.\n\nBREAKING CHANGE: remove tp-render, tp-stack, scan-driven managed layers, inline runtime metadata, TP-owned CSS cascade APIs, and dollar-variable declarations.\n\nVerified: 290/290 ERT, shuffled 290/290 (seed 20260806), 8/8 doctests, WERROR compile-all, checkdoc, package-lint, diff-check, and isolated TP-only load.
197 lines
7.4 KiB
EmacsLisp
197 lines
7.4 KiB
EmacsLisp
;;; tp-doctest.el --- Executable TP 1.0 examples -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2024-2026 Geekinney
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; Executable counterparts of the public examples in README.md and
|
|
;; README_CN.md. Run with `make doctest'.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'tp)
|
|
|
|
(defvar tp-doctest--failures 0
|
|
"Number of failed TP documentation examples.")
|
|
|
|
(defvar tp-doctest--total 0
|
|
"Number of executed TP documentation examples.")
|
|
|
|
(defvar tp-doctest--computed-calls 0
|
|
"Number of explicit computed-value calls in the doctest.")
|
|
|
|
(defvar tp-doctest--height 7
|
|
"Height returned by the doctest's explicit computed value.")
|
|
|
|
(defmacro tp-doctest--check (label expected &rest body)
|
|
"Run BODY and compare its value with EXPECTED under LABEL."
|
|
(declare (indent 2) (debug t))
|
|
`(let* ((wanted ,expected)
|
|
(actual
|
|
(condition-case error-data
|
|
(progn ,@body)
|
|
(error (list :unexpected-error error-data)))))
|
|
(cl-incf tp-doctest--total)
|
|
(if (equal actual wanted)
|
|
(princ (format "PASS %s\n" ,label))
|
|
(cl-incf tp-doctest--failures)
|
|
(princ (format "FAIL %s\n expected: %S\n actual: %S\n"
|
|
,label wanted actual)))))
|
|
|
|
(unwind-protect
|
|
(progn
|
|
(tp-doctest--check "static-propertize"
|
|
'("Hello" (:foreground "white" :background "navy") t nil)
|
|
(let* ((callback (lambda (_window _object _position) "Open"))
|
|
(text
|
|
(tp-propertize
|
|
"Hello"
|
|
(list 'face '(:foreground "white" :background "navy")
|
|
'help-echo callback 'keymap nil))))
|
|
(list (substring-no-properties text)
|
|
(get-text-property 0 'face text)
|
|
(eq (get-text-property 0 'help-echo text) callback)
|
|
(get-text-property 0 'keymap text))))
|
|
|
|
(tp-doctest--check "buffer-apply"
|
|
'("abcdef" nil italic nil host)
|
|
(with-temp-buffer
|
|
(insert "abcdef")
|
|
(put-text-property 1 7 'category 'host)
|
|
(tp-apply (current-buffer) 2 5 '(face italic))
|
|
(list (buffer-string)
|
|
(get-text-property 1 'face)
|
|
(get-text-property 2 'face)
|
|
(get-text-property 5 'face)
|
|
(get-text-property 3 'category))))
|
|
|
|
(tp-doctest--check "declaration-recipe"
|
|
'((:foreground "cyan" :weight bold) "Open item" nil)
|
|
(define-tp tp-doctest-link (foreground)
|
|
`(face (:foreground ,foreground :weight bold)
|
|
help-echo "Open item"
|
|
keymap nil))
|
|
(let ((text (tp-set "item" '(tp-doctest-link "cyan"))))
|
|
(list (get-text-property 0 'face text)
|
|
(get-text-property 0 'help-echo text)
|
|
(get-text-property 0 'keymap text))))
|
|
|
|
(tp-doctest--check "explicit-computed-value"
|
|
'(1 (:height 7))
|
|
(setq tp-doctest--computed-calls 0)
|
|
(define-tp tp-doctest-sized ()
|
|
`(face ,(tp-computed
|
|
(lambda ()
|
|
(cl-incf tp-doctest--computed-calls)
|
|
(list :height tp-doctest--height)))))
|
|
(let ((text (tp-set "size" 'tp-doctest-sized)))
|
|
(list tp-doctest--computed-calls
|
|
(get-text-property 0 'face text))))
|
|
|
|
(tp-doctest--check "reactive-existing-text"
|
|
'((:foreground "red") (:foreground "green") 2 nil)
|
|
(with-temp-buffer
|
|
(insert "offline")
|
|
(let* ((online (tp-signal-create nil))
|
|
(surface
|
|
(tp-watch
|
|
(current-buffer) 1 8
|
|
(lambda ()
|
|
(list 'face
|
|
(list :foreground
|
|
(if (tp-signal-read online)
|
|
"green"
|
|
"red"))))))
|
|
(before (get-text-property 1 'face)))
|
|
(tp-signal-set online t)
|
|
(prog1
|
|
(list before
|
|
(get-text-property 1 'face)
|
|
(tp-surface-revision surface)
|
|
(plist-get (tp-surface-unmount surface)
|
|
:property-conflicts))
|
|
(tp-signal-dispose online)))))
|
|
|
|
(tp-doctest--check "retained-content"
|
|
'("ready" "done" 2 1)
|
|
(with-temp-buffer
|
|
(let* ((status (tp-signal-create "ready"))
|
|
(producer
|
|
(lambda (context)
|
|
(let* ((object
|
|
(tp-object-ensure context nil 'status 'text))
|
|
(binding
|
|
(tp-bind object '(readme . status)
|
|
(lambda () (tp-signal-read status)))))
|
|
(tp-surface-plan-create
|
|
:key 'status :kind 'text
|
|
:text (tp-binding-read binding)
|
|
:props '(face bold) :capability 'content))))
|
|
(surface
|
|
(tp-surface-mount
|
|
(current-buffer) producer '(:capability content)))
|
|
(first (buffer-string)))
|
|
(tp-with-transaction
|
|
(tp-signal-set status "working")
|
|
(tp-signal-set status "done"))
|
|
(prog1
|
|
(list first (buffer-string)
|
|
(tp-surface-revision surface)
|
|
(plist-get (tp-surface-report surface)
|
|
:text-operations))
|
|
(tp-surface-unmount surface)
|
|
(tp-signal-dispose status)))))
|
|
|
|
(tp-doctest--check "retained-noop"
|
|
'(1 1 nil)
|
|
(with-temp-buffer
|
|
(let* ((plan
|
|
(tp-surface-plan-create
|
|
:key 'root :kind 'text :text "same"
|
|
:capability 'content))
|
|
(surface
|
|
(tp-surface-mount
|
|
(current-buffer) plan '(:capability content)))
|
|
(revision (tp-surface-revision surface)))
|
|
(set-buffer-modified-p nil)
|
|
(tp-surface-update surface plan)
|
|
(prog1
|
|
(list revision
|
|
(tp-surface-revision surface)
|
|
(buffer-modified-p))
|
|
(tp-surface-unmount surface)))))
|
|
|
|
(tp-doctest--check "materialize-is-ephemeral"
|
|
'("42" nil nil 0)
|
|
(let ((signal (tp-signal-create 42)) object binding)
|
|
(let ((text
|
|
(tp-surface-materialize-string
|
|
(lambda (context)
|
|
(setq object
|
|
(tp-object-ensure context nil 'value 'text)
|
|
binding
|
|
(tp-bind object '(readme . value)
|
|
(lambda () (tp-signal-read signal))))
|
|
(tp-surface-plan-create
|
|
:key 'value :kind 'text
|
|
:text (number-to-string (tp-binding-read binding))
|
|
:capability 'content)))))
|
|
(prog1
|
|
(list text
|
|
(tp-object-live-p object)
|
|
(tp-binding-live-p binding)
|
|
(tp-signal-subscriber-count signal))
|
|
(tp-signal-dispose signal))))))
|
|
(tp-layer-reset)
|
|
(tp-reactive-reset))
|
|
|
|
(princ (format "\nTOTAL: %d FAILURES: %d\n"
|
|
tp-doctest--total tp-doctest--failures))
|
|
(when (> tp-doctest--failures 0)
|
|
(kill-emacs 1))
|
|
|
|
(provide 'tp-doctest)
|
|
;;; tp-doctest.el ends here
|