;;; 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