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

refactor: redesign :compute to compute reactive variable values, add :data support

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-20 09:30:17 +00:00
parent 33f3ec3d7a
commit 36c0a60f3f
2 changed files with 319 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

215
tp-tests.el
View File

@ -2337,7 +2337,7 @@ Returns list of (START END VALUE) intervals."
(makunbound 'tp-test-regexp-color)))) (makunbound 'tp-test-regexp-color))))
;;; ============================================================ ;;; ============================================================
;;; :watch and :compute Tests (Vue 3 style reactivity) ;;; :watch, :data, and :compute Tests (Vue 3 style reactivity)
;;; ============================================================ ;;; ============================================================
(ert-deftest tp-test-define-layer-with-watch () (ert-deftest tp-test-define-layer-with-watch ()
@ -2374,59 +2374,86 @@ Returns list of (START END VALUE) intervals."
(makunbound 'tp-test-watch-var) (makunbound 'tp-test-watch-var)
(makunbound 'tp-test-watch-log)))) (makunbound 'tp-test-watch-log))))
(ert-deftest tp-test-define-layer-with-compute () (ert-deftest tp-test-define-layer-with-data ()
"Test tp-define-layer with :compute for derived properties." "Test tp-define-layer with :data for additional reactive variables."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-compute-size nil "Test variable for compute.")
(setq tp-test-compute-size 10)
(unwind-protect (unwind-protect
(progn (progn
(tp-define-layer test-data-layer
:props (face (:foreground $tp-test-data-color))
:data (tp-test-data-extra))
;; Check that variables were auto-defined
(should (boundp 'tp-test-data-color))
(should (boundp 'tp-test-data-extra))
;; Check data is registered
(should (assoc 'test-data-layer tp-layer-data))
;; Check the layer is defined
(should (assoc 'test-data-layer tp-layer-alist)))
;; Cleanup
(makunbound 'tp-test-data-color)
(makunbound 'tp-test-data-extra))))
(ert-deftest tp-test-define-layer-with-compute ()
"Test tp-define-layer with :compute for computed reactive variables."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; Set up the source variables
(setq tp-test-first-name "John")
(setq tp-test-last-name "Doe")
(tp-define-layer test-compute-layer (tp-define-layer test-compute-layer
:props (face (:foreground $tp-test-compute-size)) :props (help-echo $tp-test-full-name)
:compute (help-echo (lambda () (format "Size: %d" tp-test-compute-size)))) :data (tp-test-first-name tp-test-last-name)
:compute ((tp-test-full-name
(lambda ()
(concat tp-test-first-name " " tp-test-last-name)))))
;; Check the layer is defined ;; Check the layer is defined
(should (assoc 'test-compute-layer tp-layer-alist)) (should (assoc 'test-compute-layer tp-layer-alist))
;; Check the computed is registered ;; Check the computed is registered
(should (assoc 'test-compute-layer tp-layer-computed)) (should (assoc 'test-compute-layer tp-layer-computed))
;; Check initial computed value ;; Check the computed variable has initial value
(should (equal tp-test-full-name "John Doe"))
;; Check the layer property uses the computed value
(let ((props (cdr (assoc 'test-compute-layer tp-layer-alist)))) (let ((props (cdr (assoc 'test-compute-layer tp-layer-alist))))
(should (equal (plist-get props 'help-echo) "Size: 10")))) (should (equal (plist-get props 'help-echo) "John Doe"))))
;; Cleanup ;; Cleanup
(makunbound 'tp-test-compute-size)))) (makunbound 'tp-test-first-name)
(makunbound 'tp-test-last-name)
(makunbound 'tp-test-full-name))))
(ert-deftest tp-test-define-layer-with-watch-and-compute () (ert-deftest tp-test-define-layer-with-data-and-compute ()
"Test tp-define-layer with both :watch and :compute." "Test tp-define-layer with :data and :compute together."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-wc-color nil "Test variable for watch and compute.")
(defvar tp-test-wc-log nil "Log of watch callback invocations.")
(setq tp-test-wc-color "blue")
(setq tp-test-wc-log nil)
(unwind-protect (unwind-protect
(progn (progn
(tp-define-layer test-wc-layer (tp-define-layer test-dc-layer
:props (face (:foreground $tp-test-wc-color)) :props (face (:foreground $tp-test-dc-color) help-echo $tp-test-dc-full-name)
:watch ((tp-test-wc-color :data (tp-test-dc-first tp-test-dc-last)
(lambda (new old layer) :compute ((tp-test-dc-full-name
(push (list new old) tp-test-wc-log)))) (lambda ()
:compute (help-echo (lambda () (concat "Color: " tp-test-wc-color)))) (concat tp-test-dc-first " " tp-test-dc-last)))))
;; Check layer is defined ;; Set data values
(should (assoc 'test-wc-layer tp-layer-alist)) (setq tp-test-dc-color "blue")
;; Check both watcher and computed are registered (setq tp-test-dc-first "Jane")
(should (assoc 'test-wc-layer tp-layer-watchers)) (setq tp-test-dc-last "Smith")
(should (assoc 'test-wc-layer tp-layer-computed)) ;; Re-eval to trigger the compute
;; Check initial computed value (tp-define-layer test-dc-layer
(let ((props (cdr (assoc 'test-wc-layer tp-layer-alist)))) :props (face (:foreground $tp-test-dc-color) help-echo $tp-test-dc-full-name)
(should (equal (plist-get props 'help-echo) "Color: blue"))) :data (tp-test-dc-first tp-test-dc-last)
;; Change the variable :compute ((tp-test-dc-full-name
(setq tp-test-wc-color "green") (lambda ()
;; Check the watcher was called (concat tp-test-dc-first " " tp-test-dc-last)))))
(should (= (length tp-test-wc-log) 1)) ;; Check data is registered
(let ((log-entry (car tp-test-wc-log))) (should (assoc 'test-dc-layer tp-layer-data))
(should (equal (nth 0 log-entry) "green")) ;; Check computed is registered
(should (equal (nth 1 log-entry) "blue")))) (should (assoc 'test-dc-layer tp-layer-computed))
;; Check the computed value
(should (equal tp-test-dc-full-name "Jane Smith")))
;; Cleanup ;; Cleanup
(makunbound 'tp-test-wc-color) (makunbound 'tp-test-dc-color)
(makunbound 'tp-test-wc-log)))) (makunbound 'tp-test-dc-first)
(makunbound 'tp-test-dc-last)
(makunbound 'tp-test-dc-full-name))))
(ert-deftest tp-test-define-layer-watch-requires-props () (ert-deftest tp-test-define-layer-watch-requires-props ()
"Test that :watch requires :props to be explicitly specified." "Test that :watch requires :props to be explicitly specified."
@ -2442,29 +2469,43 @@ Returns list of (START END VALUE) intervals."
(should-error (should-error
(macroexpand-1 (macroexpand-1
'(tp-define-layer test-invalid '(tp-define-layer test-invalid
:compute (help-echo (lambda () "computed"))))))) :compute ((some-var (lambda () "computed"))))))))
(ert-deftest tp-test-undefine-layer-clears-watch-and-compute () (ert-deftest tp-test-define-layer-data-requires-props ()
"Test tp-undefine-layer clears watchers and computed properties." "Test that :data requires :props to be explicitly specified."
(tp-test-with-temp-buffer
(should-error
(macroexpand-1
'(tp-define-layer test-invalid
:data (some-var))))))
(ert-deftest tp-test-undefine-layer-clears-watch-compute-data ()
"Test tp-undefine-layer clears watchers, computed, and data."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-undef-wc-var nil "Test variable for undefine wc.")
(setq tp-test-undef-wc-var "test")
(unwind-protect (unwind-protect
(progn (progn
(tp-define-layer test-undef-wc (tp-define-layer test-undef-wcd
:props (face (:foreground $tp-test-undef-wc-var)) :props (face (:foreground $tp-test-undef-color) help-echo $tp-test-undef-full)
:watch ((tp-test-undef-wc-var (lambda (n o l) nil))) :data (tp-test-undef-first tp-test-undef-last)
:compute (help-echo (lambda () "computed"))) :watch ((tp-test-undef-color (lambda (n o l) nil)))
:compute ((tp-test-undef-full
(lambda ()
(concat tp-test-undef-first " " tp-test-undef-last)))))
;; Check registrations ;; Check registrations
(should (assoc 'test-undef-wc tp-layer-watchers)) (should (assoc 'test-undef-wcd tp-layer-watchers))
(should (assoc 'test-undef-wc tp-layer-computed)) (should (assoc 'test-undef-wcd tp-layer-computed))
(should (assoc 'test-undef-wcd tp-layer-data))
;; Undefine the layer ;; Undefine the layer
(tp-undefine-layer 'test-undef-wc) (tp-undefine-layer 'test-undef-wcd)
;; Check watchers and computed are cleaned up ;; Check all are cleaned up
(should-not (assoc 'test-undef-wc tp-layer-watchers)) (should-not (assoc 'test-undef-wcd tp-layer-watchers))
(should-not (assoc 'test-undef-wc tp-layer-computed))) (should-not (assoc 'test-undef-wcd tp-layer-computed))
(should-not (assoc 'test-undef-wcd tp-layer-data)))
;; Cleanup ;; Cleanup
(makunbound 'tp-test-undef-wc-var)))) (makunbound 'tp-test-undef-color)
(makunbound 'tp-test-undef-first)
(makunbound 'tp-test-undef-last)
(makunbound 'tp-test-undef-full))))
(ert-deftest tp-test-define-layer-group-with-watch () (ert-deftest tp-test-define-layer-group-with-watch ()
"Test tp-define-layer-group with :watch (format-4)." "Test tp-define-layer-group with :watch (format-4)."
@ -2498,45 +2539,75 @@ Returns list of (START END VALUE) intervals."
(ert-deftest tp-test-define-layer-group-with-compute () (ert-deftest tp-test-define-layer-group-with-compute ()
"Test tp-define-layer-group with :compute (format-4)." "Test tp-define-layer-group with :compute (format-4)."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-group-compute-var nil "Test variable for group compute.")
(setq tp-test-group-compute-var 42)
(unwind-protect (unwind-protect
(progn (progn
(setq tp-test-group-first "Group")
(setq tp-test-group-last "Test")
(tp-define-layer-group test-compute-group (tp-define-layer-group test-compute-group
;; Using $tp-test-group-compute-var to trigger reactive path ("computed" :props (help-echo $tp-test-group-full)
("computed" :props (face (:foreground $tp-test-group-compute-var)) :data (tp-test-group-first tp-test-group-last)
:compute (help-echo (lambda () (format "Value: %s" tp-test-group-compute-var)))) :compute ((tp-test-group-full
(lambda ()
(concat tp-test-group-first " " tp-test-group-last)))))
("static" :props (face (:foreground "blue")))) ("static" :props (face (:foreground "blue"))))
;; Check the group is defined ;; Check the group is defined
(should (assoc 'test-compute-group tp-layer-groups)) (should (assoc 'test-compute-group tp-layer-groups))
;; Check the computed layer has its compute registered ;; Check the computed layer has its compute registered
(should (assoc 'test-compute-group-computed tp-layer-computed)) (should (assoc 'test-compute-group-computed tp-layer-computed))
;; Static layer should not have computed ;; Static layer should not have computed
(should-not (assoc 'test-compute-group-static tp-layer-computed))) (should-not (assoc 'test-compute-group-static tp-layer-computed))
;; Check computed value
(should (equal tp-test-group-full "Group Test")))
;; Cleanup ;; Cleanup
(makunbound 'tp-test-group-compute-var)))) (makunbound 'tp-test-group-first)
(makunbound 'tp-test-group-last)
(makunbound 'tp-test-group-full))))
(ert-deftest tp-test-reactive-reset-clears-watch-and-compute () (ert-deftest tp-test-reactive-reset-clears-all ()
"Test tp-reactive-reset clears watchers and computed properties." "Test tp-reactive-reset clears watchers, computed, and data."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-reset-wc-var nil "Test variable for reset wc.")
(setq tp-test-reset-wc-var "test")
(unwind-protect (unwind-protect
(progn (progn
(tp-define-layer test-reset-wc (tp-define-layer test-reset-all
:props (face (:foreground $tp-test-reset-wc-var)) :props (face (:foreground $tp-test-reset-color) help-echo $tp-test-reset-full)
:watch ((tp-test-reset-wc-var (lambda (n o l) nil))) :data (tp-test-reset-first tp-test-reset-last)
:compute (help-echo (lambda () "computed"))) :watch ((tp-test-reset-color (lambda (n o l) nil)))
:compute ((tp-test-reset-full
(lambda ()
(concat tp-test-reset-first " " tp-test-reset-last)))))
;; Check registrations ;; Check registrations
(should tp-layer-watchers) (should tp-layer-watchers)
(should tp-layer-computed) (should tp-layer-computed)
(should tp-layer-data)
;; Reset reactive ;; Reset reactive
(tp-reactive-reset) (tp-reactive-reset)
;; Check all are cleared ;; Check all are cleared
(should-not tp-layer-watchers) (should-not tp-layer-watchers)
(should-not tp-layer-computed)) (should-not tp-layer-computed)
(should-not tp-layer-data))
;; Cleanup - variables may or may not be bound
(ignore-errors (makunbound 'tp-test-reset-color))
(ignore-errors (makunbound 'tp-test-reset-first))
(ignore-errors (makunbound 'tp-test-reset-last))
(ignore-errors (makunbound 'tp-test-reset-full)))))
(ert-deftest tp-test-auto-define-variables ()
"Test that reactive variables are auto-defined when not bound."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; Variables should not exist before
(should-not (boundp 'tp-test-auto-var1))
(should-not (boundp 'tp-test-auto-var2))
(tp-define-layer test-auto-layer
:props (face (:foreground $tp-test-auto-var1))
:data (tp-test-auto-var2))
;; Variables should now exist
(should (boundp 'tp-test-auto-var1))
(should (boundp 'tp-test-auto-var2)))
;; Cleanup ;; Cleanup
(makunbound 'tp-test-reset-wc-var)))) (makunbound 'tp-test-auto-var1)
(makunbound 'tp-test-auto-var2))))
(provide 'tp-ert-tests) (provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here ;;; tp-ert-tests.el ends here

268
tp.el
View File

@ -65,10 +65,15 @@ is a list of (VAR-SYMBOL . CALLBACK) pairs.
CALLBACK receives (NEW-VAL OLD-VAL LAYER-NAME) when VAR-SYMBOL changes.") CALLBACK receives (NEW-VAL OLD-VAL LAYER-NAME) when VAR-SYMBOL changes.")
(defvar tp-layer-computed nil (defvar tp-layer-computed nil
"Alist mapping layer names to their computed property definitions. "Alist mapping layer names to their computed variable definitions.
Each element is (LAYER-NAME . COMPUTED-PLIST) where COMPUTED-PLIST Each element is (LAYER-NAME . COMPUTED-LIST) where COMPUTED-LIST
is a plist of (PROP-KEY . COMPUTE-FN) pairs. is a list of (VAR-SYMBOL . COMPUTE-FN) pairs.
COMPUTE-FN is evaluated to get the current value of the property.") COMPUTE-FN is evaluated to get the current value of the reactive variable.")
(defvar tp-layer-data nil
"Alist mapping layer names to their data variable definitions.
Each element is (LAYER-NAME . VAR-LIST) where VAR-LIST is a list
of variable symbols defined via :data.")
(defvar tp--anonymous-layer-counter 0 (defvar tp--anonymous-layer-counter 0
"Counter for generating unique anonymous layer names.") "Counter for generating unique anonymous layer names.")
@ -196,9 +201,10 @@ Only the reactive portions of the properties are stored for each variable."
;; Clean up empty dependency entries ;; Clean up empty dependency entries
(setq tp-reactive-deps (setq tp-reactive-deps
(cl-remove-if (lambda (dep) (null (cdr dep))) tp-reactive-deps)) (cl-remove-if (lambda (dep) (null (cdr dep))) tp-reactive-deps))
;; Also clean up layer watchers and computed properties ;; Also clean up layer watchers, computed properties, and data
(tp--unregister-layer-watchers layer-name) (tp--unregister-layer-watchers layer-name)
(tp--unregister-layer-computed layer-name)) (tp--unregister-layer-computed layer-name)
(tp--unregister-layer-data layer-name))
(defun tp--reactive-variable-watcher (symbol newval operation _where) (defun tp--reactive-variable-watcher (symbol newval operation _where)
"Watcher function called when a reactive variable changes. "Watcher function called when a reactive variable changes.
@ -254,24 +260,26 @@ NEWVAL is the new value, OLDVAL is the old value."
layer-name watch-sym err)))))))) layer-name watch-sym err))))))))
(defun tp--update-layer-computed (layer-name override-alist) (defun tp--update-layer-computed (layer-name override-alist)
"Update computed properties for LAYER-NAME with OVERRIDE-ALIST. "Update computed reactive variables for LAYER-NAME with OVERRIDE-ALIST.
Evaluates compute functions and updates the layer properties." Evaluates compute functions and updates the reactive variable values.
Returns an updated override-alist with the new computed values."
(when-let ((computed (cdr (assoc layer-name tp-layer-computed)))) (when-let ((computed (cdr (assoc layer-name tp-layer-computed))))
(let ((current-props (cdr (assoc layer-name tp-layer-alist)))) (dolist (comp computed)
(when current-props (let* ((var-sym (car comp))
(cl-loop for (prop-key compute-fn) on computed by #'cddr (compute-fn (cdr comp))
do (let ((computed-val (computed-val
(condition-case err (condition-case err
;; Resolve reactive symbols in compute function result (funcall compute-fn)
(tp--resolve-reactive-symbols
(funcall compute-fn) override-alist)
(error (error
(message "tp: compute error for %s.%s: %s" (message "tp: compute error for %s.%s: %s"
layer-name prop-key err) layer-name var-sym err)
nil)))) nil))))
(when computed-val (when computed-val
(setq current-props (plist-put current-props prop-key computed-val))))) ;; Update the global variable
(tp--set-layer-props layer-name current-props))))) (set var-sym computed-val)
;; Add to override-alist for property resolution
(push (cons var-sym computed-val) override-alist)))))
override-alist)
(defun tp--register-layer-watchers (layer-name watchers) (defun tp--register-layer-watchers (layer-name watchers)
"Register WATCHERS for LAYER-NAME. "Register WATCHERS for LAYER-NAME.
@ -286,12 +294,16 @@ WATCHERS is a list of (VAR-SYMBOL CALLBACK) pairs."
(push (cons layer-name watcher-pairs) tp-layer-watchers))))) (push (cons layer-name watcher-pairs) tp-layer-watchers)))))
(defun tp--register-layer-computed (layer-name computed) (defun tp--register-layer-computed (layer-name computed)
"Register COMPUTED property definitions for LAYER-NAME. "Register COMPUTED variable definitions for LAYER-NAME.
COMPUTED is a plist of (PROP-KEY COMPUTE-FN) pairs." COMPUTED is a list of (VAR-SYMBOL COMPUTE-FN) pairs."
(when computed (when computed
(let ((computed-pairs
(mapcar (lambda (comp)
(cons (car comp) (cadr comp)))
computed)))
(if (assoc layer-name tp-layer-computed) (if (assoc layer-name tp-layer-computed)
(setf (cdr (assoc layer-name tp-layer-computed)) computed) (setf (cdr (assoc layer-name tp-layer-computed)) computed-pairs)
(push (cons layer-name computed) tp-layer-computed)))) (push (cons layer-name computed-pairs) tp-layer-computed)))))
(defun tp--unregister-layer-watchers (layer-name) (defun tp--unregister-layer-watchers (layer-name)
"Unregister all watchers for LAYER-NAME." "Unregister all watchers for LAYER-NAME."
@ -301,15 +313,42 @@ COMPUTED is a plist of (PROP-KEY COMPUTE-FN) pairs."
"Unregister all computed properties for LAYER-NAME." "Unregister all computed properties for LAYER-NAME."
(setq tp-layer-computed (assq-delete-all layer-name tp-layer-computed))) (setq tp-layer-computed (assq-delete-all layer-name tp-layer-computed)))
(defun tp--apply-initial-computed (resolved-props compute) (defun tp--apply-initial-computed (compute)
"Apply initial computed values to RESOLVED-PROPS using COMPUTE definitions. "Apply initial computed values using COMPUTE definitions.
COMPUTE is a plist of (PROP-KEY COMPUTE-FN) pairs. COMPUTE is a list of (VAR-SYMBOL COMPUTE-FN) pairs.
Returns the modified RESOLVED-PROPS." Sets the global variables to their computed values."
(cl-loop for (prop-key compute-fn) on compute by #'cddr (dolist (comp compute)
do (let ((val (tp--resolve-reactive-symbols (funcall compute-fn) nil))) (let* ((var-sym (car comp))
(compute-fn (cadr comp))
(val (condition-case err
(funcall compute-fn)
(error
(message "tp: initial compute error for %s: %s" var-sym err)
nil))))
(when val (when val
(setq resolved-props (plist-put resolved-props prop-key val))))) (set var-sym val)))))
resolved-props)
(defun tp--register-layer-data (layer-name data-vars)
"Register DATA-VARS for LAYER-NAME.
DATA-VARS is a list of variable symbols defined via :data."
(when data-vars
(if (assoc layer-name tp-layer-data)
(setf (cdr (assoc layer-name tp-layer-data)) data-vars)
(push (cons layer-name data-vars) tp-layer-data))))
(defun tp--unregister-layer-data (layer-name)
"Unregister data variables for LAYER-NAME."
(setq tp-layer-data (assq-delete-all layer-name tp-layer-data)))
(defun tp--ensure-reactive-variables (var-symbols)
"Ensure all VAR-SYMBOLS are defined as global variables.
If a variable is not bound, define it with nil as initial value."
(dolist (sym var-symbols)
(let ((var-sym (if (tp--reactive-symbol-p sym)
(tp--reactive-var-symbol sym)
sym)))
(unless (boundp var-sym)
(set var-sym nil)))))
(defun tp--update-layer-regions (layer-name) (defun tp--update-layer-regions (layer-name)
"Update all text regions that have LAYER-NAME applied. "Update all text regions that have LAYER-NAME applied.
@ -340,7 +379,8 @@ Re-applies the layer properties using tp-search-map and tp-add."
;; Clear all registries ;; Clear all registries
(setq tp-reactive-deps nil) (setq tp-reactive-deps nil)
(setq tp-layer-watchers nil) (setq tp-layer-watchers nil)
(setq tp-layer-computed nil)) (setq tp-layer-computed nil)
(setq tp-layer-data nil))
;;; Core Property Functions ;;; Core Property Functions
@ -1865,38 +1905,39 @@ Returns a plist of all properties in the region or string."
(defun tp--parse-define-layer-args (args) (defun tp--parse-define-layer-args (args)
"Parse ARGS for tp-define-layer macro. "Parse ARGS for tp-define-layer macro.
Returns a plist with keys :props, :watch, :compute. Returns a plist with keys :props, :data, :watch, :compute.
When :watch or :compute are present, :props is required." When :watch, :compute, or :data are present, :props is required."
(let (props watch compute has-keywords) (let (props data watch compute has-keywords)
(cond (cond
;; Check for keyword arguments format ;; Check for keyword arguments format
((and (keywordp (car args)) ((and (keywordp (car args))
(memq (car args) '(:props :watch :compute))) (memq (car args) '(:props :data :watch :compute)))
(setq has-keywords t) (setq has-keywords t)
;; Parse keyword arguments ;; Parse keyword arguments
(let ((rest args)) (let ((rest args))
(while rest (while rest
(pcase (car rest) (pcase (car rest)
(:props (setq props (cadr rest) rest (cddr rest))) (:props (setq props (cadr rest) rest (cddr rest)))
(:data (setq data (cadr rest) rest (cddr rest)))
(:watch (setq watch (cadr rest) rest (cddr rest))) (:watch (setq watch (cadr rest) rest (cddr rest)))
(:compute (setq compute (cadr rest) rest (cddr rest))) (:compute (setq compute (cadr rest) rest (cddr rest)))
(_ (error "Unknown keyword in tp-define-layer: %s" (car rest)))))) (_ (error "Unknown keyword in tp-define-layer: %s" (car rest))))))
;; Validate: if :watch or :compute present, :props must be present ;; Validate: if :watch, :compute, or :data present, :props must be present
(when (and (or watch compute) (null props)) (when (and (or watch compute data) (null props))
(error "When using :watch or :compute, :props must be explicitly specified"))) (error "When using :watch, :compute, or :data, :props must be explicitly specified")))
;; Format 1: single plist (legacy) ;; Format 1: single plist (legacy)
((and (= (length args) 1) ((and (= (length args) 1)
(listp (car args))) (listp (car args)))
(setq props (car args))) (setq props (car args)))
(t (error "Invalid tp-define-layer format"))) (t (error "Invalid tp-define-layer format")))
(list :props props :watch watch :compute compute))) (list :props props :data data :watch watch :compute compute)))
(defmacro tp-define-layer (name &rest args) (defmacro tp-define-layer (name &rest args)
"Define a single text property layer named NAME. "Define a single text property layer named NAME.
This macro supports three formats: This macro supports three formats:
Format 1 - Direct plist (legacy, no :watch/:compute support): Format 1 - Direct plist (legacy, no :watch/:compute/:data support):
(tp-define-layer layer-name (tp-define-layer layer-name
(display \"🌑\" face (:height 1.0))) (display \"🌑\" face (:height 1.0)))
@ -1904,59 +1945,73 @@ Format 2 - With :props keyword:
(tp-define-layer layer-name (tp-define-layer layer-name
:props (display \"🌑\" face (:height 1.0))) :props (display \"🌑\" face (:height 1.0)))
Format 3 - With :props, :watch, and/or :compute (Vue 3 style reactivity): Format 3 - With :props, :data, :watch, and/or :compute (Vue 3 style reactivity):
(tp-define-layer layer-name (tp-define-layer layer-name
:props (face (:foreground $my-color) help-echo \"tip\") ;; 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 (first-name last-name)
;; compute: list of (VAR-NAME FUNCTION) - compute reactive variable values
:compute ((full-name (lambda () (concat first-name \" \" last-name))))
;; watch: list of (VAR-NAME CALLBACK) - side effects when vars change
:watch ((my-color (lambda (new old layer) :watch ((my-color (lambda (new old layer)
(message \"Color changed from %s to %s\" old new)))) (message \"Color changed from %s to %s\" old new)))))
:compute (derived-prop (lambda () (concat \"Value: \" $my-var))))
Reactive Variables: Reactive Variables:
If any symbol in the property specification starts with $, it is If any symbol in :props starts with $, it is treated as a reactive variable.
treated as a reactive variable. When that variable's value changes, Variables in :data are also reactive. All reactive variables are automatically
all text regions with this layer will be automatically updated. defined as global variables if they are not already bound.
:watch - A list of (VAR-SYMBOL CALLBACK) pairs. CALLBACK is called :data - A list of variable symbols for additional reactive state not in :props.
when VAR-SYMBOL changes, receiving (NEW-VALUE OLD-VALUE LAYER-NAME).
Similar to Vue 3's watch() function for side effects.
:compute - A plist of (PROP-KEY COMPUTE-FN) pairs. COMPUTE-FN is a :compute - A list of (VAR-SYMBOL COMPUTE-FN) pairs. COMPUTE-FN is evaluated
function that returns the computed value for PROP-KEY. The function to compute the value of VAR-SYMBOL. Can reference other reactive variables
can use reactive variables ($-prefixed symbols) and will be from both :props and :data.
re-evaluated when any of its reactive dependencies change.
Similar to Vue 3's computed() for derived state.
Note: When using :watch or :compute, you MUST use :props to specify :watch - A list of (VAR-SYMBOL CALLBACK) pairs. CALLBACK is called when
VAR-SYMBOL changes, receiving (NEW-VALUE OLD-VALUE LAYER-NAME).
Note: When using :watch, :compute, or :data, you MUST use :props to specify
the text properties explicitly. the text properties explicitly.
If a layer with the same NAME already exists, it will be overwritten If a layer with the same NAME already exists, it will be overwritten.
with the new definition.
The layer is stored in `tp-layer-alist'." The layer is stored in `tp-layer-alist'."
(declare (indent defun)) (declare (indent defun))
(let* ((parsed (tp--parse-define-layer-args args)) (let* ((parsed (tp--parse-define-layer-args args))
(properties (plist-get parsed :props)) (properties (plist-get parsed :props))
(data (plist-get parsed :data))
(watch (plist-get parsed :watch)) (watch (plist-get parsed :watch))
(compute (plist-get parsed :compute)) (compute (plist-get parsed :compute))
(reactive-syms (tp--collect-reactive-symbols properties)) (reactive-syms (tp--collect-reactive-symbols properties))
;; Also collect reactive symbols from compute functions ;; Collect computed variable names (they become reactive too)
(compute-reactive-syms (computed-vars (when compute (mapcar #'car compute)))
(when compute ;; All variables that need to be reactive
(cl-loop for (_key fn) on compute by #'cddr (all-reactive-syms (delete-dups (append reactive-syms)))
append (tp--collect-reactive-symbols fn)))) ;; All variables to ensure are defined (including data)
(all-reactive-syms (delete-dups (append reactive-syms compute-reactive-syms)))) (all-vars-to-define (delete-dups
(if all-reactive-syms (append (mapcar #'tp--reactive-var-symbol reactive-syms)
;; Has reactive symbols - register dependencies and resolve at runtime data
computed-vars))))
(if (or all-reactive-syms data compute)
;; Has reactive features - register dependencies and resolve at runtime
`(progn `(progn
;; Ensure all reactive variables are defined
(tp--ensure-reactive-variables ',all-vars-to-define)
;; Register data variables
,@(when data
`((tp--register-layer-data ',name ',data)))
;; Register computed variable definitions
,@(when compute
`((tp--register-layer-computed ',name ',compute)
;; Apply initial computed values
(tp--apply-initial-computed ',compute)))
;; Register reactive dependencies
(tp--register-reactive-deps ',name ',all-reactive-syms ',properties) (tp--register-reactive-deps ',name ',all-reactive-syms ',properties)
;; Register watchers
,@(when watch ,@(when watch
`((tp--register-layer-watchers ',name ',watch))) `((tp--register-layer-watchers ',name ',watch)))
,@(when compute ;; Set layer properties with resolved values
`((tp--register-layer-computed ',name ',compute)))
(let ((resolved-props (tp--resolve-reactive-symbols ',properties))) (let ((resolved-props (tp--resolve-reactive-symbols ',properties)))
;; Apply initial computed values
,@(when compute
`((setq resolved-props (tp--apply-initial-computed resolved-props ',compute))))
(tp--set-layer-props ',name resolved-props)) (tp--set-layer-props ',name resolved-props))
(assoc ',name tp-layer-alist)) (assoc ',name tp-layer-alist))
;; No reactive symbols - use static properties ;; No reactive symbols - use static properties
@ -1972,8 +2027,8 @@ Returns 'symbol, 'format-1, 'format-2, 'format-3, 'format-4, or nil if invalid."
(cond (cond
;; Symbol - reference to existing layer ;; Symbol - reference to existing layer
((symbolp element) 'symbol) ((symbolp element) 'symbol)
;; Format 4 - ("name" :props (plist...) [:watch ...] [:compute ...]) ;; Format 4 - ("name" :props (plist...) [:data ...] [:watch ...] [:compute ...])
;; Named layer with :props and optional :watch/:compute ;; Named layer with :props and optional :data/:watch/:compute
((and (listp element) ((and (listp element)
(> (length element) 3) (> (length element) 3)
(stringp (car element)) (stringp (car element))
@ -2010,26 +2065,28 @@ IDX is the index for anonymous elements.
Returns a cons cell (LAYER-NAME . PROPERTIES) or a symbol if ELEMENT Returns a cons cell (LAYER-NAME . PROPERTIES) or a symbol if ELEMENT
references an already-defined layer. references an already-defined layer.
For format-4 elements, returns (LAYER-NAME :props PROPS :watch WATCH :compute COMPUTE)." For format-4 elements, returns (LAYER-NAME :props PROPS :data DATA :watch WATCH :compute COMPUTE)."
(let ((format (tp--layer-group-element-format element))) (let ((format (tp--layer-group-element-format element)))
(pcase format (pcase format
('symbol element) ('symbol element)
('format-4 ('format-4
;; Parse named layer with :props and optional :watch/:compute ;; Parse named layer with :props and optional :data/:watch/:compute
(let* ((layer-suffix (car element)) (let* ((layer-suffix (car element))
(layer-name (intern (format "%s-%s" group-name layer-suffix))) (layer-name (intern (format "%s-%s" group-name layer-suffix)))
(rest (cdr element)) (rest (cdr element))
(props nil) (props nil)
(data nil)
(watch nil) (watch nil)
(compute nil)) (compute nil))
;; Parse keyword arguments ;; Parse keyword arguments
(while rest (while rest
(pcase (car rest) (pcase (car rest)
(:props (setq props (cadr rest) rest (cddr rest))) (:props (setq props (cadr rest) rest (cddr rest)))
(:data (setq data (cadr rest) rest (cddr rest)))
(:watch (setq watch (cadr rest) rest (cddr rest))) (:watch (setq watch (cadr rest) rest (cddr rest)))
(:compute (setq compute (cadr rest) rest (cddr rest))) (:compute (setq compute (cadr rest) rest (cddr rest)))
(_ (setq rest (cdr rest))))) (_ (setq rest (cdr rest)))))
(list layer-name :props props :watch watch :compute compute))) (list layer-name :props props :data data :watch watch :compute compute)))
('format-3 ('format-3
(let* ((layer-suffix (car element)) (let* ((layer-suffix (car element))
(layer-name (intern (format "%s-%s" group-name layer-suffix))) (layer-name (intern (format "%s-%s" group-name layer-suffix)))
@ -2068,20 +2125,21 @@ Format 3 - Named layers with :props keyword (named as NAME-suffix):
(\"残月\" :props (display \"🌘\" face (:height 1.5))) (\"残月\" :props (display \"🌘\" face (:height 1.5)))
(\"下弦月\" :props (display \"🌗\" face (:height 2.0)))) (\"下弦月\" :props (display \"🌗\" face (:height 2.0))))
Format 4 - Named layers with :props, :watch, and/or :compute (Vue 3 style): Format 4 - Named layers with :props, :data, :watch, and/or :compute (Vue 3 style):
(tp-define-layer-group group-name (tp-define-layer-group group-name
(\"reactive\" :props (face (:foreground $my-color)) (\"reactive\" :props (face (:foreground $my-color) help-echo $full-name)
:watch ((my-color (lambda (new old layer) (message \"Changed!\"))))) :data (first-name last-name)
(\"computed\" :props (face (:height 1.0)) :compute ((full-name (lambda () (concat first-name \" \" last-name))))
:compute (help-echo (lambda () (format \"Value: %s\" $my-var))))) :watch ((my-color (lambda (new old layer) (message \"Changed!\"))))))
Reactive Variables: Reactive Variables:
If any symbol in the property specification starts with $, it is If any symbol in :props starts with $, it is treated as a reactive variable.
treated as a reactive variable. When that variable's value changes, Variables in :data are also reactive. All reactive variables are automatically
all text regions with that layer will be automatically updated. defined as global variables if they are not already bound.
:data - A list of variable symbols for additional reactive state not in :props.
:compute - A list of (VAR-SYMBOL COMPUTE-FN) pairs for computed reactive variables.
:watch - A list of (VAR-SYMBOL CALLBACK) pairs for side effects. :watch - A list of (VAR-SYMBOL CALLBACK) pairs for side effects.
:compute - A plist of (PROP-KEY COMPUTE-FN) for derived properties.
You can also reference already-defined layers by their symbol name: You can also reference already-defined layers by their symbol name:
(tp-define-layer-group group-name (tp-define-layer-group group-name
@ -2102,31 +2160,41 @@ and the group itself is stored in `tp-layer-groups'."
;; Reference to existing layer (symbol) ;; Reference to existing layer (symbol)
((symbolp parsed) ((symbolp parsed)
(push parsed layer-names)) (push parsed layer-names))
;; Extended format with :watch/:compute (format-4) ;; Extended format with :data/:watch/:compute (format-4)
;; parsed is (layer-name :props ... :watch ... :compute ...) ;; parsed is (layer-name :props ... :data ... :watch ... :compute ...)
((and (listp parsed) (plist-get (cdr parsed) :props)) ((and (listp parsed) (plist-get (cdr parsed) :props))
(let* ((layer-name (car parsed)) (let* ((layer-name (car parsed))
(props (plist-get (cdr parsed) :props)) (props (plist-get (cdr parsed) :props))
(data (plist-get (cdr parsed) :data))
(watch (plist-get (cdr parsed) :watch)) (watch (plist-get (cdr parsed) :watch))
(compute (plist-get (cdr parsed) :compute)) (compute (plist-get (cdr parsed) :compute))
(reactive-syms (tp--collect-reactive-symbols props)) (reactive-syms (tp--collect-reactive-symbols props))
(compute-reactive-syms (computed-vars (when compute (mapcar #'car compute)))
(when compute (all-reactive-syms (delete-dups reactive-syms))
(cl-loop for (_key fn) on compute by #'cddr (all-vars-to-define (delete-dups
append (tp--collect-reactive-symbols fn)))) (append (mapcar #'tp--reactive-var-symbol reactive-syms)
(all-reactive-syms (delete-dups (append reactive-syms compute-reactive-syms)))) data
(if all-reactive-syms computed-vars))))
;; Has reactive symbols - register dependencies and resolve at runtime (if (or all-reactive-syms data compute)
;; Has reactive features - register dependencies and resolve at runtime
(push `(progn (push `(progn
;; Ensure all reactive variables are defined
(tp--ensure-reactive-variables ',all-vars-to-define)
;; Register data variables
,@(when data
`((tp--register-layer-data ',layer-name ',data)))
;; Register computed variable definitions
,@(when compute
`((tp--register-layer-computed ',layer-name ',compute)
(tp--apply-initial-computed ',compute)))
;; Register reactive dependencies
(tp--register-reactive-deps (tp--register-reactive-deps
',layer-name ',all-reactive-syms ',props) ',layer-name ',all-reactive-syms ',props)
;; Register watchers
,@(when watch ,@(when watch
`((tp--register-layer-watchers ',layer-name ',watch))) `((tp--register-layer-watchers ',layer-name ',watch)))
,@(when compute ;; Set layer properties with resolved values
`((tp--register-layer-computed ',layer-name ',compute)))
(let ((resolved-props (tp--resolve-reactive-symbols ',props))) (let ((resolved-props (tp--resolve-reactive-symbols ',props)))
,@(when compute
`((setq resolved-props (tp--apply-initial-computed resolved-props ',compute))))
(tp--set-layer-props ',layer-name resolved-props))) (tp--set-layer-props ',layer-name resolved-props)))
layer-defs) layer-defs)
;; No reactive symbols - use static properties ;; No reactive symbols - use static properties
@ -2141,6 +2209,8 @@ and the group itself is stored in `tp-layer-groups'."
(if reactive-syms (if reactive-syms
;; Has reactive symbols - register dependencies and resolve at runtime ;; Has reactive symbols - register dependencies and resolve at runtime
(push `(progn (push `(progn
(tp--ensure-reactive-variables
',(mapcar #'tp--reactive-var-symbol reactive-syms))
(tp--register-reactive-deps (tp--register-reactive-deps
',layer-name ',reactive-syms ',props) ',layer-name ',reactive-syms ',props)
(let ((resolved-props (tp--resolve-reactive-symbols ',props))) (let ((resolved-props (tp--resolve-reactive-symbols ',props)))