diff --git a/tp-tests.el b/tp-tests.el index 88d7934..a7843bb 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -1603,5 +1603,179 @@ Returns list of (START END VALUE) intervals." (let ((intervals (tp-get 0 7 '(face :underline (:color :style)) str))) (should (= (length intervals) 2))))) +;;; ============================================================ +;;; tp-add-to-layers and tp-add-to-all-layers Tests +;;; ============================================================ + +(ert-deftest tp-test-add-to-layers-buffer () + "Test tp-add-to-layers adds properties to specified layers in buffer." + (tp-test-with-temp-buffer + (insert "Hello") + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-define-layer layer3 (face underline)) + (tp-push-layer 1 6 'layer1) + (tp-push-layer 1 6 'layer2) + (tp-push-layer 1 6 'layer3) + ;; Add help-echo to layer1 and layer3 + (tp-add-to-layers '(layer1 layer3) 1 6 '(help-echo "test")) + ;; layer3 is on top, should have help-echo + (should (equal (tp-at 1 'help-echo) "test")) + ;; Check layer1 also got help-echo + (let ((layer1-props (car (tp-region-layer-props 1 6 'layer1)))) + (should (equal (plist-get (caddr layer1-props) 'help-echo) "test"))) + ;; layer2 should NOT have help-echo + (let ((layer2-props (car (tp-region-layer-props 1 6 'layer2)))) + (should (null (plist-get (caddr layer2-props) 'help-echo)))))) + +(ert-deftest tp-test-add-to-layers-by-index () + "Test tp-add-to-layers with layer indices." + (tp-test-with-temp-buffer + (insert "Hello") + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-define-layer layer3 (face underline)) + (tp-push-layer 1 6 'layer1) + (tp-push-layer 1 6 'layer2) + (tp-push-layer 1 6 'layer3) + ;; Stack is: layer3 (0), layer2 (1), layer1 (2) + ;; Add help-echo to indices 0 and 2 (layer3 and layer1) + (tp-add-to-layers '(0 2) 1 6 '(help-echo "indexed")) + ;; layer3 (top) should have help-echo + (should (equal (tp-at 1 'help-echo) "indexed")) + ;; Check layer1 also got help-echo + (let ((layer1-props (car (tp-region-layer-props 1 6 'layer1)))) + (should (equal (plist-get (caddr layer1-props) 'help-echo) "indexed"))) + ;; layer2 (index 1) should NOT have help-echo + (let ((layer2-props (car (tp-region-layer-props 1 6 'layer2)))) + (should (null (plist-get (caddr layer2-props) 'help-echo)))))) + +(ert-deftest tp-test-add-to-layers-string () + "Test tp-add-to-layers works on entire string." + (let ((str (copy-sequence "Hello"))) + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-push-layer str 'layer1) + (tp-push-layer str 'layer2) + ;; Add help-echo to layer1 + (tp-add-to-layers '(layer1) str 'help-echo "test") + ;; Check layer1 got help-echo + (let ((layer1-props (car (tp-region-layer-props 0 5 'layer1 str)))) + (should (equal (plist-get (caddr layer1-props) 'help-echo) "test"))) + ;; layer2 (top) should NOT have help-echo + (should (null (tp-at 0 'help-echo str))))) + +(ert-deftest tp-test-add-to-layers-deep-merge () + "Test tp-add-to-layers deeply merges properties." + (tp-test-with-temp-buffer + (insert "Hello") + (tp-define-layer layer1 (face (:foreground "red"))) + (tp-push-layer 1 6 'layer1) + ;; Add background to layer1 - should merge with existing face + (tp-add-to-layers '(layer1) 1 6 '(face (:background "blue"))) + (let ((face (tp-at 1 'face))) + (should (equal (plist-get face :foreground) "red")) + (should (equal (plist-get face :background) "blue"))))) + +(ert-deftest tp-test-add-to-all-layers-buffer () + "Test tp-add-to-all-layers adds properties to all layers in buffer." + (tp-test-with-temp-buffer + (insert "Hello") + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-define-layer layer3 (face underline)) + (tp-push-layer 1 6 'layer1) + (tp-push-layer 1 6 'layer2) + (tp-push-layer 1 6 'layer3) + ;; Add help-echo to all layers + (tp-add-to-all-layers 1 6 '(help-echo "all")) + ;; layer3 (top) should have help-echo + (should (equal (tp-at 1 'help-echo) "all")) + ;; Check all layers got help-echo + (let ((layer1-props (car (tp-region-layer-props 1 6 'layer1))) + (layer2-props (car (tp-region-layer-props 1 6 'layer2))) + (layer3-props (car (tp-region-layer-props 1 6 'layer3)))) + (should (equal (plist-get (caddr layer1-props) 'help-echo) "all")) + (should (equal (plist-get (caddr layer2-props) 'help-echo) "all")) + (should (equal (plist-get (caddr layer3-props) 'help-echo) "all"))))) + +(ert-deftest tp-test-add-to-all-layers-string () + "Test tp-add-to-all-layers works on entire string." + (let ((str (copy-sequence "Hello"))) + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-push-layer str 'layer1) + (tp-push-layer str 'layer2) + ;; Add help-echo to all layers + (tp-add-to-all-layers str 'help-echo "all") + ;; Check all layers got help-echo + (let ((layer1-props (car (tp-region-layer-props 0 5 'layer1 str))) + (layer2-props (car (tp-region-layer-props 0 5 'layer2 str)))) + (should (equal (plist-get (caddr layer1-props) 'help-echo) "all")) + (should (equal (plist-get (caddr layer2-props) 'help-echo) "all"))))) + +(ert-deftest tp-test-add-to-all-layers-deep-merge () + "Test tp-add-to-all-layers deeply merges properties." + (tp-test-with-temp-buffer + (insert "Hello") + (tp-define-layer layer1 (face (:foreground "red"))) + (tp-define-layer layer2 (face (:foreground "blue"))) + (tp-push-layer 1 6 'layer1) + (tp-push-layer 1 6 'layer2) + ;; Add background to all layers + (tp-add-to-all-layers 1 6 '(face (:background "green"))) + ;; Top layer (layer2) should have merged face + (let ((face (tp-at 1 'face))) + (should (equal (plist-get face :foreground) "blue")) + (should (equal (plist-get face :background) "green"))) + ;; layer1 should also have merged face + (let* ((layer1-props (car (tp-region-layer-props 1 6 'layer1))) + (face (plist-get (caddr layer1-props) 'face))) + (should (equal (plist-get face :foreground) "red")) + (should (equal (plist-get face :background) "green"))))) + +(ert-deftest tp-test-add-to-layers-negative-index () + "Test tp-add-to-layers with negative index (-1 means bottom)." + (tp-test-with-temp-buffer + (insert "Hello") + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-push-layer 1 6 'layer1) + (tp-push-layer 1 6 'layer2) + ;; Stack is: layer2 (0), layer1 (1) + ;; Add help-echo to index -1 (bottom = layer1) + (tp-add-to-layers '(-1) 1 6 '(help-echo "bottom")) + ;; layer2 (top) should NOT have help-echo + (should (null (tp-at 1 'help-echo))) + ;; layer1 (bottom) should have help-echo + (let ((layer1-props (car (tp-region-layer-props 1 6 'layer1)))) + (should (equal (plist-get (caddr layer1-props) 'help-echo) "bottom"))))) + +(ert-deftest tp-test-add-to-layers-returns-string () + "Test tp-add-to-layers returns the modified string." + (let ((str (copy-sequence "Hello"))) + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer layer1 (face bold)) + (tp-push-layer str 'layer1) + (let ((result (tp-add-to-layers '(layer1) str 'help-echo "test"))) + (should (stringp result)) + (should (eq result str))))) + +(ert-deftest tp-test-add-to-all-layers-returns-string () + "Test tp-add-to-all-layers returns the modified string." + (let ((str (copy-sequence "Hello"))) + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer layer1 (face bold)) + (tp-push-layer str 'layer1) + (let ((result (tp-add-to-all-layers str 'help-echo "test"))) + (should (stringp result)) + (should (eq result str))))) + (provide 'tp-ert-tests) ;;; tp-ert-tests.el ends here diff --git a/tp.el b/tp.el index 1ac51e3..ba83120 100644 --- a/tp.el +++ b/tp.el @@ -2139,6 +2139,127 @@ OBJECT defaults to current buffer." (when-let ((intervals (tp-intervals start end object))) (plist-get (nth 2 (car intervals)) 'tp-name))) +;;; Layer property manipulation functions + +(defun tp-add-to-layers (idx-or-layer-name-list start-or-string &optional end-or-plist plist-or-object object) + "Add/merge properties to specified layers. + +This function supports two calling conventions: + +1. Buffer/string region: + (tp-add-to-layers IDX-OR-LAYER-NAME-LIST START END PLIST OBJECT) + +2. Entire string: + (tp-add-to-layers IDX-OR-LAYER-NAME-LIST STRING &rest PLIST) + +IDX-OR-LAYER-NAME-LIST is a list of layer indices (integers) or +layer names (symbols) specifying which layers to add properties to. +For indices: 0 means top layer, -1 means bottom layer. + +PLIST is a property list to merge into the specified layers. +Properties are deeply merged (nested plists are merged, not replaced). + +OBJECT defaults to current buffer for region form. + +Returns the modified object (string) or nil for buffer operations." + (let (start end plist obj layer-ids) + (setq layer-ids idx-or-layer-name-list) + (cond + ;; Entire string form: (tp-add-to-layers ids string &rest plist) + ((stringp start-or-string) + (setq obj start-or-string + start 0 + end (length start-or-string) + plist (if (listp end-or-plist) + (if plist-or-object + (cons end-or-plist (cons plist-or-object (when object (list object)))) + end-or-plist) + (list end-or-plist plist-or-object)))) + ;; Region form: (tp-add-to-layers ids start end plist object) + ((numberp start-or-string) + (setq start start-or-string + end end-or-plist + plist plist-or-object + obj object))) + + ;; Handle plist as list if needed + (when (and (listp plist) (listp (car plist)) (keywordp (caar plist))) + (setq plist (car plist))) + + ;; Process each interval + (tp-intervals-map + (lambda (i-start i-end top belows) + (let* ((current-stack (tp--layer-stack-to-list top belows)) + (modified-stack + (cl-loop for layer in current-stack + for i from 0 + collect + (if (cl-some + (lambda (id) + (let ((found (tp--get-layer-by-idx-or-name current-stack id))) + (and found (= (car found) i)))) + layer-ids) + ;; Merge plist into this layer + (tp--deep-merge-plist layer plist) + ;; Keep layer unchanged + layer)))) + (set-text-properties + (+ start i-start) (+ start i-end) + (tp--build-layer-props modified-stack) + obj))) + start end obj) + (if (stringp obj) obj nil))) + +(defun tp-add-to-all-layers (start-or-string &optional end-or-plist plist-or-object object) + "Add/merge properties to all layers. + +This function supports two calling conventions: + +1. Buffer/string region: + (tp-add-to-all-layers START END PLIST OBJECT) + +2. Entire string: + (tp-add-to-all-layers STRING &rest PLIST) + +PLIST is a property list to merge into all layers. +Properties are deeply merged (nested plists are merged, not replaced). + +OBJECT defaults to current buffer for region form. + +This function uses `tp-add-to-layers' internally, collecting all +layer indices and passing them to add the plist to every layer. + +Returns the modified object (string) or nil for buffer operations." + (let (start end plist obj) + (cond + ;; Entire string form: (tp-add-to-all-layers string &rest plist) + ((stringp start-or-string) + (setq obj start-or-string + start 0 + end (length start-or-string) + plist (if (listp end-or-plist) + (if plist-or-object + (cons end-or-plist (cons plist-or-object (when object (list object)))) + end-or-plist) + (list end-or-plist plist-or-object)))) + ;; Region form: (tp-add-to-all-layers start end plist object) + ((numberp start-or-string) + (setq start start-or-string + end end-or-plist + plist plist-or-object + obj object))) + + ;; Handle plist as list if needed + (when (and (listp plist) (listp (car plist)) (keywordp (caar plist))) + (setq plist (car plist))) + + ;; Get the maximum layer count in the region to build a list of all indices + (let ((max-count (tp-layer-count start end obj))) + (when (> max-count 0) + (let ((all-indices (cl-loop for i from 0 below max-count collect i))) + (tp-add-to-layers all-indices start end plist obj)))) + (if (stringp obj) obj nil))) + (provide 'tp) ;;; tp.el ends here