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.
118 lines
4.5 KiB
EmacsLisp
118 lines
4.5 KiB
EmacsLisp
;;; diagnostic-decoration.el --- TP diagnostics decorations example -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2026 Geekinney
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; Demonstrates properties-only diagnostics with explicit ownership boundaries:
|
|
;; - create marker anchors directly with `tp-range-anchor-create`
|
|
;; - mount a properties surface with `tp-surface-mount`
|
|
;; - update it from a signal
|
|
;; - handle external host overrides and cleanup.
|
|
|
|
;;; Code:
|
|
|
|
(require 'tp)
|
|
|
|
(defun tp-example-diagnostic-decoration-mount (buffer)
|
|
"Mount a diagnostics decoration on BUFFER and return its control plist.
|
|
|
|
The decoration tracks a signal-controlled color on the word \"DIAG\"."
|
|
(let* ((target (get-buffer-create buffer))
|
|
(palette '((ok . "DarkGreen") (warn . "DarkOrange") (busy . "Purple")))
|
|
(mode-signal (tp-signal-create 'ok))
|
|
(range (cons 2 6))
|
|
(anchor nil)
|
|
(producer nil)
|
|
(surface nil))
|
|
(with-current-buffer target
|
|
(erase-buffer)
|
|
(insert "xDIAG")
|
|
(setq anchor
|
|
(tp-range-anchor-create target 2 6 :boundary-policy 'stale))
|
|
(setq producer
|
|
(lambda (context)
|
|
(let* ((root (tp-object-ensure context nil 'diag 'column))
|
|
(node (tp-object-ensure
|
|
context root 'diagnostic 'range))
|
|
(mode (tp-signal-read mode-signal))
|
|
(color (alist-get mode palette)))
|
|
(tp-object-attach-range context node anchor)
|
|
(tp-surface-plan-create
|
|
:key 'diag
|
|
:kind 'column
|
|
:capability 'properties
|
|
:children
|
|
(list
|
|
(tp-surface-plan-create
|
|
:key 'diagnostic
|
|
:kind 'range
|
|
:props (list 'help-echo
|
|
(format "mode=%s" mode)
|
|
'face `(:foreground ,color))
|
|
:capability 'properties))))))
|
|
(setq surface
|
|
(tp-surface-mount target producer '(:capability properties :inhibit-read-only t))))
|
|
(list :buffer target
|
|
:range range
|
|
:anchor anchor
|
|
:producer producer
|
|
:surface surface
|
|
:mode-signal mode-signal)))
|
|
|
|
(defun tp-example-diagnostic-decoration-object (state)
|
|
"Return the retained diagnostic object from STATE."
|
|
(tp-object-resolve (plist-get state :surface) '(diag diagnostic)))
|
|
|
|
(defun tp-example-diagnostic-decoration-range (state)
|
|
"Return STATE's active diagnostic range as `(START . END)`."
|
|
(let ((mount (car (tp-object-mounts (tp-example-diagnostic-decoration-object state)))))
|
|
(cons (plist-get mount :start) (plist-get mount :end))))
|
|
|
|
(defun tp-example-diagnostic-decoration-set-mode (state mode)
|
|
"Set diagnostics MODE in STATE and return the resulting report.
|
|
|
|
MODE should be one of `ok`, `warn`, or `busy`."
|
|
(tp-signal-set (plist-get state :mode-signal) mode)
|
|
(tp-surface-report (plist-get state :surface)))
|
|
|
|
(defun tp-example-diagnostic-decoration-repaint-range (state properties)
|
|
"Apply external PROPERTIES on the diagnostic range in STATE's buffer.
|
|
|
|
This simulates host edits that are outside TP ownership."
|
|
(let* ((buffer (plist-get state :buffer))
|
|
(range (tp-example-diagnostic-decoration-range state)))
|
|
(with-current-buffer buffer
|
|
(add-text-properties (car range) (cdr range) properties))))
|
|
|
|
(defun tp-example-diagnostic-decoration-insert-host-text (state position text)
|
|
"Insert TEXT at POSITION in STATE buffer."
|
|
(with-current-buffer (plist-get state :buffer)
|
|
(save-excursion
|
|
(goto-char position)
|
|
(insert text))))
|
|
|
|
(defun tp-example-diagnostic-decoration-delete-host-range (state start end)
|
|
"Delete host text in STATE buffer between START and END."
|
|
(with-current-buffer (plist-get state :buffer)
|
|
(delete-region start end)))
|
|
|
|
(defun tp-example-diagnostic-decoration-rebase (state)
|
|
"Rebase diagnostics anchors for STATE."
|
|
(tp-range-rebase (plist-get state :anchor)))
|
|
|
|
(defun tp-example-diagnostic-decoration-unmount (state)
|
|
"Unmount diagnostic decoration in STATE and dispose its signal."
|
|
(let* ((surface (plist-get state :surface))
|
|
(signal (plist-get state :mode-signal))
|
|
(report (when (tp-surface-live-p surface)
|
|
(tp-surface-unmount surface))))
|
|
(when (tp-signal-live-p signal)
|
|
(tp-signal-dispose signal))
|
|
report))
|
|
|
|
(provide 'diagnostic-decoration)
|
|
|
|
;;; diagnostic-decoration.el ends here
|