diff --git a/tp-tests.el b/tp-tests.el index d2b2b54..b7dfc8f 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -2042,5 +2042,169 @@ Returns list of (START END VALUE) intervals." ;; Cleanup (makunbound 'tp-test-undef-color)))) +;;; ============================================================ +;;; Layer Name in Property-Setting APIs Tests +;;; ============================================================ + +(ert-deftest tp-test-set-with-layer-name () + "Test tp-set accepts a layer name defined by define-tp." + (tp-test-with-temp-buffer + (insert "Hello World") + (tp-define-layer my-style (face bold help-echo "tip")) + ;; Use layer name instead of plist + (tp-set 1 6 'my-style) + (should (eq (tp-at 1 'face) 'bold)) + (should (equal (tp-at 1 'help-echo) "tip")))) + +(ert-deftest tp-test-set-with-layer-name-on-string () + "Test tp-set accepts a layer name on string." + (let ((str (copy-sequence "Hello World"))) + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer my-style (face italic)) + (tp-set 0 5 'my-style str) + (should (eq (get-text-property 0 'face str) 'italic)))) + +(ert-deftest tp-test-reset-with-layer-name () + "Test tp-reset accepts a layer name defined by define-tp." + (tp-test-with-temp-buffer + (insert "Hello World") + (tp-set 1 6 '(mouse-face highlight)) + (tp-define-layer my-style (face underline)) + ;; Use layer name - should completely replace + (tp-reset 1 6 'my-style) + (should (eq (tp-at 1 'face) 'underline)) + (should (null (tp-at 1 'mouse-face))))) + +(ert-deftest tp-test-add-with-layer-name () + "Test tp-add accepts a layer name defined by define-tp." + (tp-test-with-temp-buffer + (insert "Hello World") + (tp-set 1 6 '(help-echo "existing")) + (tp-define-layer my-style (face bold)) + ;; Use layer name - should preserve existing properties + (tp-add 1 6 'my-style) + (should (eq (tp-at 1 'face) 'bold)) + (should (equal (tp-at 1 'help-echo) "existing")))) + +(ert-deftest tp-test-match-set-with-layer-name () + "Test tp-match-set accepts a layer name." + (tp-test-with-temp-buffer + (insert "Hello World Hello") + (tp-define-layer match-style (face bold help-echo "matched")) + (tp-match-set "Hello" 'match-style) + (should (eq (tp-at 1 'face) 'bold)) + (should (equal (tp-at 1 'help-echo) "matched")) + (should (eq (tp-at 13 'face) 'bold)))) + +(ert-deftest tp-test-match-set-with-layer-name-on-string () + "Test tp-match-set accepts a layer name on string." + (let ((str (copy-sequence "Hello World Hello"))) + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer match-style (face italic)) + (tp-match-set "Hello" 'match-style str) + (should (eq (get-text-property 0 'face str) 'italic)) + (should (eq (get-text-property 12 'face str) 'italic)))) + +(ert-deftest tp-test-match-reset-with-layer-name () + "Test tp-match-reset accepts a layer name." + (tp-test-with-temp-buffer + (insert "Hello World Hello") + (tp-set 1 6 '(mouse-face highlight)) + (tp-define-layer match-style (face bold)) + (tp-match-reset "Hello" 'match-style) + (should (eq (tp-at 1 'face) 'bold)) + (should (null (tp-at 1 'mouse-face))))) + +(ert-deftest tp-test-match-add-with-layer-name () + "Test tp-match-add accepts a layer name." + (tp-test-with-temp-buffer + (insert "Hello World Hello") + (tp-set 1 6 '(help-echo "original")) + (tp-define-layer match-style (face bold)) + (tp-match-add "Hello" 'match-style) + (should (eq (tp-at 1 'face) 'bold)) + (should (equal (tp-at 1 'help-echo) "original")))) + +(ert-deftest tp-test-regexp-set-with-layer-name () + "Test tp-regexp-set accepts a layer name." + (tp-test-with-temp-buffer + (insert "abc 123 def 456") + (tp-define-layer number-style (face bold help-echo "number")) + (tp-regexp-set "[0-9]+" 'number-style) + (should (eq (tp-at 5 'face) 'bold)) + (should (equal (tp-at 5 'help-echo) "number")) + (should (eq (tp-at 13 'face) 'bold)))) + +(ert-deftest tp-test-regexp-set-with-layer-name-on-string () + "Test tp-regexp-set accepts a layer name on string." + (let ((str (copy-sequence "abc 123 def 456"))) + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer number-style (face italic)) + (tp-regexp-set "[0-9]+" 'number-style str) + (should (eq (get-text-property 4 'face str) 'italic)) + (should (eq (get-text-property 12 'face str) 'italic)))) + +(ert-deftest tp-test-regexp-reset-with-layer-name () + "Test tp-regexp-reset accepts a layer name." + (tp-test-with-temp-buffer + (insert "abc 123 def 456") + (tp-set 5 8 '(mouse-face highlight)) + (tp-define-layer number-style (face bold)) + (tp-regexp-reset "[0-9]+" 'number-style) + (should (eq (tp-at 5 'face) 'bold)) + (should (null (tp-at 5 'mouse-face))))) + +(ert-deftest tp-test-regexp-add-with-layer-name () + "Test tp-regexp-add accepts a layer name." + (tp-test-with-temp-buffer + (insert "abc 123 def 456") + (tp-set 5 8 '(help-echo "original")) + (tp-define-layer number-style (face bold)) + (tp-regexp-add "[0-9]+" 'number-style) + (should (eq (tp-at 5 'face) 'bold)) + (should (equal (tp-at 5 'help-echo) "original")))) + +(ert-deftest tp-test-set-with-group-name () + "Test tp-set accepts a group name defined by define-tp-group." + (tp-test-with-temp-buffer + (insert "Hello World") + (tp-define-layer-group my-group + ("style" . (face bold help-echo "grouped"))) + ;; Use group name - should use first layer's properties + (tp-set 1 6 'my-group) + (should (eq (tp-at 1 'face) 'bold)) + (should (equal (tp-at 1 'help-echo) "grouped")))) + +(ert-deftest tp-test-match-set-with-group-name () + "Test tp-match-set accepts a group name." + (tp-test-with-temp-buffer + (insert "Hello World Hello") + (tp-define-layer-group my-group + ("style" . (face italic))) + (tp-match-set "Hello" 'my-group) + (should (eq (tp-at 1 'face) 'italic)) + (should (eq (tp-at 13 'face) 'italic)))) + +(ert-deftest tp-test-resolve-props-returns-nil-for-unknown () + "Test tp--resolve-props returns nil for unknown layer name." + (tp-test-with-temp-buffer + (should (null (tp--resolve-props 'unknown-layer-name))))) + +(ert-deftest tp-test-set-with-complex-layer () + "Test tp-set with layer containing complex nested properties." + (tp-test-with-temp-buffer + (insert "Hello World") + (tp-define-layer complex-layer + (face (:foreground "red" :underline (:style wave)) + help-echo "complex")) + (tp-set 1 6 'complex-layer) + (let ((face (tp-at 1 'face))) + (should (equal (plist-get face :foreground) "red")) + (should (equal (plist-get (plist-get face :underline) :style) 'wave))) + (should (equal (tp-at 1 'help-echo) "complex")))) + (provide 'tp-ert-tests) ;;; tp-ert-tests.el ends here diff --git a/tp.el b/tp.el index 2e150c9..9d23829 100644 --- a/tp.el +++ b/tp.el @@ -248,7 +248,10 @@ Supports four calling conventions: 1. Buffer region: (START END PROPS) 2. Buffer region with object: (START END PROPS OBJECT) 3. String region: (START END PROPS STRING) -4. Entire string: (STRING PROP VAL ...)" +4. Entire string: (STRING PROP VAL ...) + +PROPS can also be a symbol representing a layer or group name defined +by `define-tp' or `define-tp-group', which will be resolved to its properties." (let (object start finish props) (cond ;; First arg is a string - apply to entire string @@ -272,8 +275,11 @@ Supports four calling conventions: (setq object nil props props-or-val))) (t (error "Invalid first argument: %S" start-or-string))) - ;; Handle properties as a list - (when (listp (car-safe props)) + ;; Resolve layer/group name to properties if props is a symbol + (when (symbolp props) + (setq props (or (tp--resolve-props props) props))) + ;; Handle properties as a list (only if props is a list and its first element is also a list) + (when (and (listp props) (listp (car-safe props))) (setq props (car props))) (list object start finish props))) @@ -284,16 +290,22 @@ This function supports four calling conventions: 1. Current buffer: (tp-set START END \\='(PROPERTY VALUE ...)) + (tp-set START END LAYER-NAME) 2. Specific buffer: (tp-set START END \\='(PROPERTY VALUE ...) BUFFER) + (tp-set START END LAYER-NAME BUFFER) 3. Specific string (0-indexed positions): (tp-set START END \\='(PROPERTY VALUE ...) STRING) + (tp-set START END LAYER-NAME STRING) 4. Entire string: (tp-set STRING PROPERTY VALUE ...) +PROPS can also be a symbol representing a layer or group name defined +by `define-tp' or `define-tp-group', which will be resolved to its properties. + This replaces only the properties specified, preserving other properties. Return the modified object (string) or region (START . END) for buffer." (pcase-let ((`(,object ,start ,finish ,props) @@ -318,16 +330,22 @@ This function supports four calling conventions: 1. Current buffer: (tp-reset START END \\='(PROPERTY VALUE ...)) + (tp-reset START END LAYER-NAME) 2. Specific buffer: (tp-reset START END \\='(PROPERTY VALUE ...) BUFFER) + (tp-reset START END LAYER-NAME BUFFER) 3. Specific string (0-indexed positions): (tp-reset START END \\='(PROPERTY VALUE ...) STRING) + (tp-reset START END LAYER-NAME STRING) 4. Entire string: (tp-reset STRING PROPERTY VALUE ...) +PROPS can also be a symbol representing a layer or group name defined +by `define-tp' or `define-tp-group', which will be resolved to its properties. + Unlike `tp-set', this completely replaces all existing properties. Return the modified object (string) or region (START . END) for buffer." (pcase-let ((`(,object ,start ,finish ,props) @@ -415,16 +433,22 @@ This function supports four calling conventions: 1. Current buffer: (tp-add START END \\='(PROPERTY VALUE ...)) + (tp-add START END LAYER-NAME) 2. Specific buffer: (tp-add START END \\='(PROPERTY VALUE ...) BUFFER) + (tp-add START END LAYER-NAME BUFFER) 3. Specific string (0-indexed positions): (tp-add START END \\='(PROPERTY VALUE ...) STRING) + (tp-add START END LAYER-NAME STRING) 4. Entire string: (tp-add STRING PROPERTY VALUE ...) +PROPS can also be a symbol representing a layer or group name defined +by `define-tp' or `define-tp-group', which will be resolved to its properties. + Unlike `tp-set', this deeply merges nested properties. For example, \\='(face (:underline (:style wave))) will merge with existing face properties rather than replacing them entirely. @@ -1030,13 +1054,16 @@ Merges nested plists instead of replacing them." PATTERN is a string (single pattern) or list of strings (multiple patterns). Each pattern will be matched and have properties applied. -PLIST is a property list like \\='(face bold help-echo \"tip\"). +PLIST is a property list like \\='(face bold help-echo \"tip\"), +or a symbol representing a layer/group name defined by `define-tp' +or `define-tp-group'. OBJECT is a buffer or string; nil means current buffer. Returns: - For strings: the modified string - For buffers: list of (START . END) pairs for all matches." - (tp--match-apply pattern plist #'tp-set object)) + (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist))) + (tp--match-apply pattern props #'tp-set object))) (defun tp-match-reset (pattern plist &optional object) "Reset (completely replace) properties on all occurrences of PATTERN. @@ -1044,14 +1071,17 @@ Returns: (tp-match-reset PATTERN PLIST &optional OBJECT) PATTERN is a string (single pattern) or list of strings (multiple patterns). -PLIST is a property list like \\='(face bold help-echo \"tip\"). +PLIST is a property list like \\='(face bold help-echo \"tip\"), +or a symbol representing a layer/group name defined by `define-tp' +or `define-tp-group'. OBJECT is a buffer or string; nil means current buffer. Unlike `tp-match-set', this completely replaces all existing properties." - (tp--match-apply pattern plist - (lambda (start end props obj) - (set-text-properties start end props obj)) - object)) + (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist))) + (tp--match-apply pattern props + (lambda (start end props obj) + (set-text-properties start end props obj)) + object))) (defun tp-match-add (pattern plist &optional object) "Add/update properties on all occurrences of PATTERN. @@ -1059,11 +1089,14 @@ Unlike `tp-match-set', this completely replaces all existing properties." (tp-match-add PATTERN PLIST &optional OBJECT) PATTERN is a string (single pattern) or list of strings (multiple patterns). -PLIST is a property list like \\='(face bold help-echo \"tip\"). +PLIST is a property list like \\='(face bold help-echo \"tip\"), +or a symbol representing a layer/group name defined by `define-tp' +or `define-tp-group'. OBJECT is a buffer or string; nil means current buffer. Unlike `tp-match-set', this deeply merges nested properties." - (tp--match-apply pattern plist #'tp--deep-merge-apply object)) + (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist))) + (tp--match-apply pattern props #'tp--deep-merge-apply object))) (defun tp-regexp-set (pattern plist &optional object) "Set properties on all matches of PATTERN (regexp). @@ -1072,13 +1105,16 @@ Unlike `tp-match-set', this deeply merges nested properties." PATTERN is a string (single regexp) or list of strings (multiple regexps). Each pattern will be matched and have properties applied. -PLIST is a property list like \\='(face bold help-echo \"tip\"). +PLIST is a property list like \\='(face bold help-echo \"tip\"), +or a symbol representing a layer/group name defined by `define-tp' +or `define-tp-group'. OBJECT is a buffer or string; nil means current buffer. Returns: - For strings: the modified string - For buffers: list of (START . END) pairs for all matches." - (tp--regexp-apply pattern plist #'tp-set object)) + (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist))) + (tp--regexp-apply pattern props #'tp-set object))) (defun tp-regexp-reset (pattern plist &optional object) "Reset (completely replace) properties on all regexp matches of PATTERN. @@ -1086,14 +1122,17 @@ Returns: (tp-regexp-reset PATTERN PLIST &optional OBJECT) PATTERN is a string (single regexp) or list of strings (multiple regexps). -PLIST is a property list like \\='(face bold help-echo \"tip\"). +PLIST is a property list like \\='(face bold help-echo \"tip\"), +or a symbol representing a layer/group name defined by `define-tp' +or `define-tp-group'. OBJECT is a buffer or string; nil means current buffer. Unlike `tp-regexp-set', this completely replaces all existing properties." - (tp--regexp-apply pattern plist - (lambda (start end props obj) - (set-text-properties start end props obj)) - object)) + (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist))) + (tp--regexp-apply pattern props + (lambda (start end props obj) + (set-text-properties start end props obj)) + object))) (defun tp-regexp-add (pattern plist &optional object) "Add/update properties on all regexp matches of PATTERN. @@ -1101,11 +1140,14 @@ Unlike `tp-regexp-set', this completely replaces all existing properties." (tp-regexp-add PATTERN PLIST &optional OBJECT) PATTERN is a string (single regexp) or list of strings (multiple regexps). -PLIST is a property list like \\='(face bold help-echo \"tip\"). +PLIST is a property list like \\='(face bold help-echo \"tip\"), +or a symbol representing a layer/group name defined by `define-tp' +or `define-tp-group'. OBJECT is a buffer or string; nil means current buffer. Unlike `tp-regexp-set', this deeply merges nested properties." - (tp--regexp-apply pattern plist #'tp--deep-merge-apply object)) + (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist))) + (tp--regexp-apply pattern props #'tp--deep-merge-apply object))) ;;; Search functions @@ -1911,6 +1953,37 @@ Appends 'tp-name property to identify the layer." (tp-layer-props layer)) layers))) +(defun tp--resolve-props (props) + "Resolve PROPS to a property list. +PROPS can be: +- A symbol (layer name from `tp-layer-alist' or group name from `tp-layer-groups') +- A plist (returned as-is) + +If PROPS is a symbol: +- First checks `tp-layer-alist' and returns the layer properties +- Then checks `tp-layer-groups' and returns the first layer's properties + +Unlike `tp-layer-props', this does NOT add the `tp-name' property, +making it suitable for use with basic property-setting APIs like +`tp-set', `tp-add', `tp-match-set', etc." + (cond + ;; Already a plist - return as-is + ((listp props) props) + ;; Symbol - check if it's a layer or group name + ((symbolp props) + (cond + ;; Check layer first + ((assoc props tp-layer-alist) + (cdr (assoc props tp-layer-alist))) + ;; Check group (use first layer's properties) + ((assoc props tp-layer-groups) + (when-let* ((layers (cdr (assoc props tp-layer-groups))) + (first-layer (car layers))) + (cdr (assoc first-layer tp-layer-alist)))) + ;; Not found - return nil (let caller decide how to handle) + (t nil))) + (t nil))) + (defun tp-layer-reset () "Reset all layer definitions. Clears both `tp-layer-alist' and `tp-layer-groups'.