geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

Phase 1: CI matrix, zero-warning compile, shuffled runner, autoloads

Browse Source 
Byte-compile warnings swept 57 -> 0 across all modules, tests, and
doctest (docstring rewraps and quoting, defvar declarations for the
reactive test variables, prefixed doctest counters, dead-binding
removal, one impossible eq -> equal in a face-merge assertion) with
behavior preserved. GitHub Actions workflow runs an Emacs 28.1/29.4/
30.1 matrix: compile-all with warnings-as-errors, the 443-test suite,
a genuinely shuffled-order rerun (tp-run-shuffled.el runs each test
individually; ERT's member selector cannot reorder), and the 63
README doctests. Makefile gains WERROR, compile-all, and
test-shuffled. Autoload cookies added for the four interactive
commands and the define-tp/define-tps macros. package-lint: 0
findings (main file tp.el); draft MELPA recipe in docs/.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Kinneyzhang 2026-07-26 23:46:52 +08:00
parent 2c5ce6c27b
commit 36328a1cca
11 changed files with 264 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
.github/workflows/ci.yml vendored Normal file
View File

@ -0,0 +1,44 @@
name: CI
on:
push:
branches: [main, 'dev/**']
pull_request:
branches: [main]
jobs:
test:
runs-on: ubuntu-latest
strategy:
fail-fast: false
matrix:
emacs_version: ['28.1', '29.4', '30.1']
steps:
- uses: actions/checkout@v4
- uses: purcell/setup-emacs@master
with:
version: ${{ matrix.emacs_version }}
- name: Install dash from GNU ELPA
run: |
emacs -Q --batch --eval "(progn \
(require 'package) \
(setq package-user-dir (expand-file-name \".elpa\")) \
(add-to-list 'package-archives '(\"gnu\" . \"https://elpa.gnu.org/packages/\")) \
(package-initialize) \
(package-refresh-contents) \
(package-install 'dash))"
echo "LOAD_EXTRA=-L $(ls -d "$PWD"/.elpa/dash-*)" >> "$GITHUB_ENV"
- name: Byte-compile (warnings are errors)
run: make compile-all WERROR=t LOAD_EXTRA="$LOAD_EXTRA"
- name: ERT suite
run: make test LOAD_EXTRA="$LOAD_EXTRA"
- name: ERT suite (shuffled order)
run: make test-shuffled LOAD_EXTRA="$LOAD_EXTRA"
- name: README doctests
run: make doctest LOAD_EXTRA="$LOAD_EXTRA"

22
Makefile
View File

@ -2,32 +2,48 @@
#
# Usage:
# make test # run all ERT test suites
# make test-shuffled # run the suite in a random order (SHUFFLE_SEED=n reproduces)
# make doctest # execute README examples against the code
# make compile # byte-compile all modules
# make compile # byte-compile the library modules
# make compile-all # byte-compile modules + tests + dev scripts
# make clean # remove compiled files
#
# WERROR=t turns byte-compile warnings into errors (used in CI).
# If dash.el is not on the default load-path, point LOAD_EXTRA at it:
# make test LOAD_EXTRA="-L ~/.emacs.d/elpa/dash-20240510.1327"
EMACS ?= emacs
LOAD_EXTRA ?=
WERROR ?= nil
LOADPATH = -L . $(LOAD_EXTRA)
SRC = tp-core.el tp-reactive.el tp-layer.el tp-ops.el tp-search.el \
tp-render.el tp-stack.el tp-palette.el tp-builtins.el tp.el
TESTS = $(wildcard *-tests.el)
DEV = tp-doctest.el tp-run-shuffled.el
.PHONY: test doctest compile clean
.PHONY: test test-shuffled doctest compile compile-all clean
test:
$(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \
-f ert-run-tests-batch-and-exit
test-shuffled:
$(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \
-l tp-run-shuffled.el
doctest:
$(EMACS) -Q --batch $(LOADPATH) -l tp-doctest.el
compile: clean
$(EMACS) -Q --batch $(LOADPATH) -f batch-byte-compile $(SRC)
$(EMACS) -Q --batch $(LOADPATH) \
--eval "(setq byte-compile-error-on-warn $(WERROR))" \
-f batch-byte-compile $(SRC)
compile-all: clean
$(EMACS) -Q --batch $(LOADPATH) \
--eval "(setq byte-compile-error-on-warn $(WERROR))" \
-f batch-byte-compile $(SRC) $(TESTS) $(DEV)
clean:
rm -f *.elc

16
docs/melpa-recipe.el Normal file
View File

@ -0,0 +1,16 @@
;;; melpa-recipe.el --- draft MELPA recipe for tp -*- lexical-binding: t -*-
;; Draft recipe for a future MELPA submission (not yet submitted).
;; The package ships the nine library modules plus the tp.el umbrella;
;; test suites, doctests, and dev scripts are excluded.
;;
;; Verified locally with: package-lint (0 findings, main file tp.el)
;; and a multi-Emacs CI matrix (28.1 / 29.4 / 30.1).
(tp :fetcher github
:repo "Kinneyzhang/tp"
:files ("tp.el" "tp-core.el" "tp-reactive.el" "tp-layer.el"
"tp-ops.el" "tp-search.el" "tp-render.el" "tp-stack.el"
"tp-palette.el" "tp-builtins.el"))
;;; melpa-recipe.el ends here

11
tp-core.el
View File

@ -68,7 +68,8 @@ If nil, debug messages are only logged to the *tp-debug* buffer."
;; Misc
yank-handler auto-composed evaporate face-alias)
"List of built-in Emacs text property names.
These property names are reserved and cannot be used as layer names in `define-tp'.
These property names are reserved and cannot be used as layer names
in `define-tp'.
An error is signaled at macro expansion time (when the `define-tp' form is
evaluated) if a reserved name is used, preventing the layer definition from
being created.")
@ -95,6 +96,7 @@ FORMAT-STRING and ARGS are passed to `format'."
(when tp-debug-echo
(message "[tp] %s" msg)))))
;;;###autoload
(defun tp-debug-clear ()
"Clear the *tp-debug* buffer."
(interactive)
@ -102,6 +104,7 @@ FORMAT-STRING and ARGS are passed to `format'."
(with-current-buffer buf
(erase-buffer))))
;;;###autoload
(defun tp-debug-show ()
"Show the *tp-debug* buffer."
(interactive)
@ -455,7 +458,8 @@ Example:
(tp--merge-duplicate-keys \\='(face bold face (:foreground \"red\")))
=> (face ((:foreground \"red\") bold))
(tp--merge-duplicate-keys \\='(face (:background \"blue\") face (:foreground \"red\")))
(tp--merge-duplicate-keys
\\='(face (:background \"blue\") face (:foreground \"red\")))
=> (face (:background \"blue\" :foreground \"red\"))
(tp--merge-duplicate-keys \\='(prop1 a prop2 b prop1 c))
@ -555,7 +559,8 @@ Returns a list of reactive symbols found."
(defun tp--extract-reactive-value (val reactive-var)
"Extract only the parts of VAL that use REACTIVE-VAR.
If VAL is a plist, recursively extract only the key-value pairs containing REACTIVE-VAR.
If VAL is a plist, recursively extract only the key-value pairs
containing REACTIVE-VAR.
If VAL directly contains REACTIVE-VAR, return VAL as-is.
REACTIVE-VAR should be the $-prefixed symbol (e.g., $my-color)."
(cond

19
tp-doctest.el
View File

@ -23,16 +23,17 @@
(require 'tp)
(tp-layer-reset)
(defvar fails 0)
(defvar total 0)
(defvar tp-doctest--fails 0)
(defvar tp-doctest--total 0)
(defmacro chk (label expected &rest body)
`(let* ((exp ,expected)
(got (condition-case err (progn ,@body) (error (list :ERROR err)))))
(setq total (1+ total))
(setq tp-doctest--total (1+ tp-doctest--total))
(if (equal got exp)
(princ (format "PASS %s\n" ,label))
(setq fails (1+ fails))
(princ (format "FAIL %s\n expected: %S\n got: %S\n" ,label exp got)))))
(setq tp-doctest--fails (1+ tp-doctest--fails))
(princ (format "FAIL %s\n expected: %S\n got: %S\n"
,label exp got)))))
(defmacro chk-str (label expected &rest body)
"Compare prin1 form (covers propertized strings)."
`(chk ,label ,expected (prin1-to-string (progn ,@body))))
@ -195,6 +196,7 @@
(list (substring-no-properties my-string) (nreverse positions))))
;; ---- Layer definitions ----
(defvar my-color)
(chk "L-format3" '((:foreground "blue") "status: active")
(progn
(tp-layer-reset)
@ -456,6 +458,8 @@
'("error" :props (face (:foreground $error-color))
:data ((error-color . "red"))))
(tp-layer-props 'status-indicators-success)))
(defvar fg-color)
(defvar bg-color)
(chk "RC-batch" '(:foreground "red" :background "blue")
(progn
(tp-layer-reset)
@ -484,6 +488,7 @@
(list before (tp-at 1 'face))))))
;; ---- Theme example (as in the docs) ----
(declare-function switch-to-light-theme "tp-doctest")
(defvar theme-fg "white")
(defvar theme-bg "black")
(defvar theme-accent "cyan")
@ -548,7 +553,7 @@
(list (tp-forward-do #'upcase 'marker nil str 3)
(substring-no-properties str))))
(princ (format "\nTOTAL: %d FAILS: %d\n" total fails))
(when (> fails 0) (kill-emacs 1))
(princ (format "\nTOTAL: %d FAILS: %d\n" tp-doctest--total tp-doctest--fails))
(when (> tp-doctest--fails 0) (kill-emacs 1))
;;; tp-doctest.el ends here

86
tp-layer.el
View File

@ -86,7 +86,7 @@ The error message names the full cycle, e.g. \"a -> b -> a\"."
(defun tp--expand-layer-to-props-list (layer-name str start)
"Expand LAYER-NAME to a list of property keys it contributes.
If LAYER-NAME is a layer defined in `tp-layer-alist', returns a list
of the property keys that the layer adds, plus 'tp-name.
of the property keys that the layer adds, plus `tp-name'.
STR and START are used to get the argument value for parameterized layers.
For non-layer symbols, returns a list containing just that symbol."
(if (tp--is-layer-name-p layer-name)
@ -167,13 +167,13 @@ Returns the face value that the layer adds, or nil if no face contribution."
(defun tp--parse-define-layer-args (args)
"Parse ARGS for tp--define-layer-internal function.
Returns plist with keys :props, :data, :watch, :compute, :transform.
- Keyword arguments: :props PLIST [:data DATA] [:watch WATCH] [:compute COMPUTE] [:transform FN]"
(let (props data watch compute transform has-keywords)
- Keyword arguments: :props PLIST [:data DATA] [:watch WATCH]
[:compute COMPUTE] [:transform FN]"
(let (props data watch compute transform)
(cond
;; Check for keyword arguments format
((and (keywordp (car args))
(memq (car args) '(:props :data :watch :compute :transform)))
(setq has-keywords t)
;; Parse keyword arguments
(let ((rest args))
(while rest
@ -203,11 +203,14 @@ Format 1 - Direct plist (no :watch/:compute/:data/:transform support):
(tp--define-layer-internal \\='layer-name
\\='(display \"🌑\" face (:height 1.0)))
Format 2 - With :props, :data, :watch, :compute, and/or :transform (Vue 3 style reactivity):
Format 2 - With :props, :data, :watch, :compute, and/or :transform
\(Vue 3 style reactivity):
(tp--define-layer-internal \\='layer-name
;; props: $-prefixed symbols are reactive variables; auto-defined if not bound
;; props: $-prefixed symbols are reactive variables;
;; auto-defined if not bound
:props \\='(face (:foreground $my-color) help-echo $full-name)
;; data: additional reactive variables not used in props; auto-defined if not bound
;; data: additional reactive variables not used in props;
;; auto-defined if not bound
:data \\='((first-name . \"John\") (last-name . \"Doe\"))
;; compute: list of (VAR-NAME FUNCTION) - compute reactive variable values
:compute \\='((full-name (lambda () (concat first-name \" \" last-name))))
@ -234,7 +237,8 @@ Reactive Variables:
:transform - A function that receives the tp-text value and returns a
transformed string. Useful for formatting numbers, dates, or other values
before display. Example: (lambda (text) (format \"$%.2f\" (string-to-number text)))
before display.
Example: (lambda (text) (format \"$%.2f\" (string-to-number text)))
Note: When using :watch, :compute, or :data, you MUST use :props to specify
the text properties explicitly.
@ -306,6 +310,7 @@ The layer is stored in `tp-layer-alist'."
(tp--layer-refresh name)
(assoc name tp-layer-alist)))))
;;;###autoload
(defmacro define-tp (name arglist &rest body)
"Define a text property layer named NAME.
@ -319,7 +324,8 @@ Format 2 - Parameterized simple (single argument, simple body):
(define-tp tp-space (pixel)
\\=`(display (space :width (,pixel))))
Format 3 - Non-parameterized with reactive features (requires $-prefixed variables):
Format 3 - Non-parameterized with reactive features
\(requires $-prefixed variables):
(define-tp my-layer ()
:props \\='(face (:foreground $my-color))
:data \\='((my-color . \"red\"))
@ -339,7 +345,8 @@ ARGLIST must be either:
BODY is either:
- A single property list expression (simple format)
- Keyword arguments starting with :props, :data, :compute, :watch, or :transform
(reactive format - only for non-parameterized layers with $-prefixed variables)
(reactive format - only for non-parameterized layers with $-prefixed
variables)
In simple format, exactly one body form is accepted; supplying more
than one signals an error at macro-expansion time instead of silently
@ -389,8 +396,10 @@ complete list of reserved names."
(defun tp--define-layer-unified (name arglist body)
"Define a layer NAME with ARGLIST and BODY using unified structure.
For non-parameterized layers, ARGLIST is nil and BODY is the evaluated plist.
For parameterized layers, ARGLIST contains one symbol and BODY is the unevaluated form.
Stores the layer in `tp-layer-alist' with format: (LAYER-NAME ARGLIST BODY-FORM).
For parameterized layers, ARGLIST contains one symbol and BODY is the
unevaluated form.
Stores the layer in `tp-layer-alist' with format:
\(LAYER-NAME ARGLIST BODY-FORM).
For non-parameterized layers, if BODY contains reactive symbols ($-prefixed),
delegates to `tp--define-layer-internal' for proper reactive handling."
@ -417,7 +426,8 @@ delegates to `tp--define-layer-internal' for proper reactive handling."
(defun tp--layer-group-element-format (element)
"Determine the format type of ELEMENT.
Returns 'symbol, 'format-1, 'format-2, 'format-3, 'format-4, or nil if invalid."
Returns `symbol', `format-1', `format-2', `format-3', `format-4', or
nil if invalid."
(cond
;; Symbol - reference to existing layer
((symbolp element) 'symbol)
@ -452,9 +462,11 @@ Returns 'symbol, 'format-1, 'format-2, 'format-3, 'format-4, or nil if invalid."
(t nil)))
(defun tp--parse-layer-group-element (group-name element idx)
"Parse a layer group element and return (layer-name . properties) or extended form.
"Parse a layer group element and return (layer-name . properties)
or extended form.
GROUP-NAME is the name of the layer group.
ELEMENT is the element to parse (can be anonymous plist, cons-cell, or :props form).
ELEMENT is the element to parse (can be anonymous plist, cons-cell,
or :props form).
IDX is the index for anonymous elements.
Returns a cons cell (LAYER-NAME . PROPERTIES) or a symbol if ELEMENT
@ -634,7 +646,8 @@ ELEMENTS is the list of layer definitions."
(defun tp--define-layer-group-unified (name arglist body-form)
"Define a parameterized layer group NAME with ARGLIST and BODY-FORM.
Stores the group in `tp-layer-groups' with format: (GROUP-NAME ARGLIST BODY-FORM).
Stores the group in `tp-layer-groups' with format:
\(GROUP-NAME ARGLIST BODY-FORM).
Layers generated by a previous non-parameterized definition of NAME
are undefined, since a parameterized group generates none."
(dolist (stale (cdr (assq name tp--group-generated-layers)))
@ -647,10 +660,12 @@ are undefined, since a parameterized group generates none."
(push (cons name entry) tp-layer-groups)))
(assoc name tp-layer-groups))
;;;###autoload
(defmacro define-tps (name arglist &rest body)
"Define a text property group named NAME.
This macro defines a group of text properties (layers) that can be used together.
This macro defines a group of text properties (layers) that can be
used together.
It follows the same format as `define-tp' for consistency.
ARGLIST must be either:
@ -686,7 +701,8 @@ Format 4 - Named layer with :props keyword (named as NAME-suffix):
Format 5 - Named layer with :props, :data, :watch, and/or :compute:
\\='(\"reactive\" :props (face (:foreground $my-color))
:data ((my-color . \"red\"))
:watch ((my-color (lambda (new old layer) (message \"Changed!\")))))
:watch ((my-color (lambda (new old layer)
(message \"Changed!\")))))
Note: NAME cannot be a built-in Emacs text property name like `face',
`display', `invisible', etc. See `tp--builtin-text-properties' for the
@ -715,8 +731,10 @@ complete list of reserved names."
(defun tp--set-layer-props (layer-name properties)
"Set PROPERTIES for layer LAYER-NAME in `tp-layer-alist'.
If the layer already exists, updates its properties; otherwise creates it.
Stores as (LAYER-NAME . PROPERTIES) for backward compatibility with reactive layers.
This is an internal function used by layer definition macros and reactive updates."
Stores as (LAYER-NAME . PROPERTIES) for backward compatibility with
reactive layers.
This is an internal function used by layer definition macros and
reactive updates."
(if (assoc layer-name tp-layer-alist)
(setf (cdr (assoc layer-name tp-layer-alist)) properties)
(push (cons layer-name properties) tp-layer-alist)))
@ -731,12 +749,15 @@ This is an internal function used by group definition macros."
(defun tp-layer-props (layer-name &optional include-tp-name)
"Return properties for layer LAYER-NAME from `tp-layer-alist'.
If INCLUDE-TP-NAME is non-nil, appends 'tp-name property to identify the layer.
Also includes tp-name automatically if the layer has reactive dependencies registered.
If INCLUDE-TP-NAME is non-nil, appends `tp-name' property to identify
the layer.
Also includes tp-name automatically if the layer has reactive
dependencies registered.
Handles two storage formats:
1. Old format (from tp--set-layer-props): (LAYER-NAME . PLIST) - flat plist
2. Unified format (from define-tp): (LAYER-NAME ARGLIST BODY-FORM)
For parameterized layers (ARGLIST non-nil), returns nil - use `tp-layer-props-with-arg'.
For parameterized layers (ARGLIST non-nil), returns nil - use
`tp-layer-props-with-arg'.
Recursively expands any nested layer names in the returned plist.
Signals an error naming the cycle if layer references are cyclic.
The returned plist is a fresh copy: mutating it does not affect the
@ -794,7 +815,8 @@ where ARGLIST is a non-nil list of argument symbols."
(defun tp-layer-props-with-arg (layer-name arg &optional include-tp-name)
"Return properties for parameterized layer LAYER-NAME with ARG.
Evaluates the body form with the argument bound to the parameter.
If INCLUDE-TP-NAME is non-nil, appends 'tp-name property to identify the layer.
If INCLUDE-TP-NAME is non-nil, appends `tp-name' property to identify
the layer.
Recursively expands any nested layer names in the returned plist.
$-prefixed reactive symbols in the body are resolved to the current
values of their variables at evaluation time; they do not create
@ -994,7 +1016,8 @@ Returns the expanded plist."
(defun tp--resolve-props (props)
"Resolve PROPS to a property list with layer metadata.
PROPS can be:
- A symbol (layer name from `tp-layer-alist' or group name from `tp-layer-groups')
- A symbol (layer name from `tp-layer-alist' or group name from
`tp-layer-groups')
- A two-element list (LAYER-NAME ARG) where LAYER-NAME is a defined layer
and ARG is either `t' for non-parameterized layers or the argument value
for parameterized layers
@ -1018,8 +1041,10 @@ If PROPS is a plist with layer names at any position:
If PROPS is a plist:
- If it contains reactive variables ($...), generates a UUID for `tp-name',
registers reactive dependencies, and returns the resolved props with `tp-name'.
If the plist already has a `tp-name', uses that instead of generating a new one.
registers reactive dependencies, and returns the resolved props
with `tp-name'.
If the plist already has a `tp-name', uses that instead of
generating a new one.
- If no reactive variables, returns props as-is (no tp-name added).
Returns nil if PROPS is a symbol but no matching layer/group is found.
@ -1157,13 +1182,15 @@ For group names, includes `tp-layers' property with the full layer stack."
(t nil)))
(defun tp--ensure-props (plist)
"Ensure PLIST is a property list, resolving layer names and handling reactive vars.
"Ensure PLIST is a property list, resolving layer names and
handling reactive vars.
If PLIST is a symbol, resolve it via `tp--resolve-props'.
If PLIST is a plist, also process it via `tp--resolve-props' to handle
anonymous reactive layers.
If resolution fails, return PLIST unchanged (for backward compatibility)."
(or (tp--resolve-props plist) plist))
;;;###autoload
(defun tp-layer-reset ()
"Reset all layer definitions.
Clears both `tp-layer-alist' and `tp-layer-groups'.
@ -1204,7 +1231,8 @@ untouched."
Used by layer stack functions that need tp-name for identification.
LAYER-SPEC can be:
- A symbol (non-parameterized layer name from define-tp or tp--define-layer-internal)
- A symbol (non-parameterized layer name from define-tp or
tp--define-layer-internal)
- A list (LAYER-NAME ARG) for parameterized layers from define-tp
- A plist for inline layer definition
- A list (NAME &rest PLIST) for named inline layer"

6
tp-ops.el
View File

@ -48,7 +48,8 @@ Supports multiple calling conventions:
3. String region: (START END PROPS STRING)
4. Entire string with plist: (STRING PROP VAL ...)
5. Entire string with layer: (STRING LAYER-NAME ARG)
6. Entire string with layer and extra props: (STRING LAYER-NAME ARG PROP VAL ...)"
6. Entire string with layer and extra props:
(STRING LAYER-NAME ARG PROP VAL ...)"
(let (object start finish props)
(cond
;; First arg is a string - apply to entire string
@ -219,7 +220,8 @@ Returns: For buffers, (START . END) cons. For strings, the result string."
(defun tp-reset (start-or-string &optional end-or-prop props-or-val &rest rest)
"Completely replace all text properties with PROPS.
Like `tp-set' but replaces ALL existing properties.
For tp-text, embedded text properties are preserved (props override if there's a conflict).
For tp-text, embedded text properties are preserved (props override
if there's a conflict).
**String Modification Behavior:**
- Entire string form (tp-reset STRING ...): Returns a NEW propertized string

16
tp-reactive.el
View File

@ -153,10 +153,10 @@ WHERE indicates where the variable was set:
- a buffer for `setq-local'
Updates all layers that depend on this variable.
Only 'set' operations trigger updates because:
- 'let'/'unlet': Temporary bindings that will be restored, no need to update UI
- 'makunbound': Variable is being undefined, not a value change
- 'defvaralias': Aliasing, the actual value change will trigger a separate 'set'
Only `set' operations trigger updates because:
- `let'/`unlet': Temporary bindings that will be restored, no need to update UI
- `makunbound': Variable is being undefined, not a value change
- `defvaralias': Aliasing, the actual value change will trigger a separate `set'
When `tp--batch-update-active' is non-nil, buffer updates are deferred until
the batch completes. Layer definitions are still updated immediately.
@ -335,9 +335,10 @@ Also adds variable watchers so changes to data vars trigger computed updates."
(defun tp--ensure-reactive-variables (var-symbols)
"Ensure all VAR-SYMBOLS are defined as global variables.
VAR-SYMBOLS can be a list of symbols or cons cells (SYMBOL . INITIAL-VALUE).
If a variable is not bound, define it with the initial value (nil if not specified).
If a variable has an explicit initial value (cons cell), always update it to allow
re-definition to change initial values."
If a variable is not bound, define it with the initial value (nil if
not specified).
If a variable has an explicit initial value (cons cell), always update
it to allow re-definition to change initial values."
(dolist (sym var-symbols)
(let* ((is-cons (and (consp sym) (not (tp--reactive-symbol-p sym))))
(var-sym (cond
@ -353,6 +354,7 @@ re-definition to change initial values."
(unless (boundp var-sym)
(set var-sym initial-val))))))
;;;###autoload
(defun tp-reactive-reset ()
"Reset all reactive text property watchers and dependencies."
(interactive)

3
tp-render.el
View File

@ -353,7 +353,8 @@ the reactive variable and the `tp-text' property - keeps the raw text.
If tp-text is a string different from current text, replace the text.
When PRESERVE-PROPS is non-nil, existing text properties are preserved
on the replaced text (used by tp-set and tp-add).
MERGE-MODE is retained for backward compatibility but no longer affects behavior.
MERGE-MODE is retained for backward compatibility but no longer
affects behavior.
All modes now preserve embedded text properties from tp-text, with props taking
precedence over embedded props when there's a conflict.
Returns (PROPS NEW-END NEW-OBJECT) where PROPS is the updated props,

63
tp-run-shuffled.el Normal file
View File

@ -0,0 +1,63 @@
;;; tp-run-shuffled.el --- run the ERT suite in a shuffled order -*- lexical-binding: t -*-
;; Copyright (C) 2024-2026 Geekinney
;; Author: Geekinney (kinneyzhang666@gmail.com)
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3 of
;; the License, or (at your option) any later version.
;;; Commentary:
;; Development script (not part of the installed package): runs every
;; loaded ERT test individually in a shuffled order to catch
;; inter-test state leaks that the fixed definition order hides.
;;
;; ERT's `member' selector does NOT control execution order (tests
;; always run in definition order), so this script loops over the
;; shuffled names and runs each test on its own.
;;
;; Usage (after loading tp and all *-tests.el files):
;; emacs -Q --batch -L . -l tp.el -l tp-tests.el ... -l tp-run-shuffled.el
;; or: make test-shuffled
;;
;; The shuffle seed is printed; reproduce a failing order with
;; SHUFFLE_SEED=<seed> make test-shuffled
;;; Code:
(require 'ert)
(require 'cl-lib)
(defun tp-run-shuffled--permute (list state)
"Return LIST deterministically permuted from integer seed STATE."
(let* ((v (vconcat list))
(n (length v)))
(dotimes (i (1- n))
;; Simple LCG so a printed seed reproduces the exact order.
(setq state (mod (+ (* state 1103515245) 12345) 2147483648))
(let* ((j (+ i (mod state (- n i))))
(tmp (aref v i)))
(aset v i (aref v j))
(aset v j tmp)))
(append v nil)))
(let* ((names (mapcar #'ert-test-name (ert-select-tests t t)))
(seed (let ((env (getenv "SHUFFLE_SEED")))
(if (and env (not (string-empty-p env)))
(string-to-number env)
(progn (random t) (abs (random 1000000))))))
(shuffled (tp-run-shuffled--permute names seed))
(unexpected 0))
(message "tp: running %d tests in shuffled order (SHUFFLE_SEED=%d)"
(length shuffled) seed)
(dolist (name shuffled)
(let ((stats (ert-run-tests-batch name)))
(cl-incf unexpected (ert-stats-completed-unexpected stats))))
(message "tp: shuffled run complete: %d tests, %d unexpected (seed %d)"
(length shuffled) unexpected seed)
(kill-emacs (if (zerop unexpected) 0 1)))
;;; tp-run-shuffled.el ends here

34
tp-tests.el
View File

@ -34,6 +34,32 @@ leak between tests regardless of how BODY exits."
,@body)
(tp-layer-reset)))
;; Reactive test variables set with `setq' inside tests. They must be
;; dynamically bound (variable watchers depend on it), so plain
;; `defvar' declarations are used.
(defvar tp-test-first-name nil "Test variable for computed properties.")
(defvar tp-test-last-name nil "Test variable for computed properties.")
(defvar tp-test-full-name nil "Test variable for computed properties.")
(defvar tp-test-dc-color nil "Test variable for data+compute layer.")
(defvar tp-test-dc-first nil "Test variable for data+compute layer.")
(defvar tp-test-dc-last nil "Test variable for data+compute layer.")
(defvar tp-test-dc-full-name nil "Test variable for data+compute layer.")
(defvar tp-test-init-color nil "Test variable for initial values.")
(defvar tp-test-init-name nil "Test variable for initial values.")
(defvar tp-test-init-other nil "Test variable for initial values.")
(defvar tp-test-global-color nil "Test variable for global updates.")
(defvar tp-test-redef-color nil "Test variable for layer re-definition.")
(defvar tp-test-watch-var nil "Test variable for watch callbacks.")
(defvar tp-test-compute-src nil "Test variable for compute source.")
(defvar tp-test-compute-out nil "Test variable for compute output.")
(defvar tp-test-group-color nil "Test variable for layer groups.")
(defvar tp-test-name-part1 nil "Test variable for tp-text updates.")
(defvar tp-test-name-part2 nil "Test variable for tp-text updates.")
(defvar tp-test-batch-color nil "Test variable for batch updates.")
(defvar tp-test-fg nil "Test variable for batch foreground.")
(defvar tp-test-bg nil "Test variable for batch background.")
(defvar tp-test-amount nil "Test variable for transform updates.")
;;; ============================================================
;;; Basic Text Property Functions Tests
;;; ============================================================
@ -863,7 +889,7 @@ nothing and returns the available count."
(tp-set 12 17 '(marker t) str)
(let ((result nil))
(tp--search-do
(lambda (match obj)
(lambda (match _obj)
(push (car match) result))
'marker nil str)
(should (= (length result) 2))
@ -878,7 +904,7 @@ nothing and returns the available count."
(tp-set 13 18 '(marker t))
(let ((result nil))
(tp--search-do
(lambda (match obj)
(lambda (match _obj)
(push (car match) result))
'marker nil nil 1 18)
(should (= (length result) 2))
@ -955,7 +981,7 @@ nothing and returns the available count."
(tp-set 5 8 '(marker t))
(tp-set 9 12 '(marker t))
(let ((positions nil))
(tp-search-map (lambda (txt start end idx)
(tp-search-map (lambda (_txt start end idx)
(push (list start end idx) positions)
(format "[%d]" idx))
'marker nil nil 1 12)
@ -3212,7 +3238,7 @@ text content but different properties, the properties should be updated."
;; Should contain both the plist and symbol
(should (member 'bold (if (listp face-val) face-val (list face-val))))
;; Should have foreground red
(should (or (eq face-val '(:foreground "red"))
(should (or (equal face-val '(:foreground "red"))
(and (listp face-val)
(cl-some (lambda (f)
(and (listp f)