diff --git a/README.md b/README.md index 22eafcb..80354da 100644 --- a/README.md +++ b/README.md @@ -57,27 +57,50 @@ Or with `use-package`: ### Setting Properties ```elisp -;; On current buffer -(tp-put 1 10 'face 'bold 'help-echo "Hello!") +;; On current buffer (properties as a list) +(tp-put 1 10 '(face bold help-echo "Hello!")) -;; On a string -(tp-put "Hello World" 0 5 'face 'bold) +;; On a specific buffer +(tp-put 1 10 '(face bold) some-buffer) + +;; On a string with range (0-indexed) +(tp-put 0 5 '(face bold) "Hello World") ;; => #("Hello World" 0 5 (face bold)) -;; Using a property list -(tp-put 1 10 '(face bold help-echo "test")) +;; On entire string (flat properties) +(tp-put "Hello World" 'face 'bold 'help-echo "test") +;; => #("Hello World" 0 11 (face bold help-echo "test")) ``` ### Getting Properties ```elisp -;; Get specific property +;; Get specific property at position (tp-get 5 'face) ; => bold +;; Get specific property from range +(tp-get 1 10 'face) ; => bold + +;; Get all properties from range +(tp-get 1 10) ; => (face bold help-echo "Hello!") + ;; Get all properties at point (tp-at 5) ; => (face bold help-echo "Hello!") ``` +### Fine-grained Property Manipulation + +```elisp +;; Get sub-property from face +(tp-get-sub 1 'face :foreground) ; => "red" + +;; Set sub-property on face +(tp-put-sub 1 6 'face :foreground "blue") + +;; Remove sub-property from face +(tp-remove-sub 1 6 'face :foreground) +``` + ### Pattern Matching ```elisp @@ -103,47 +126,101 @@ Or with `use-package`: Set text properties on a string or buffer region. ```elisp -;; Buffer (current buffer) -(tp-put START END PROPERTY VALUE ...) +;; Current buffer (properties as a list) (tp-put START END '(PROPERTY VALUE ...)) -;; String or Buffer object -(tp-put OBJECT START END PROPERTY VALUE ...) -(tp-put OBJECT START END '(PROPERTY VALUE ...)) +;; Specific buffer or string +(tp-put START END '(PROPERTY VALUE ...) OBJECT) + +;; Entire string (flat properties) +(tp-put STRING PROPERTY VALUE ...) ``` **Examples:** ```elisp ;; Set face on buffer region -(tp-put 1 10 'face 'bold) ; => (1 . 10) +(tp-put 1 10 '(face bold)) ; => (1 . 10) ;; Set multiple properties -(tp-put 1 10 'face 'bold 'help-echo "Click me") +(tp-put 1 10 '(face bold help-echo "Click me")) -;; Set properties on a string -(setq my-string (tp-put "Hello World" 0 5 'face 'italic)) +;; Set on specific buffer +(tp-put 1 10 '(face italic) my-buffer) + +;; Set properties on a string (0-indexed) +(setq my-string (tp-put 0 5 '(face italic) "Hello World")) ;; => #("Hello World" 0 5 (face italic)) -;; Properties as a list -(tp-put 1 10 '(face bold mouse-face highlight)) +;; Set properties on entire string +(tp-put "Hello" 'face 'bold 'mouse-face 'highlight) +;; => #("Hello" 0 5 (face bold mouse-face highlight)) ``` --- #### `tp-get` - Get Property Value -```elisp -(tp-get POSITION PROPERTY &optional OBJECT) -``` +Get property value(s) from position or range. -Get the value of PROPERTY at POSITION. +```elisp +;; Single position +(tp-get POSITION PROPERTY) +(tp-get POSITION PROPERTY OBJECT) + +;; Range - specific property +(tp-get START END PROPERTY) +(tp-get START END PROPERTY OBJECT) + +;; Range - all properties +(tp-get START END) +(tp-get START END OBJECT) +``` **Examples:** ```elisp -(tp-get 5 'face) ; Get from current buffer -(tp-get 0 'face my-string) ; Get from string +;; Get from current buffer +(tp-get 5 'face) ; => bold + +;; Get from string (0-indexed) +(tp-get 0 'face my-string) ; => italic + +;; Get from range +(tp-get 1 10 'face) ; => bold + +;; Get all properties from range +(tp-get 1 10) ; => (face bold help-echo "test") +``` + +--- + +#### Fine-grained Property Functions + +For manipulating sub-properties within complex properties like `face` or `display`: + +```elisp +;; Get sub-property +(tp-get-sub POSITION PROPERTY SUB-PROPERTY &optional OBJECT) + +;; Set sub-property +(tp-put-sub START END PROPERTY SUB-PROPERTY VALUE &optional OBJECT) + +;; Remove sub-property +(tp-remove-sub START END PROPERTY SUB-PROPERTY &optional OBJECT) +``` + +**Examples:** + +```elisp +;; Get :foreground from face +(tp-get-sub 1 'face :foreground) ; => "red" + +;; Set :weight on face +(tp-put-sub 1 6 'face :weight 'bold) + +;; Remove :background from face +(tp-remove-sub 1 6 'face :background) ``` --- diff --git a/README_CN.md b/README_CN.md index d14f62a..fb10d18 100644 --- a/README_CN.md +++ b/README_CN.md @@ -56,27 +56,50 @@ ### 设置属性 ```elisp -;; 在当前缓冲区 -(tp-put 1 10 'face 'bold 'help-echo "Hello!") +;; 在当前缓冲区（属性作为列表） +(tp-put 1 10 '(face bold help-echo "Hello!")) -;; 在字符串上 -(tp-put "Hello World" 0 5 'face 'bold) +;; 在特定缓冲区 +(tp-put 1 10 '(face bold) some-buffer) + +;; 在字符串上（0 索引） +(tp-put 0 5 '(face bold) "Hello World") ;; => #("Hello World" 0 5 (face bold)) -;; 使用属性列表 -(tp-put 1 10 '(face bold help-echo "test")) +;; 在整个字符串上（平铺属性） +(tp-put "Hello World" 'face 'bold 'help-echo "test") +;; => #("Hello World" 0 11 (face bold help-echo "test")) ``` ### 获取属性 ```elisp -;; 获取特定属性 +;; 获取特定位置的属性 (tp-get 5 'face) ; => bold +;; 获取范围内的特定属性 +(tp-get 1 10 'face) ; => bold + +;; 获取范围内的所有属性 +(tp-get 1 10) ; => (face bold help-echo "Hello!") + ;; 获取该位置的所有属性 (tp-at 5) ; => (face bold help-echo "Hello!") ``` +### 细粒度属性操作 + +```elisp +;; 获取 face 的子属性 +(tp-get-sub 1 'face :foreground) ; => "red" + +;; 设置 face 的子属性 +(tp-put-sub 1 6 'face :foreground "blue") + +;; 移除 face 的子属性 +(tp-remove-sub 1 6 'face :foreground) +``` + ### 模式匹配 ```elisp @@ -102,47 +125,101 @@ 在字符串或缓冲区区域上设置文本属性。 ```elisp -;; 缓冲区（当前缓冲区） -(tp-put START END PROPERTY VALUE ...) +;; 当前缓冲区（属性作为列表） (tp-put START END '(PROPERTY VALUE ...)) -;; 字符串或缓冲区对象 -(tp-put OBJECT START END PROPERTY VALUE ...) -(tp-put OBJECT START END '(PROPERTY VALUE ...)) +;; 特定缓冲区或字符串 +(tp-put START END '(PROPERTY VALUE ...) OBJECT) + +;; 整个字符串（平铺属性） +(tp-put STRING PROPERTY VALUE ...) ``` **示例：** ```elisp ;; 在缓冲区区域设置 face -(tp-put 1 10 'face 'bold) ; => (1 . 10) +(tp-put 1 10 '(face bold)) ; => (1 . 10) ;; 设置多个属性 -(tp-put 1 10 'face 'bold 'help-echo "Click me") +(tp-put 1 10 '(face bold help-echo "Click me")) -;; 在字符串上设置属性 -(setq my-string (tp-put "Hello World" 0 5 'face 'italic)) +;; 在特定缓冲区设置 +(tp-put 1 10 '(face italic) my-buffer) + +;; 在字符串上设置属性（0 索引） +(setq my-string (tp-put 0 5 '(face italic) "Hello World")) ;; => #("Hello World" 0 5 (face italic)) -;; 属性作为列表 -(tp-put 1 10 '(face bold mouse-face highlight)) +;; 在整个字符串上设置属性 +(tp-put "Hello" 'face 'bold 'mouse-face 'highlight) +;; => #("Hello" 0 5 (face bold mouse-face highlight)) ``` --- #### `tp-get` - 获取属性值 -```elisp -(tp-get POSITION PROPERTY &optional OBJECT) -``` +从位置或范围获取属性值。 -获取 POSITION 位置的 PROPERTY 值。 +```elisp +;; 单个位置 +(tp-get POSITION PROPERTY) +(tp-get POSITION PROPERTY OBJECT) + +;; 范围 - 特定属性 +(tp-get START END PROPERTY) +(tp-get START END PROPERTY OBJECT) + +;; 范围 - 所有属性 +(tp-get START END) +(tp-get START END OBJECT) +``` **示例：** ```elisp -(tp-get 5 'face) ; 从当前缓冲区获取 -(tp-get 0 'face my-string) ; 从字符串获取 +;; 从当前缓冲区获取 +(tp-get 5 'face) ; => bold + +;; 从字符串获取（0 索引） +(tp-get 0 'face my-string) ; => italic + +;; 从范围获取 +(tp-get 1 10 'face) ; => bold + +;; 获取范围内的所有属性 +(tp-get 1 10) ; => (face bold help-echo "test") +``` + +--- + +#### 细粒度属性函数 + +用于操作复杂属性（如 `face` 或 `display`）内的子属性： + +```elisp +;; 获取子属性 +(tp-get-sub POSITION PROPERTY SUB-PROPERTY &optional OBJECT) + +;; 设置子属性 +(tp-put-sub START END PROPERTY SUB-PROPERTY VALUE &optional OBJECT) + +;; 移除子属性 +(tp-remove-sub START END PROPERTY SUB-PROPERTY &optional OBJECT) +``` + +**示例：** + +```elisp +;; 获取 face 的 :foreground +(tp-get-sub 1 'face :foreground) ; => "red" + +;; 设置 face 的 :weight +(tp-put-sub 1 6 'face :weight 'bold) + +;; 移除 face 的 :background +(tp-remove-sub 1 6 'face :background) ``` --- diff --git a/tp-tests.el b/tp-tests.el index 24523f8..cfc6686 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -754,5 +754,80 @@ (should (stringp result)) (should (eq (get-text-property 0 'face result) 'bold))))) +;;; ============================================================ +;;; Enhanced tp-get Tests +;;; ============================================================ + +(ert-deftest tp-test-get-single-position () + "Test tp-get with single position." + (tp-test-with-temp-buffer + (insert "Hello") + (tp-put 1 6 '(face bold)) + (should (eq (tp-get 1 'face) 'bold)) + (should (eq (tp-get 3 'face) 'bold)))) + +(ert-deftest tp-test-get-range-property () + "Test tp-get with range and specific property." + (tp-test-with-temp-buffer + (insert "Hello World") + (tp-put 1 6 '(face bold)) + (should (eq (tp-get 1 6 'face) 'bold)) + (should (null (tp-get 7 12 'face))))) + +(ert-deftest tp-test-get-range-all-properties () + "Test tp-get with range returns all properties." + (tp-test-with-temp-buffer + (insert "Hello World") + (tp-put 1 6 '(face bold help-echo "test")) + (let ((props (tp-get 1 6))) + (should (eq (plist-get props 'face) 'bold)) + (should (equal (plist-get props 'help-echo) "test"))))) + +(ert-deftest tp-test-get-range-on-string () + "Test tp-get with range on string object." + (let ((str (copy-sequence "Hello World"))) + (tp-put 0 5 '(face bold) str) + (should (eq (tp-get 0 5 'face str) 'bold)) + (should (null (tp-get 6 11 'face str))))) + +;;; ============================================================ +;;; Fine-grained Property Manipulation Tests +;;; ============================================================ + +(ert-deftest tp-test-get-sub-property () + "Test tp-get-sub retrieves sub-property from face." + (tp-test-with-temp-buffer + (insert "Hello") + (put-text-property 1 6 'face '(:foreground "red" :weight bold)) + (should (equal (tp-get-sub 1 'face :foreground) "red")) + (should (eq (tp-get-sub 1 'face :weight) 'bold)) + (should (null (tp-get-sub 1 'face :background))))) + +(ert-deftest tp-test-put-sub-property () + "Test tp-put-sub sets sub-property on face." + (tp-test-with-temp-buffer + (insert "Hello") + (tp-put-sub 1 6 'face :foreground "blue") + (should (equal (tp-get-sub 1 'face :foreground) "blue")) + ;; Add another sub-property + (tp-put-sub 1 6 'face :weight 'bold) + (should (eq (tp-get-sub 1 'face :weight) 'bold)) + (should (equal (tp-get-sub 1 'face :foreground) "blue")))) + +(ert-deftest tp-test-remove-sub-property () + "Test tp-remove-sub removes sub-property from face." + (tp-test-with-temp-buffer + (insert "Hello") + (put-text-property 1 6 'face '(:foreground "red" :weight bold)) + (tp-remove-sub 1 6 'face :foreground) + (should (null (tp-get-sub 1 'face :foreground))) + (should (eq (tp-get-sub 1 'face :weight) 'bold)))) + +(ert-deftest tp-test-sub-property-on-string () + "Test fine-grained property manipulation on strings." + (let ((str (copy-sequence "Hello"))) + (tp-put-sub 0 5 'face :foreground "green" str) + (should (equal (tp-get-sub 0 'face :foreground str) "green")))) + (provide 'tp-ert-tests) ;;; tp-ert-tests.el ends here diff --git a/tp.el b/tp.el index faf2a25..a54d189 100644 --- a/tp.el +++ b/tp.el @@ -163,10 +163,133 @@ Return the modified object (string) or region (START . END) for buffer." (defalias 'tp-set 'tp-put "Alias for `tp-put'.") -(defun tp-get (position property &optional object) - "Get the value of PROPERTY at POSITION in OBJECT. +(defun tp-get (pos-or-start &optional property-or-end &rest args) + "Get text property value(s). + +This function supports multiple calling conventions: + +1. Single position, single property: + (tp-get POSITION PROPERTY) + (tp-get POSITION PROPERTY OBJECT) + +2. Range, single property: + (tp-get START END PROPERTY) + (tp-get START END PROPERTY OBJECT) + +3. Range, all properties (returns plist): + (tp-get START END) + (tp-get START END OBJECT) + +For buffers, positions are 1-indexed. +For strings, positions are 0-indexed. OBJECT defaults to current buffer." - (get-text-property position property object)) + (cond + ;; (tp-get POS PROP) or (tp-get POS PROP OBJECT) - single position + ((and (numberp pos-or-start) + (symbolp property-or-end)) + (let ((object (car args))) + (get-text-property pos-or-start property-or-end object))) + ;; (tp-get START END ...) - range form + ((and (numberp pos-or-start) + (numberp property-or-end)) + (let* ((start pos-or-start) + (end property-or-end) + (property (car args)) + (object (cadr args))) + (if property + ;; Get specific property from range - return first non-nil value + (let ((pos start) + (result nil)) + (while (and (< pos end) (null result)) + (setq result (get-text-property pos property object)) + (setq pos (next-single-property-change pos property object end))) + result) + ;; Get all properties from range - merge into plist + (let ((props nil) + (pos start) + (obj (or object (current-buffer)))) + (while (< pos end) + (let ((current-props (text-properties-at pos obj))) + (cl-loop for (key val) on current-props by #'cddr + do (unless (plist-member props key) + (setq props (plist-put props key val))))) + (setq pos (next-single-property-change pos nil obj end))) + props)))) + (t (error "Invalid arguments to tp-get")))) + +;;; Fine-grained property manipulation for nested properties + +(defun tp-get-sub (position property sub-property &optional object) + "Get SUB-PROPERTY from PROPERTY at POSITION in OBJECT. +For example, get :foreground from a face property. +OBJECT defaults to current buffer." + (let ((prop-value (get-text-property position property object))) + (cond + ;; Property is a plist (e.g., (:foreground \"red\" :weight bold)) + ((and (listp prop-value) (keywordp (car prop-value))) + (plist-get prop-value sub-property)) + ;; Property is an alist + ((and (listp prop-value) (consp (car prop-value))) + (cdr (assoc sub-property prop-value))) + ;; Property is a list of face specs + ((listp prop-value) + (cl-loop for spec in prop-value + when (and (listp spec) (keywordp (car spec))) + thereis (plist-get spec sub-property))) + (t nil)))) + +(defun tp-put-sub (start end property sub-property value &optional object) + "Set SUB-PROPERTY of PROPERTY to VALUE from START to END in OBJECT. +Merges the sub-property into the existing property value. +For example, set :foreground of a face property. +OBJECT defaults to current buffer." + (let* ((pos start)) + (while (< pos end) + (let* ((current-value (get-text-property pos property object)) + (next-pos (or (next-single-property-change pos property object end) end)) + (new-value + (cond + ;; No existing value - create new plist + ((null current-value) + (list sub-property value)) + ;; Existing plist + ((and (listp current-value) (keywordp (car current-value))) + (plist-put (copy-sequence current-value) sub-property value)) + ;; Existing symbol (e.g., 'bold) - convert to list and add + ((symbolp current-value) + (list current-value sub-property value)) + ;; Other list - wrap and add + ((listp current-value) + (append current-value (list sub-property value))) + (t (list sub-property value))))) + (put-text-property pos next-pos property new-value object) + (setq pos next-pos)))) + (if (stringp object) + object + (cons start end))) + +(defun tp-remove-sub (start end property sub-property &optional object) + "Remove SUB-PROPERTY from PROPERTY between START and END in OBJECT. +For example, remove :foreground from a face property. +OBJECT defaults to current buffer." + (let* ((pos start)) + (while (< pos end) + (let* ((current-value (get-text-property pos property object)) + (next-pos (or (next-single-property-change pos property object end) end)) + (new-value + (cond + ;; Plist - remove the sub-property + ((and (listp current-value) (keywordp (car current-value))) + (let ((result (copy-sequence current-value))) + (cl-remf result sub-property) + (if result result nil))) + ;; Other types - leave unchanged + (t current-value)))) + (if new-value + (put-text-property pos next-pos property new-value object) + (remove-text-properties pos next-pos (list property nil) object)) + (setq pos next-pos)))) + nil) (defun tp-remove (start end property &optional object) "Remove PROPERTY from text between START and END in OBJECT.