Refine string modification behavior: region form modifies in-place, entire string form creates copy
Updated the implementation to clearly distinguish: - (tp-set/add/reset START END PROPS STRING): Modifies original string in-place - (tp-set/add/reset "string" PROP VAL ...): Creates NEW string using propertize Also fixed code review issues: - Removed unused 'offset' variable - Made tp--remove-nested-keys non-destructive Updated documentation with detailed behavior table and examples. Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
parent
70f60f1a25
commit
98f807993a
124
README.md
124
README.md
@ -425,26 +425,49 @@ A complete overview of all tp.el functions organized by category:
|
|||||||
|
|
||||||
### Core Property Functions
|
### Core Property Functions
|
||||||
|
|
||||||
|
> **Important: String Modification Behavior**
|
||||||
|
>
|
||||||
|
> The core property functions (`tp-set`, `tp-reset`, `tp-add`, `tp-remove`) have different behaviors depending on the calling convention:
|
||||||
|
>
|
||||||
|
> | Calling Convention | Underlying Implementation | Modifies Original? |
|
||||||
|
> |-------------------|---------------------------|-------------------|
|
||||||
|
> | `(tp-set STRING PROP VAL ...)` | Uses `propertize` internally | **No** - Returns a NEW string |
|
||||||
|
> | `(tp-set START END PROPS)` | Uses `put-text-property` on buffer | Yes - Modifies current buffer |
|
||||||
|
> | `(tp-set START END PROPS STRING)` | Uses `put-text-property` on string | **Yes** - Modifies original string |
|
||||||
|
> | `(tp-set START END PROPS BUFFER)` | Uses `put-text-property` on buffer | Yes - Modifies the buffer |
|
||||||
|
>
|
||||||
|
> **Summary:**
|
||||||
|
> - **Entire string form** `(tp-set "string" ...)`: Creates a **new** propertized string. The original string is not modified. This uses `propertize` internally.
|
||||||
|
> - **Region form with string object** `(tp-set 0 5 '(...) string)`: **Directly modifies** the original string object using `put-text-property` or `set-text-properties`.
|
||||||
|
> - **Buffer forms**: Always modify the buffer in-place.
|
||||||
|
>
|
||||||
|
> This distinction applies to all core property functions: `tp-set`, `tp-reset`, `tp-add`, and `tp-remove`.
|
||||||
|
|
||||||
#### `tp-set` - Set Text Properties
|
#### `tp-set` - Set Text Properties
|
||||||
|
|
||||||
Set text properties on a string or buffer region. Replaces only the specified properties, preserving others.
|
Set text properties on a string or buffer region. Replaces only the specified properties, preserving others.
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
;; Current buffer (properties as a list)
|
;; Current buffer (properties as a list) - modifies buffer in-place
|
||||||
(tp-set START END '(PROPERTY VALUE ...))
|
(tp-set START END '(PROPERTY VALUE ...))
|
||||||
(tp-set START END LAYER-NAME)
|
(tp-set START END LAYER-NAME)
|
||||||
|
|
||||||
;; Specific buffer or string
|
;; Specific buffer or string - modifies OBJECT in-place
|
||||||
(tp-set START END '(PROPERTY VALUE ...) OBJECT)
|
(tp-set START END '(PROPERTY VALUE ...) OBJECT)
|
||||||
(tp-set START END LAYER-NAME OBJECT)
|
(tp-set START END LAYER-NAME OBJECT)
|
||||||
|
|
||||||
;; Entire string (flat properties or layer name)
|
;; Entire string (flat properties or layer name) - returns NEW string
|
||||||
(tp-set STRING PROPERTY VALUE ...)
|
(tp-set STRING PROPERTY VALUE ...)
|
||||||
(tp-set STRING LAYER-NAME)
|
(tp-set STRING LAYER-NAME)
|
||||||
```
|
```
|
||||||
|
|
||||||
LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a group defined by `define-tps`.
|
LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a group defined by `define-tps`.
|
||||||
|
|
||||||
|
**Return Values:**
|
||||||
|
- Buffer forms: Returns `(START . END)` cons cell
|
||||||
|
- String region form `(tp-set 0 5 '(...) string)`: Returns the modified string (same object)
|
||||||
|
- Entire string form `(tp-set "string" ...)`: Returns a **new** propertized string
|
||||||
|
|
||||||
**Examples:**
|
**Examples:**
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
@ -476,14 +499,21 @@ LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a grou
|
|||||||
(kill-buffer my-buffer))
|
(kill-buffer my-buffer))
|
||||||
;; => (1 . 10)
|
;; => (1 . 10)
|
||||||
|
|
||||||
;; Set properties on a string (0-indexed)
|
;; Set properties on a string region (0-indexed) - MODIFIES original string
|
||||||
(let ((my-string (tp-set 0 5 '(face italic) "Hello World")))
|
(let ((my-string (copy-sequence "Hello World")))
|
||||||
|
(tp-set 0 5 '(face italic) my-string)
|
||||||
my-string)
|
my-string)
|
||||||
;; => #("Hello World" 0 5 (face italic))
|
;; => #("Hello World" 0 5 (face italic))
|
||||||
|
|
||||||
;; Set properties on entire string
|
;; Set properties on entire string - returns NEW string, original unchanged
|
||||||
(tp-set "Hello" 'face 'bold 'mouse-face 'highlight)
|
(let ((original "Hello"))
|
||||||
;; => #("Hello" 0 5 (face bold mouse-face highlight))
|
(let ((result (tp-set original 'face 'bold)))
|
||||||
|
(list :original original
|
||||||
|
:result result
|
||||||
|
:original-has-props (get-text-property 0 'face original)
|
||||||
|
:result-has-props (get-text-property 0 'face result))))
|
||||||
|
;; => (:original "Hello" :result #("Hello" 0 5 (face bold))
|
||||||
|
;; :original-has-props nil :result-has-props bold)
|
||||||
|
|
||||||
;; Use a defined layer name on entire string
|
;; Use a defined layer name on entire string
|
||||||
(define-tp my-style ()
|
(define-tp my-style ()
|
||||||
@ -519,13 +549,21 @@ LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a grou
|
|||||||
Completely replace ALL text properties with the specified ones.
|
Completely replace ALL text properties with the specified ones.
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
|
;; Buffer/region forms - modifies in-place
|
||||||
(tp-reset START END '(PROPERTY VALUE ...) &optional OBJECT)
|
(tp-reset START END '(PROPERTY VALUE ...) &optional OBJECT)
|
||||||
(tp-reset START END LAYER-NAME &optional OBJECT)
|
(tp-reset START END LAYER-NAME &optional OBJECT)
|
||||||
|
|
||||||
|
;; Entire string form - returns NEW string
|
||||||
(tp-reset STRING PROPERTY VALUE ...)
|
(tp-reset STRING PROPERTY VALUE ...)
|
||||||
```
|
```
|
||||||
|
|
||||||
LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a group defined by `define-tps`.
|
LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a group defined by `define-tps`.
|
||||||
|
|
||||||
|
**Return Values:**
|
||||||
|
- Buffer forms: Returns `(START . END)` cons cell
|
||||||
|
- String region form: Returns the modified string (same object)
|
||||||
|
- Entire string form: Returns a **new** propertized string
|
||||||
|
|
||||||
**Examples:**
|
**Examples:**
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
@ -537,9 +575,12 @@ LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a grou
|
|||||||
(tp-at 1))
|
(tp-at 1))
|
||||||
;; => (face bold) ; help-echo is gone
|
;; => (face bold) ; help-echo is gone
|
||||||
|
|
||||||
;; On string
|
;; On entire string - returns NEW string, original unchanged
|
||||||
(tp-reset "Hello" 'face 'italic)
|
(let ((original "Hello"))
|
||||||
;; => #("Hello" 0 5 (face italic))
|
(let ((result (tp-reset original 'face 'italic)))
|
||||||
|
(list :original-modified (get-text-property 0 'face original)
|
||||||
|
:result-face (get-text-property 0 'face result))))
|
||||||
|
;; => (:original-modified nil :result-face italic)
|
||||||
|
|
||||||
;; Use a defined layer name
|
;; Use a defined layer name
|
||||||
(define-tp error-style ()
|
(define-tp error-style ()
|
||||||
@ -557,13 +598,21 @@ LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a grou
|
|||||||
Add or update properties with deep merge support for nested plists.
|
Add or update properties with deep merge support for nested plists.
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
|
;; Buffer/region forms - modifies in-place
|
||||||
(tp-add START END '(PROPERTY VALUE ...) &optional OBJECT)
|
(tp-add START END '(PROPERTY VALUE ...) &optional OBJECT)
|
||||||
(tp-add START END LAYER-NAME &optional OBJECT)
|
(tp-add START END LAYER-NAME &optional OBJECT)
|
||||||
|
|
||||||
|
;; Entire string form - returns NEW string
|
||||||
(tp-add STRING PROPERTY VALUE ...)
|
(tp-add STRING PROPERTY VALUE ...)
|
||||||
```
|
```
|
||||||
|
|
||||||
LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a group defined by `define-tps`.
|
LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a group defined by `define-tps`.
|
||||||
|
|
||||||
|
**Return Values:**
|
||||||
|
- Buffer forms: Returns `(START . END)` cons cell
|
||||||
|
- String region form: Returns the modified string (same object)
|
||||||
|
- Entire string form: Returns a **new** propertized string
|
||||||
|
|
||||||
**Examples:**
|
**Examples:**
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
@ -583,11 +632,12 @@ LAYER-NAME can be a symbol representing a layer defined by `define-tp` or a grou
|
|||||||
(tp-at 1 'face))
|
(tp-at 1 'face))
|
||||||
;; => (:foreground "red" :background "blue")
|
;; => (:foreground "red" :background "blue")
|
||||||
|
|
||||||
;; Face prepending - symbol faces are prepended to face list
|
;; Entire string form - returns NEW string, original unchanged
|
||||||
(let ((str (tp-set "Hello" 'face 'bold)))
|
(let ((original "Hello"))
|
||||||
(tp-add str 'face 'shadow)
|
(let ((result (tp-add original 'face 'bold)))
|
||||||
(tp-at 0 'face str))
|
(list :original-modified (get-text-property 0 'face original)
|
||||||
;; => (shadow bold)
|
:result-face (get-text-property 0 'face result))))
|
||||||
|
;; => (:original-modified nil :result-face bold)
|
||||||
|
|
||||||
;; Use a defined layer name
|
;; Use a defined layer name
|
||||||
(define-tp highlight-style ()
|
(define-tp highlight-style ()
|
||||||
@ -761,21 +811,25 @@ For single-position property queries (previously done with `tp-get`), use `tp-at
|
|||||||
Remove a property or nested sub-property from a region or entire string.
|
Remove a property or nested sub-property from a region or entire string.
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
;; Remove entire property (buffer)
|
;; Remove entire property (buffer) - modifies in-place
|
||||||
(tp-remove START END PROPERTY &optional OBJECT)
|
(tp-remove START END PROPERTY &optional OBJECT)
|
||||||
|
|
||||||
;; Remove sub-property (buffer)
|
;; Remove sub-property (buffer) - modifies in-place
|
||||||
(tp-remove START END '(PROPERTY SUB-KEY) &optional OBJECT)
|
(tp-remove START END '(PROPERTY SUB-KEY) &optional OBJECT)
|
||||||
|
|
||||||
;; Remove nested sub-properties (buffer)
|
;; Remove nested sub-properties (buffer) - modifies in-place
|
||||||
(tp-remove START END '(PROPERTY SUB-KEY (NESTED-KEYS...)) &optional OBJECT)
|
(tp-remove START END '(PROPERTY SUB-KEY (NESTED-KEYS...)) &optional OBJECT)
|
||||||
|
|
||||||
;; Remove from entire string
|
;; Remove from entire string - returns NEW string
|
||||||
(tp-remove STRING PROP1 PROP2 ...)
|
(tp-remove STRING PROP1 PROP2 ...)
|
||||||
(tp-remove STRING PROPERTY SUB-KEY)
|
(tp-remove STRING PROPERTY SUB-KEY)
|
||||||
(tp-remove STRING PROPERTY SUB-KEY '(NESTED-KEYS...))
|
(tp-remove STRING PROPERTY SUB-KEY '(NESTED-KEYS...))
|
||||||
```
|
```
|
||||||
|
|
||||||
|
**Return Values:**
|
||||||
|
- Buffer forms: Returns `nil`
|
||||||
|
- Entire string forms: Returns a **new** string with properties removed
|
||||||
|
|
||||||
**Examples:**
|
**Examples:**
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
@ -803,24 +857,24 @@ Remove a property or nested sub-property from a region or entire string.
|
|||||||
(tp-at 1 '(face :underline)))
|
(tp-at 1 '(face :underline)))
|
||||||
;; => (:color "blue") ; :style and :position removed, :color preserved
|
;; => (:color "blue") ; :style and :position removed, :color preserved
|
||||||
|
|
||||||
;; Remove from entire string - multiple properties
|
;; Remove from entire string - returns NEW string, original unchanged
|
||||||
(let ((str (tp-set "Hello World" 'face 'bold 'help-echo "tip")))
|
(let ((original (propertize "Hello" 'face 'bold 'help-echo "tip")))
|
||||||
(tp-remove str 'face 'help-echo)
|
(let ((result (tp-remove original 'face)))
|
||||||
(tp-at 0 str))
|
(list :original-face (get-text-property 0 'face original)
|
||||||
;; => nil
|
:result-face (get-text-property 0 'face result))))
|
||||||
|
;; => (:original-face bold :result-face nil)
|
||||||
|
|
||||||
;; Remove sub-property from string
|
;; Remove sub-property from string - returns NEW string
|
||||||
(let ((str (copy-sequence "Hello World")))
|
(let ((original (propertize "Hello" 'face '(:foreground "red" :underline t))))
|
||||||
(tp-set 0 11 '(face (:foreground "red" :underline t)) str)
|
(let ((result (tp-remove original 'face :underline)))
|
||||||
(tp-remove str 'face :underline)
|
(list :original (get-text-property 0 'face original)
|
||||||
(tp-at 0 'face str))
|
:result (get-text-property 0 'face result))))
|
||||||
;; => (:foreground "red")
|
;; => (:original (:foreground "red" :underline t) :result (:foreground "red"))
|
||||||
|
|
||||||
;; Remove nested keys from string
|
;; Remove nested keys from string
|
||||||
(let ((str (copy-sequence "Hello World")))
|
(let ((original (propertize "Hello" 'face '(:underline (:style wave :color "blue")))))
|
||||||
(tp-set 0 11 '(face (:underline (:style wave :color "blue"))) str)
|
(let ((result (tp-remove original 'face :underline '(:style))))
|
||||||
(tp-remove str 'face :underline '(:style))
|
(get-text-property 0 '(face :underline) result)))
|
||||||
(tp-at 0 '(face :underline) str))
|
|
||||||
;; => (:color "blue")
|
;; => (:color "blue")
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|||||||
17
tp-tests.el
17
tp-tests.el
@ -4095,17 +4095,16 @@ Regression test for: (tp-set \"emacs\" 'face nil) erroring with
|
|||||||
;; Strings should not be eq (different objects)
|
;; Strings should not be eq (different objects)
|
||||||
(should (not (eq original result))))))
|
(should (not (eq original result))))))
|
||||||
|
|
||||||
(ert-deftest tp-test-set-region-does-not-modify-original-string ()
|
(ert-deftest tp-test-set-region-modifies-original-string ()
|
||||||
"Test that tp-set with region returns a new string and does not modify the original."
|
"Test that tp-set with region form DOES modify the original string.
|
||||||
(let ((original "Hello World"))
|
The region form (tp-set START END PROPS STRING) modifies the string in-place."
|
||||||
|
(let ((original (copy-sequence "Hello World")))
|
||||||
(let ((result (tp-set 0 5 '(face bold) original)))
|
(let ((result (tp-set 0 5 '(face bold) original)))
|
||||||
;; Result should be a new string with properties on the region
|
;; Result should be the same object as original (modified in-place)
|
||||||
(should (stringp result))
|
(should (eq result original))
|
||||||
|
;; Both should have the face property
|
||||||
(should (eq (get-text-property 0 'face result) 'bold))
|
(should (eq (get-text-property 0 'face result) 'bold))
|
||||||
;; Original should NOT be modified (no properties)
|
(should (eq (get-text-property 0 'face original) 'bold)))))
|
||||||
(should (null (get-text-property 0 'face original)))
|
|
||||||
;; Strings should not be eq (different objects)
|
|
||||||
(should (not (eq original result))))))
|
|
||||||
|
|
||||||
(ert-deftest tp-test-match-set-does-not-modify-original-string ()
|
(ert-deftest tp-test-match-set-does-not-modify-original-string ()
|
||||||
"Test that tp-match-set returns a new string and does not modify the original."
|
"Test that tp-match-set returns a new string and does not modify the original."
|
||||||
|
|||||||
127
tp.el
127
tp.el
@ -1305,8 +1305,16 @@ PROPS can be a plist or a layer/group name symbol.
|
|||||||
Preserves existing properties not specified in PROPS.
|
Preserves existing properties not specified in PROPS.
|
||||||
For tp-text, props override embedded text properties.
|
For tp-text, props override embedded text properties.
|
||||||
|
|
||||||
For strings, returns a NEW propertized string (original is not modified).
|
**String Modification Behavior:**
|
||||||
For buffers, returns (START . END) cons."
|
- Entire string form (tp-set STRING ...): Returns a NEW propertized string
|
||||||
|
(original is not modified). Uses `propertize' internally.
|
||||||
|
- Region form with string (tp-set START END PROPS STRING): Modifies the
|
||||||
|
original string in-place using `put-text-property'.
|
||||||
|
- Buffer forms: Always modify in-place.
|
||||||
|
|
||||||
|
Returns: For buffers, (START . END) cons. For strings, the result string."
|
||||||
|
;; Determine if this is the "entire string" form (first arg is a string)
|
||||||
|
(let ((entire-string-form (stringp start-or-string)))
|
||||||
(pcase-let ((`(,object ,start ,finish ,props)
|
(pcase-let ((`(,object ,start ,finish ,props)
|
||||||
(tp--parse-args start-or-string end-or-prop props-or-val rest)))
|
(tp--parse-args start-or-string end-or-prop props-or-val rest)))
|
||||||
;; Handle tp-text property specially - :override means props override embedded props
|
;; Handle tp-text property specially - :override means props override embedded props
|
||||||
@ -1315,25 +1323,44 @@ For buffers, returns (START . END) cons."
|
|||||||
(setq props new-props finish new-finish object new-object)
|
(setq props new-props finish new-finish object new-object)
|
||||||
(when (and (stringp object) (plist-member props 'tp-text))
|
(when (and (stringp object) (plist-member props 'tp-text))
|
||||||
(setq start 0)))
|
(setq start 0)))
|
||||||
(if (stringp object)
|
(cond
|
||||||
;; For strings: create a new propertized string (non-destructive)
|
;; Entire string form: create a new propertized string (non-destructive)
|
||||||
(tp--apply-props-to-string object start finish props nil)
|
((and (stringp object) entire-string-form)
|
||||||
;; For buffers: modify in place (standard behavior)
|
(tp--apply-props-to-string object start finish props nil))
|
||||||
|
;; Region form with string object: modify in-place
|
||||||
|
((stringp object)
|
||||||
(let ((has-existing-props (text-properties-at start object)))
|
(let ((has-existing-props (text-properties-at start object)))
|
||||||
(if (and (not has-existing-props)
|
(if (and (not has-existing-props)
|
||||||
(= start (or (next-single-property-change start nil object finish) finish)))
|
(= start (or (next-single-property-change start nil object finish) finish)))
|
||||||
(set-text-properties start finish props object)
|
(set-text-properties start finish props object)
|
||||||
(cl-loop for (key val) on props by #'cddr
|
(cl-loop for (key val) on props by #'cddr
|
||||||
do (put-text-property start finish key val object))))
|
do (put-text-property start finish key val object))))
|
||||||
(cons start finish))))
|
object)
|
||||||
|
;; Buffer: modify in place
|
||||||
|
(t
|
||||||
|
(let ((has-existing-props (text-properties-at start object)))
|
||||||
|
(if (and (not has-existing-props)
|
||||||
|
(= start (or (next-single-property-change start nil object finish) finish)))
|
||||||
|
(set-text-properties start finish props object)
|
||||||
|
(cl-loop for (key val) on props by #'cddr
|
||||||
|
do (put-text-property start finish key val object))))
|
||||||
|
(cons start finish))))))
|
||||||
|
|
||||||
(defun tp-reset (start-or-string &optional end-or-prop props-or-val &rest rest)
|
(defun tp-reset (start-or-string &optional end-or-prop props-or-val &rest rest)
|
||||||
"Completely replace all text properties with PROPS.
|
"Completely replace all text properties with PROPS.
|
||||||
Like `tp-set' but replaces ALL existing properties.
|
Like `tp-set' but replaces ALL existing properties.
|
||||||
For tp-text, embedded text properties are ignored - only props are used.
|
For tp-text, embedded text properties are ignored - only props are used.
|
||||||
|
|
||||||
For strings, returns a NEW propertized string (original is not modified).
|
**String Modification Behavior:**
|
||||||
For buffers, returns (START . END) cons."
|
- Entire string form (tp-reset STRING ...): Returns a NEW propertized string
|
||||||
|
(original is not modified). Uses `propertize' internally.
|
||||||
|
- Region form with string (tp-reset START END PROPS STRING): Modifies the
|
||||||
|
original string in-place using `set-text-properties'.
|
||||||
|
- Buffer forms: Always modify in-place.
|
||||||
|
|
||||||
|
Returns: For buffers, (START . END) cons. For strings, the result string."
|
||||||
|
;; Determine if this is the "entire string" form (first arg is a string)
|
||||||
|
(let ((entire-string-form (stringp start-or-string)))
|
||||||
(pcase-let ((`(,object ,start ,finish ,props)
|
(pcase-let ((`(,object ,start ,finish ,props)
|
||||||
(tp--parse-args start-or-string end-or-prop props-or-val rest)))
|
(tp--parse-args start-or-string end-or-prop props-or-val rest)))
|
||||||
;; Handle tp-text property - :reset means only use props, ignore embedded props
|
;; Handle tp-text property - :reset means only use props, ignore embedded props
|
||||||
@ -1342,12 +1369,18 @@ For buffers, returns (START . END) cons."
|
|||||||
(setq props new-props finish new-finish object new-object)
|
(setq props new-props finish new-finish object new-object)
|
||||||
(when (and (stringp object) (plist-member props 'tp-text))
|
(when (and (stringp object) (plist-member props 'tp-text))
|
||||||
(setq start 0)))
|
(setq start 0)))
|
||||||
(if (stringp object)
|
(cond
|
||||||
;; For strings: create a new propertized string (non-destructive)
|
;; Entire string form: create a new propertized string (non-destructive)
|
||||||
(tp--apply-props-to-string object start finish props :reset)
|
((and (stringp object) entire-string-form)
|
||||||
;; For buffers: modify in place (standard behavior)
|
(tp--apply-props-to-string object start finish props :reset))
|
||||||
|
;; Region form with string object: modify in-place
|
||||||
|
((stringp object)
|
||||||
(set-text-properties start finish props object)
|
(set-text-properties start finish props object)
|
||||||
(cons start finish))))
|
object)
|
||||||
|
;; Buffer: modify in place
|
||||||
|
(t
|
||||||
|
(set-text-properties start finish props object)
|
||||||
|
(cons start finish))))))
|
||||||
|
|
||||||
(defun tp--prepend-face (new-face existing-face)
|
(defun tp--prepend-face (new-face existing-face)
|
||||||
"Prepend NEW-FACE to EXISTING-FACE for the face property.
|
"Prepend NEW-FACE to EXISTING-FACE for the face property.
|
||||||
@ -1438,8 +1471,16 @@ Unlike `tp-set', deeply merges nested properties.
|
|||||||
For `face' property, symbol faces are prepended to existing face list.
|
For `face' property, symbol faces are prepended to existing face list.
|
||||||
For tp-text, embedded text properties are merged with props.
|
For tp-text, embedded text properties are merged with props.
|
||||||
|
|
||||||
For strings, returns a NEW propertized string (original is not modified).
|
**String Modification Behavior:**
|
||||||
For buffers, returns (START . END) cons."
|
- Entire string form (tp-add STRING ...): Returns a NEW propertized string
|
||||||
|
(original is not modified). Uses `propertize' internally.
|
||||||
|
- Region form with string (tp-add START END PROPS STRING): Modifies the
|
||||||
|
original string in-place using `put-text-property'.
|
||||||
|
- Buffer forms: Always modify in-place.
|
||||||
|
|
||||||
|
Returns: For buffers, (START . END) cons. For strings, the result string."
|
||||||
|
;; Determine if this is the "entire string" form (first arg is a string)
|
||||||
|
(let ((entire-string-form (stringp start-or-string)))
|
||||||
(pcase-let ((`(,object ,start ,finish ,props)
|
(pcase-let ((`(,object ,start ,finish ,props)
|
||||||
(tp--parse-args start-or-string end-or-prop props-or-val rest)))
|
(tp--parse-args start-or-string end-or-prop props-or-val rest)))
|
||||||
;; Handle tp-text property - :merge means embedded props are merged with props
|
;; Handle tp-text property - :merge means embedded props are merged with props
|
||||||
@ -1449,14 +1490,16 @@ For buffers, returns (START . END) cons."
|
|||||||
(setq props new-props finish new-finish object new-object)
|
(setq props new-props finish new-finish object new-object)
|
||||||
(when (and (stringp object) has-tp-text)
|
(when (and (stringp object) has-tp-text)
|
||||||
(setq start 0))))
|
(setq start 0))))
|
||||||
(if (stringp object)
|
(cond
|
||||||
;; For strings: create a new propertized string (non-destructive)
|
;; Entire string form: create a new propertized string (non-destructive)
|
||||||
|
((and (stringp object) entire-string-form)
|
||||||
(if (plist-member props 'tp-text)
|
(if (plist-member props 'tp-text)
|
||||||
;; For tp-text, properties are already merged
|
;; For tp-text, properties are already merged
|
||||||
(tp--apply-props-to-string object start finish props :reset)
|
(tp--apply-props-to-string object start finish props :reset)
|
||||||
;; Otherwise use :add mode for deep merging
|
;; Otherwise use :add mode for deep merging
|
||||||
(tp--apply-props-to-string object start finish props :add))
|
(tp--apply-props-to-string object start finish props :add)))
|
||||||
;; For buffers: modify in place with deep merging
|
;; Region form with string object: modify in-place with deep merging
|
||||||
|
((stringp object)
|
||||||
(let ((pos start))
|
(let ((pos start))
|
||||||
(while (< pos finish)
|
(while (< pos finish)
|
||||||
(let* ((current-props (text-properties-at pos object))
|
(let* ((current-props (text-properties-at pos object))
|
||||||
@ -1472,7 +1515,25 @@ For buffers, returns (START . END) cons."
|
|||||||
(t val))))
|
(t val))))
|
||||||
(put-text-property pos next-pos key new-val object)))
|
(put-text-property pos next-pos key new-val object)))
|
||||||
(setq pos next-pos))))
|
(setq pos next-pos))))
|
||||||
(cons start finish))))
|
object)
|
||||||
|
;; Buffer: modify in place with deep merging
|
||||||
|
(t
|
||||||
|
(let ((pos start))
|
||||||
|
(while (< pos finish)
|
||||||
|
(let* ((current-props (text-properties-at pos object))
|
||||||
|
(next-pos (or (next-property-change pos object finish) finish)))
|
||||||
|
(cl-loop
|
||||||
|
for (key val) on props by #'cddr
|
||||||
|
do (let* ((current-val (plist-get current-props key))
|
||||||
|
(new-val (cond
|
||||||
|
((eq key 'face) (tp--prepend-face val current-val))
|
||||||
|
((and (listp val) (keywordp (car-safe val))
|
||||||
|
(listp current-val) (keywordp (car-safe current-val)))
|
||||||
|
(tp--deep-merge-plist current-val val))
|
||||||
|
(t val))))
|
||||||
|
(put-text-property pos next-pos key new-val object)))
|
||||||
|
(setq pos next-pos))))
|
||||||
|
(cons start finish))))))
|
||||||
|
|
||||||
;;;============================================================================
|
;;;============================================================================
|
||||||
;;; Layer 2: Core Property Functions - Get/At
|
;;; Layer 2: Core Property Functions - Get/At
|
||||||
@ -1770,8 +1831,14 @@ This function supports multiple calling conventions:
|
|||||||
(tp-remove STRING PROPERTY SUB-KEY \\='(NESTED-KEYS...))
|
(tp-remove STRING PROPERTY SUB-KEY \\='(NESTED-KEYS...))
|
||||||
(tp-remove \"Hello\" \\='face :underline \\='(:style :position))
|
(tp-remove \"Hello\" \\='face :underline \\='(:style :position))
|
||||||
|
|
||||||
For strings, returns a NEW string with properties removed (original is not modified).
|
**String Modification Behavior:**
|
||||||
For buffers, returns nil."
|
- Entire string form (tp-remove STRING ...): Returns a NEW string with
|
||||||
|
properties removed (original is not modified). Uses `propertize' internally.
|
||||||
|
- Region form with string (tp-remove START END PROP STRING): Modifies the
|
||||||
|
original string in-place using `remove-text-properties'.
|
||||||
|
- Buffer forms: Always modify in-place.
|
||||||
|
|
||||||
|
Returns: For buffers, nil. For entire string forms, a new string."
|
||||||
(cond
|
(cond
|
||||||
;; First arg is a string - apply to entire string, non-destructively
|
;; First arg is a string - apply to entire string, non-destructively
|
||||||
((stringp start-or-string)
|
((stringp start-or-string)
|
||||||
@ -1916,7 +1983,7 @@ Returns a new string (original is not modified)."
|
|||||||
|
|
||||||
(defun tp--remove-nested-keys (plist sub-key nested-keys)
|
(defun tp--remove-nested-keys (plist sub-key nested-keys)
|
||||||
"Remove NESTED-KEYS from the SUB-KEY value within PLIST.
|
"Remove NESTED-KEYS from the SUB-KEY value within PLIST.
|
||||||
Returns the modified plist."
|
Returns a new plist (does not modify the original)."
|
||||||
(let* ((sub-value (plist-get plist sub-key))
|
(let* ((sub-value (plist-get plist sub-key))
|
||||||
(keys-to-remove (if (listp nested-keys) nested-keys (list nested-keys)))
|
(keys-to-remove (if (listp nested-keys) nested-keys (list nested-keys)))
|
||||||
(new-sub-value (when (and sub-value (listp sub-value))
|
(new-sub-value (when (and sub-value (listp sub-value))
|
||||||
@ -1926,7 +1993,14 @@ Returns the modified plist."
|
|||||||
do (setq result (plist-put result k v)))
|
do (setq result (plist-put result k v)))
|
||||||
result))))
|
result))))
|
||||||
(if new-sub-value
|
(if new-sub-value
|
||||||
(plist-put plist sub-key new-sub-value)
|
;; Build a new plist with the updated sub-value
|
||||||
|
(let ((result nil))
|
||||||
|
(cl-loop for (k v) on plist by #'cddr
|
||||||
|
do (setq result (plist-put result k
|
||||||
|
(if (eq k sub-key)
|
||||||
|
new-sub-value
|
||||||
|
v))))
|
||||||
|
result)
|
||||||
;; Remove the sub-key entirely if no value left
|
;; Remove the sub-key entirely if no value left
|
||||||
(let ((result nil))
|
(let ((result nil))
|
||||||
(cl-loop for (k v) on plist by #'cddr
|
(cl-loop for (k v) on plist by #'cddr
|
||||||
@ -1955,8 +2029,7 @@ For buffers, modifies in-place and returns list of regions."
|
|||||||
;; String object
|
;; String object
|
||||||
((stringp object)
|
((stringp object)
|
||||||
(let ((result object)
|
(let ((result object)
|
||||||
(pos 0)
|
(pos 0))
|
||||||
(offset 0)) ; Track offset for position changes (though properties shouldn't change length)
|
|
||||||
(while (string-match (regexp-quote pattern) result pos)
|
(while (string-match (regexp-quote pattern) result pos)
|
||||||
(let ((beg (match-beginning 0))
|
(let ((beg (match-beginning 0))
|
||||||
(end (match-end 0)))
|
(end (match-end 0)))
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user