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.
195 lines
8.4 KiB
EmacsLisp
195 lines
8.4 KiB
EmacsLisp
;;; tp-query.el --- Native query and policy helpers for tp -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2024-2026 Geekinney
|
|
|
|
;; Author: Geekinney (kinneyzhang666@gmail.com)
|
|
|
|
;;; Commentary:
|
|
|
|
;; Explicit native text-property query boundaries and mutation policy.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'tp-core)
|
|
|
|
(cl-defstruct (tp-lookup-result
|
|
(:constructor tp--make-lookup-result
|
|
(&key property value present-p source mode
|
|
object position overlay)))
|
|
"Normalized text or character property lookup result.
|
|
PRESENT-P distinguishes an explicit nil value from absence. SOURCE
|
|
identifies the winning text source or `:overlay'; OVERLAY is non-nil
|
|
only when that overlay supplied the winning character-property value."
|
|
property value present-p source mode object position overlay)
|
|
|
|
(defun tp--lookup-direct (position property object mode)
|
|
"Return direct text lookup result for PROPERTY at POSITION in OBJECT.
|
|
|
|
POSITION, PROPERTY, and OBJECT identify the lookup target; MODE is
|
|
returned in the result."
|
|
(let* ((obj (or object (current-buffer)))
|
|
(cell (plist-member (text-properties-at position object) property)))
|
|
(tp--make-lookup-result
|
|
:property property :value (cadr cell) :present-p (and cell t)
|
|
:source (if cell :text-direct :absent) :mode mode
|
|
:object obj :position position)))
|
|
|
|
(defun tp--lookup-effective (position property object mode)
|
|
"Return effective text lookup result for PROPERTY at POSITION in OBJECT.
|
|
|
|
POSITION, PROPERTY, and OBJECT identify the lookup target; MODE is
|
|
returned in the result."
|
|
(let* ((value (get-text-property position property object))
|
|
(source-cell (tp--lookup-source-cell position property object))
|
|
(present-p (nth 2 source-cell)))
|
|
(tp--make-lookup-result
|
|
:property property :value value :present-p present-p
|
|
:source (if present-p (car source-cell) :absent) :mode mode
|
|
:object (or object (current-buffer)) :position position)))
|
|
|
|
(defun tp--lookup-char (position property object mode)
|
|
"Return overlay-aware lookup for PROPERTY at POSITION in OBJECT.
|
|
MODE is recorded in the returned `tp-lookup-result'."
|
|
(let* ((native (get-char-property-and-overlay position property object))
|
|
(overlay (cdr native))
|
|
(text-object (if (windowp object) (window-buffer object) object))
|
|
(text-source (tp--lookup-source-cell
|
|
position property text-object))
|
|
(present-p (or overlay (nth 2 text-source)))
|
|
(source (if overlay :overlay (car text-source))))
|
|
(tp--make-lookup-result
|
|
:property property :value (car native) :present-p (and present-p t)
|
|
:source source :mode mode :object (or object (current-buffer))
|
|
:position position :overlay overlay)))
|
|
|
|
(defun tp--lookup-alias-cell (position property object)
|
|
"Return the first non-nil alias value for PROPERTY at POSITION."
|
|
(catch 'found
|
|
(dolist (alias (cdr (assq property char-property-alias-alist)))
|
|
(when-let ((value (get-text-property position alias object)))
|
|
(throw 'found (list alias value))))))
|
|
|
|
(defun tp--lookup-source-cell (position property object)
|
|
"Return (SOURCE VALUE PRESENT-P) for PROPERTY at POSITION in OBJECT."
|
|
(let* ((props (text-properties-at position object))
|
|
(direct (plist-member props property))
|
|
(category (plist-get props 'category))
|
|
(cat-cell (and category (plist-member (symbol-plist category) property)))
|
|
(alias-cell (tp--lookup-alias-cell position property object))
|
|
(default-cell (plist-member default-text-properties property)))
|
|
(cond
|
|
(direct (list :text-direct (cadr direct) t))
|
|
(cat-cell (list :category (cadr cat-cell) t))
|
|
(alias-cell (list :alias (cadr alias-cell) t))
|
|
(default-cell (list :default (cadr default-cell) t))
|
|
(t (list :absent nil nil)))))
|
|
|
|
;;;###autoload
|
|
(cl-defun tp-lookup (position property &key object (mode :text-effective))
|
|
"Look up PROPERTY at POSITION in OBJECT according to MODE.
|
|
|
|
POSITION, PROPERTY, OBJECT, and MODE are lookup parameters.
|
|
|
|
MODE is one of `:text-direct', `:text-effective', `:text-source',
|
|
`:char', or `:char-source'. Text modes ignore overlays. Character
|
|
modes delegate overlay precedence to `get-char-property-and-overlay';
|
|
when an overlay supplies the winning value, the result records both
|
|
source `:overlay' and the winning overlay object.
|
|
|
|
Always return a `tp-lookup-result'. Its `present-p' field separates
|
|
absence from a direct property whose value is nil."
|
|
(pcase mode
|
|
(:text-direct (tp--lookup-direct position property object mode))
|
|
(:text-effective (tp--lookup-effective position property object mode))
|
|
(:text-source
|
|
(pcase-let ((`(,source ,value ,present-p)
|
|
(tp--lookup-source-cell position property object)))
|
|
(tp--make-lookup-result
|
|
:property property :value value :present-p present-p
|
|
:source source :mode mode :object (or object (current-buffer))
|
|
:position position)))
|
|
((or :char :char-source)
|
|
(tp--lookup-char position property object mode))
|
|
(_ (error "TP-LOOKUP: unknown mode %S" mode))))
|
|
|
|
;;;###autoload
|
|
(cl-defun tp-property-change
|
|
(position &key property object limit (direction :next))
|
|
"Return a native property change position from POSITION.
|
|
With PROPERTY, delegate to the single-property change primitives;
|
|
with nil PROPERTY, observe changes to any property. DIRECTION is
|
|
`:next' or `:previous'. OBJECT and LIMIT retain their native Emacs
|
|
meanings. Return the changed position or nil."
|
|
(pcase direction
|
|
(:next
|
|
(if property
|
|
(next-single-property-change position property object limit)
|
|
(next-property-change position object limit)))
|
|
(:previous
|
|
(if property
|
|
(previous-single-property-change position property object limit)
|
|
(previous-property-change position object limit)))
|
|
(_ (error "TP-PROPERTY-CHANGE: unknown direction %S" direction))))
|
|
|
|
;;;###autoload
|
|
(defun tp-property-any (start end property value &optional object)
|
|
"Return first position in [START, END) where PROPERTY is VALUE.
|
|
|
|
START and END are search bounds.
|
|
PROPERTY and VALUE are matched directly.
|
|
OBJECT is a string, a buffer, or nil for the current buffer."
|
|
(text-property-any start end property value object))
|
|
|
|
;;;###autoload
|
|
(defun tp-property-not-all (start end property value &optional object)
|
|
"Return first position in [START, END) where PROPERTY is not VALUE.
|
|
|
|
START and END are search bounds.
|
|
PROPERTY and VALUE are matched directly.
|
|
OBJECT is a string, a buffer, or nil for the current buffer."
|
|
(text-property-not-all start end property value object))
|
|
|
|
(defun tp--mutation-policy-modes (policy)
|
|
"Return normalized (MODIFIED READ-ONLY) modes for POLICY.
|
|
|
|
POLICY is a property list with keys `:modified' and `:read-only'."
|
|
(unless (and (proper-list-p policy) (cl-evenp (length policy)))
|
|
(error "TP-WITH-MUTATION-POLICY: POLICY must be a plist"))
|
|
(cl-loop for (key _value) on policy by #'cddr
|
|
unless (memq key '(:modified :read-only))
|
|
do (error "TP-WITH-MUTATION-POLICY: unknown key %S" key))
|
|
(let ((modified (if (plist-member policy :modified)
|
|
(plist-get policy :modified)
|
|
:ordinary))
|
|
(read-only (if (plist-member policy :read-only)
|
|
(plist-get policy :read-only)
|
|
:respect)))
|
|
(unless (memq modified '(:ordinary :silent))
|
|
(error "TP-WITH-MUTATION-POLICY: unknown :modified %S" modified))
|
|
(unless (memq read-only '(:respect :inhibit))
|
|
(error "TP-WITH-MUTATION-POLICY: unknown :read-only %S" read-only))
|
|
(when (and (eq modified :silent) (eq read-only :respect))
|
|
(error "TP-WITH-MUTATION-POLICY: :silent requires :read-only :inhibit"))
|
|
(list modified read-only)))
|
|
|
|
;;;###autoload
|
|
(defmacro tp-with-mutation-policy (policy &rest body)
|
|
"Run BODY with explicit mutation POLICY.
|
|
POLICY accepts `:modified' (`:ordinary' or `:silent') and
|
|
`:read-only' (`:respect' or `:inhibit'). The supported combinations
|
|
are ordinary/respect, ordinary/inhibit, and silent/inhibit.
|
|
Silent/respect is rejected because native `with-silent-modifications'
|
|
itself inhibits read-only text."
|
|
(declare (indent 1) (debug (form body)))
|
|
`(pcase (tp--mutation-policy-modes ,policy)
|
|
('(:ordinary :respect) ,@body)
|
|
('(:ordinary :inhibit)
|
|
(let ((inhibit-read-only t)) ,@body))
|
|
('(:silent :inhibit)
|
|
(let ((inhibit-read-only t))
|
|
(with-silent-modifications ,@body)))))
|
|
|
|
(provide 'tp-query)
|
|
;;; tp-query.el ends here
|