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

format

Browse Source
This commit is contained in:
Kinneyzhang 2025-12-15 16:20:51 +08:00
parent bca7d4a41c
commit a41ad171a0
1 changed files with 22 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
tp.el
View File

@ -252,24 +252,26 @@ Return the modified object (string) or region (START . END) for buffer."
(let* ((current-props (text-properties-at pos object)) (let* ((current-props (text-properties-at pos object))
(next-pos (or (next-property-change pos object finish) finish))) (next-pos (or (next-property-change pos object finish) finish)))
;; Merge each property in props ;; Merge each property in props
(cl-loop for (key val) on props by #'cddr (cl-loop
do (let* ((current-val (plist-get current-props key)) for (key val) on props by #'cddr
(new-val do (let* ((current-val (plist-get current-props key))
(cond (new-val
;; Handle face property specially - prepend faces (cond
((eq key 'face) ;; Handle face property specially - prepend faces
(tp--prepend-face val current-val)) ((eq key 'face)
;; Both are plists - deep merge (tp--prepend-face val current-val))
((and (listp val) (keywordp (car-safe val)) ;; Both are plists - deep merge
(listp current-val) (keywordp (car-safe current-val))) ((and (listp val) (keywordp (car-safe val))
(tp--deep-merge-plist current-val val)) (listp current-val) (keywordp (car-safe current-val)))
;; Otherwise use new value (tp--deep-merge-plist current-val val))
(t val)))) ;; Otherwise use new value
(put-text-property pos next-pos key new-val object))) (t val))))
(put-text-property pos next-pos key new-val object)))
(setq pos next-pos)))) (setq pos next-pos))))
(if (stringp object) (if (stringp object)
object object
(cons start finish)))) (cons start finish))))
(defun tp--parse-single-prop-args (start-or-string end-or-val val-or-object rest) (defun tp--parse-single-prop-args (start-or-string end-or-val val-or-object rest)
"Parse arguments for single-property functions like tp-set-face. "Parse arguments for single-property functions like tp-set-face.
Returns (OBJECT START END VALUE)." Returns (OBJECT START END VALUE)."
@ -310,7 +312,8 @@ This function supports four calling conventions:
This replaces only the face property, preserving other properties. This replaces only the face property, preserving other properties.
Return the modified object (string) or region (START . END) for buffer." Return the modified object (string) or region (START . END) for buffer."
(pcase-let ((`(,object ,start ,finish ,face) (pcase-let ((`(,object ,start ,finish ,face)
(tp--parse-single-prop-args start-or-string end-or-face face-or-object rest))) (tp--parse-single-prop-args
start-or-string end-or-face face-or-object rest)))
(put-text-property start finish 'face face object) (put-text-property start finish 'face face object)
(if (stringp object) (if (stringp object)
object object
@ -336,13 +339,13 @@ This function supports four calling conventions:
This replaces only the display property, preserving other properties. This replaces only the display property, preserving other properties.
Return the modified object (string) or region (START . END) for buffer." Return the modified object (string) or region (START . END) for buffer."
(pcase-let ((`(,object ,start ,finish ,display) (pcase-let ((`(,object ,start ,finish ,display)
(tp--parse-single-prop-args start-or-string end-or-display display-or-object rest))) (tp--parse-single-prop-args
start-or-string end-or-display display-or-object rest)))
(put-text-property start finish 'display display object) (put-text-property start finish 'display display object)
(if (stringp object) (if (stringp object)
object object
(cons start finish)))) (cons start finish))))
(defun tp--get-nested (value path) (defun tp--get-nested (value path)
"Get nested value from VALUE following PATH. "Get nested value from VALUE following PATH.
PATH is a list of keys/symbols to traverse nested structures. PATH is a list of keys/symbols to traverse nested structures.
@ -595,9 +598,6 @@ POINT defaults to current point.
OBJECT defaults to current buffer." OBJECT defaults to current buffer."
(text-properties-at (or point (point)) object)) (text-properties-at (or point (point)) object))
;;; Match and regexp functions (similar to ov-match and ov-regexp)
;;; Private functions for fine-grained property manipulation ;;; Private functions for fine-grained property manipulation
(defun tp--remove-sub (start end property sub-property &optional object) (defun tp--remove-sub (start end property sub-property &optional object)
@ -751,6 +751,8 @@ OBJECT defaults to current buffer."
(finish (or end (point-max)))) (finish (or end (point-max))))
(set-text-properties beg finish nil object))) (set-text-properties beg finish nil object)))
;;; Match and regexp functions
(defun tp--match-apply (pattern properties apply-fn &optional object) (defun tp--match-apply (pattern properties apply-fn &optional object)
"Internal function to apply APPLY-FN to matches of PATTERN. "Internal function to apply APPLY-FN to matches of PATTERN.
PATTERN can be a string or (PATTERN STRING) for substring matching. PATTERN can be a string or (PATTERN STRING) for substring matching.
@ -1340,7 +1342,6 @@ Appends 'tp-name property to identify the layer."
(defalias 'tp-layer-group-properties 'tp-group-props (defalias 'tp-layer-group-properties 'tp-group-props
"Alias for `tp-group-props'.") "Alias for `tp-group-props'.")
(defun tp-layer-reset () (defun tp-layer-reset ()
"Reset all layer definitions. "Reset all layer definitions.
Clears both `tp-layer-alist' and `tp-layer-groups'." Clears both `tp-layer-alist' and `tp-layer-groups'."