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

improve code

Browse Source
This commit is contained in:
Kinneyzhang 2025-12-20 16:12:46 +08:00
parent 0dba4d2a07
commit 77dfd030d0
1 changed files with 59 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
tp.el
View File

@ -58,9 +58,6 @@ REACTIVE-PROPS contains only the property key-value pairs that use this variable
For example, for (define-tp my-layer (help-echo \"test\" face (:foreground $color))), For example, for (define-tp my-layer (help-echo \"test\" face (:foreground $color))),
only (face (:foreground $color)) is stored, not the help-echo.") only (face (:foreground $color)) is stored, not the help-echo.")
(defvar tp-reactive-enabled t
"Non-nil means reactive text property updates are enabled.")
(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.")
@ -108,7 +105,8 @@ REACTIVE-VAR should be the $-prefixed symbol (e.g., $my-color)."
(let ((result nil)) (let ((result nil))
(cl-loop for (key subval) on val by #'cddr (cl-loop for (key subval) on val by #'cddr
when (member reactive-var (tp--collect-reactive-symbols subval)) when (member reactive-var (tp--collect-reactive-symbols subval))
do (setq result (plist-put result key do (setq result
(plist-put result key
(tp--extract-reactive-value subval reactive-var)))) (tp--extract-reactive-value subval reactive-var))))
result)) result))
;; Otherwise return val as-is if it contains the reactive var ;; Otherwise return val as-is if it contains the reactive var
@ -122,7 +120,8 @@ REACTIVE-VAR should be the $-prefixed symbol (e.g., $my-color)."
(let ((result nil)) (let ((result nil))
(cl-loop for (key val) on plist by #'cddr (cl-loop for (key val) on plist by #'cddr
when (member reactive-var (tp--collect-reactive-symbols val)) when (member reactive-var (tp--collect-reactive-symbols val))
do (setq result (plist-put result key do (setq result
(plist-put result key
(tp--extract-reactive-value val reactive-var)))) (tp--extract-reactive-value val reactive-var))))
result)) result))
@ -183,7 +182,8 @@ Only the reactive portions of the properties are stored for each variable."
(dolist (var-sym vars-to-clean) (dolist (var-sym vars-to-clean)
(remove-variable-watcher var-sym #'tp--reactive-variable-watcher))) (remove-variable-watcher var-sym #'tp--reactive-variable-watcher)))
;; Clean up empty dependency entries ;; Clean up empty dependency entries
(setq tp-reactive-deps (cl-remove-if (lambda (dep) (null (cdr dep))) tp-reactive-deps))) (setq tp-reactive-deps
(cl-remove-if (lambda (dep) (null (cdr dep))) tp-reactive-deps)))
(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.
@ -196,7 +196,7 @@ Only 'set' operations trigger updates because:
- 'let'/'unlet': Temporary bindings that will be restored, no need to update UI - 'let'/'unlet': Temporary bindings that will be restored, no need to update UI
- 'makunbound': Variable is being undefined, not a value change - 'makunbound': Variable is being undefined, not a value change
- 'defvaralias': Aliasing, the actual value change will trigger a separate 'set'" - 'defvaralias': Aliasing, the actual value change will trigger a separate 'set'"
(when (and tp-reactive-enabled (when (and (not (equal (symbol-value symbol) newval))
(eq operation 'set)) (eq operation 'set))
(let ((deps (cdr (assoc symbol tp-reactive-deps))) (let ((deps (cdr (assoc symbol tp-reactive-deps)))
;; Create override alist with the new value ;; Create override alist with the new value
@ -208,7 +208,8 @@ Only 'set' operations trigger updates because:
(reactive-props (cdr dep))) (reactive-props (cdr dep)))
(when reactive-props (when reactive-props
;; Resolve the reactive props with the new value override ;; Resolve the reactive props with the new value override
(let ((resolved-props (tp--resolve-reactive-symbols reactive-props override-alist))) (let ((resolved-props (tp--resolve-reactive-symbols
reactive-props override-alist)))
;; Update only the reactive properties in the layer definition ;; Update only the reactive properties in the layer definition
(let ((current-props (cdr (assoc layer-name tp-layer-alist)))) (let ((current-props (cdr (assoc layer-name tp-layer-alist))))
(when current-props (when current-props
@ -380,10 +381,12 @@ Return the modified object (string) or region (START . END) for buffer."
For nested plists (starting with keyword), recursively merge. For nested plists (starting with keyword), recursively merge.
NEW values override BASE values." NEW values override BASE values."
(let ((result (copy-sequence base))) (let ((result (copy-sequence base)))
(cl-loop for (key val) on new by #'cddr (cl-loop
for (key val) on new by #'cddr
do (let ((base-val (plist-get result key))) do (let ((base-val (plist-get result key)))
(setq result (setq result
(plist-put result key (plist-put
result key
(cond (cond
;; Both are plists - recursively merge ;; Both are plists - recursively merge
((and (listp val) (keywordp (car-safe val)) ((and (listp val) (keywordp (car-safe val))
@ -641,7 +644,9 @@ OBJECT defaults to current buffer."
(pos 0)) (pos 0))
(while (< pos len) (while (< pos len)
(let* ((prop-value (get-text-property pos property str)) (let* ((prop-value (get-text-property pos property str))
(next-pos (or (next-single-property-change pos property str len) len)) (next-pos (or (next-single-property-change
pos property str len)
len))
(value (if sub-path (value (if sub-path
(tp--get-nested prop-value sub-path) (tp--get-nested prop-value sub-path)
prop-value))) prop-value)))
@ -657,7 +662,9 @@ OBJECT defaults to current buffer."
(pos 0)) (pos 0))
(while (< pos len) (while (< pos len)
(let* ((prop-value (get-text-property pos property str)) (let* ((prop-value (get-text-property pos property str))
(next-pos (or (next-single-property-change pos property str len) len)) (next-pos (or (next-single-property-change
pos property str len)
len))
(value (if sub-path (value (if sub-path
(tp--get-nested prop-value sub-path) (tp--get-nested prop-value sub-path)
prop-value))) prop-value)))
@ -704,7 +711,9 @@ OBJECT defaults to current buffer."
(intervals nil)) (intervals nil))
(while (< pos end) (while (< pos end)
(let* ((prop-value (get-text-property pos property object)) (let* ((prop-value (get-text-property pos property object))
(next-pos (or (next-single-property-change pos property object end) end)) (next-pos (or (next-single-property-change
pos property object end)
end))
(value (if sub-path (value (if sub-path
(tp--get-nested prop-value sub-path) (tp--get-nested prop-value sub-path)
prop-value))) prop-value)))
@ -844,12 +853,16 @@ PROPERTY can be a symbol or a list for nested removal."
(let ((pos start)) (let ((pos start))
(while (< pos end) (while (< pos end)
(let* ((current-value (get-text-property pos prop-name object)) (let* ((current-value (get-text-property pos prop-name object))
(next-pos (or (next-single-property-change pos prop-name object end) end))) (next-pos (or (next-single-property-change
pos prop-name object end)
end)))
(when current-value (when current-value
(let* ((sub-value (if (and (listp current-value) (keywordp (car current-value))) (let* ((sub-value
(if (and (listp current-value) (keywordp (car current-value)))
(plist-get current-value sub-key) (plist-get current-value sub-key)
nil)) nil))
(new-sub-value (when (and (listp sub-value) (keywordp (car sub-value))) (new-sub-value
(when (and (listp sub-value) (keywordp (car sub-value)))
(tp--remove-nested-keys sub-value nested-keys))) (tp--remove-nested-keys sub-value nested-keys)))
(new-value (new-value
(cond (cond
@ -1060,7 +1073,8 @@ Merges nested plists instead of replacing them."
(new-val (new-val
(cond (cond
((and (listp val) (keywordp (car-safe val)) ((and (listp val) (keywordp (car-safe val))
(listp current-val) (keywordp (car-safe current-val))) (listp current-val)
(keywordp (car-safe current-val)))
(tp--deep-merge-plist current-val val)) (tp--deep-merge-plist current-val val))
(t val)))) (t val))))
(put-text-property pos next-pos key new-val obj))) (put-text-property pos next-pos key new-val obj)))
@ -1917,7 +1931,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--register-reactive-deps ',layer-name ',reactive-syms ',props) (tp--register-reactive-deps
',layer-name ',reactive-syms ',props)
(let ((resolved-props (tp--resolve-reactive-symbols ',props))) (let ((resolved-props (tp--resolve-reactive-symbols ',props)))
(tp--set-layer-props ',layer-name resolved-props))) (tp--set-layer-props ',layer-name resolved-props)))
layer-defs) layer-defs)
@ -2117,7 +2132,8 @@ Returns (TOP-PROPS . BELOW-PROPS-LIST)."
(let* ((props (text-properties-at pos object)) (let* ((props (text-properties-at pos object))
(tp-layers-idx (-elem-index 'tp-layers props)) (tp-layers-idx (-elem-index 'tp-layers props))
(top-props (if tp-layers-idx (top-props (if tp-layers-idx
(-remove-at-indices (list tp-layers-idx (1+ tp-layers-idx)) props) (-remove-at-indices
(list tp-layers-idx (1+ tp-layers-idx)) props)
props)) props))
(below-props (plist-get props 'tp-layers))) (below-props (plist-get props 'tp-layers)))
(cons top-props below-props))) (cons top-props below-props)))
@ -2641,7 +2657,8 @@ NAME can be nil for an unnamed layer."
;; Use merge with all layers ;; Use merge with all layers
(let* ((layers-to-merge (let* ((layers-to-merge
(cl-loop for id in all-ids (cl-loop for id in all-ids
for found = (tp--get-layer-by-idx-or-name current-stack id) for found = (tp--get-layer-by-idx-or-name
current-stack id)
when found collect found)) when found collect found))
(merged-props (merged-props
(cl-reduce (lambda (acc layer) (cl-reduce (lambda (acc layer)
@ -2745,7 +2762,9 @@ Returns the modified object (string) or nil for buffer operations."
obj (car rest)))) obj (car rest))))
;; Handle plist wrapped in a list (from region form) ;; Handle plist wrapped in a list (from region form)
(when (and (listp plist) (not (keywordp (car-safe plist))) (listp (car-safe plist))) (when (and (listp plist)
(not (keywordp (car-safe plist)))
(listp (car-safe plist)))
(setq plist (car plist))) (setq plist (car plist)))
;; Process each interval ;; Process each interval
@ -2758,7 +2777,8 @@ Returns the modified object (string) or nil for buffer operations."
collect collect
(if (cl-some (if (cl-some
(lambda (id) (lambda (id)
(let ((found (tp--get-layer-by-idx-or-name current-stack id))) (let ((found (tp--get-layer-by-idx-or-name
current-stack id)))
(and found (= (car found) i)))) (and found (= (car found) i))))
layer-ids) layer-ids)
;; Merge plist into this layer ;; Merge plist into this layer
@ -2814,7 +2834,9 @@ Returns the modified object (string) or nil for buffer operations."
obj (car rest)))) obj (car rest))))
;; Handle plist wrapped in a list (from region form) ;; Handle plist wrapped in a list (from region form)
(when (and (listp plist) (not (keywordp (car-safe plist))) (listp (car-safe plist))) (when (and (listp plist)
(not (keywordp (car-safe plist)))
(listp (car-safe plist)))
(setq plist (car plist))) (setq plist (car plist)))
;; Get the maximum layer count in the region to build a list of all indices ;; Get the maximum layer count in the region to build a list of all indices