From cc98ac4ed8357580ba190798a8cef468960fd034 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Thu, 18 Dec 2025 03:05:44 +0000 Subject: [PATCH] Add tp-move-layer function and refactor layer switching functions to use it Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com> --- README.md | 68 ++++++++++++++++ README_CN.md | 68 ++++++++++++++++ tp-tests.el | 67 ++++++++++++++++ tp.el | 223 ++++++++++++++++++++++++++++++++------------------- 4 files changed, 343 insertions(+), 83 deletions(-) diff --git a/README.md b/README.md index d392039..f231831 100644 --- a/README.md +++ b/README.md @@ -229,6 +229,7 @@ A complete overview of all tp.el functions organized by category: #### Property Layer Movement Functions | Function | Description | |----------|-------------| +| [`tp-move-layer`](#tp-move-layer---move-layer-to-position) | Move a layer from one position to another | | [`tp-raise-layer`](#tp-raise-layer---move-layer-updown) | Move layer up/down by N positions | | [`tp-rotate-layer`](#tp-rotate-layer---cycle-layers) | Cycle layers (top goes to bottom) | | [`tp-pin-layer`](#tp-pin-layer---pin-layer-to-top) | Pin a layer to top (make visible) | @@ -1486,6 +1487,73 @@ Remove the top layer (equivalent to `tp-delete-layer ... 0`). ### Property Layer Movement +#### `tp-move-layer` - Move Layer to Position + +```elisp +;; Buffer/string region +(tp-move-layer START END FROM-ID TO-IDX OBJECT) + +;; Entire string +(tp-move-layer STRING FROM-ID TO-IDX) +``` + +Move a layer from one position to another in the layer stack. + +- `FROM-ID` identifies the layer to move: an integer index or a layer name symbol +- `TO-IDX` is the target position (integer index) +- Index 0 means top (visible), -1 means bottom +- Both indices refer to positions before the move + +This is the generic layer movement function used internally by `tp-raise-layer`, `tp-rotate-layer`, `tp-pin-layer`, and `tp-switch-layer`. + +**Examples:** + +```elisp +;; Move layer at index 2 to index 0 (top) +(progn + (tp-layer-reset) + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-define-layer layer3 (face underline)) + (with-temp-buffer + (insert "Hello World") + (tp-push-layer 1 10 'layer1) + (tp-push-layer 1 10 'layer2) + (tp-push-layer 1 10 'layer3) + ;; Stack: layer3 (0), layer2 (1), layer1 (2) + (tp-move-layer 1 10 2 0) + (tp-layer-top 1 10))) +;; => layer1 + +;; Move layer by name to bottom +(progn + (tp-layer-reset) + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (with-temp-buffer + (insert "Hello World") + (tp-push-layer 1 10 'layer1) + (tp-push-layer 1 10 'layer2) + ;; Stack: layer2 (top), layer1 (bottom) + (tp-move-layer 1 10 'layer2 -1) + (tp-layer-top 1 10))) +;; => layer1 + +;; Move on string +(let ((str (copy-sequence "Hello"))) + (tp-layer-reset) + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-push-layer str 'layer1) + (tp-push-layer str 'layer2) + ;; layer2 is on top + (tp-move-layer str 'layer1 0) + (tp-at 0 'tp-name str)) +;; => layer1 +``` + +--- + #### `tp-raise-layer` - Move Layer Up/Down ```elisp diff --git a/README_CN.md b/README_CN.md index 5f850d1..09c169b 100644 --- a/README_CN.md +++ b/README_CN.md @@ -228,6 +228,7 @@ tp.el 所有函数按类别组织的完整概览： #### 属性层移动函数 | 函数 | 描述 | |------|------| +| [`tp-move-layer`](#tp-move-layer---移动属性层到指定位置) | 将属性层从一个位置移动到另一个位置 | | [`tp-raise-layer`](#tp-raise-layer---上移下移属性层) | 将属性层上移/下移 N 个位置 | | [`tp-rotate-layer`](#tp-rotate-layer---轮换属性层) | 轮换属性层（顶层移到底部） | | [`tp-pin-layer`](#tp-pin-layer---将属性层置顶) | 将属性层置顶（使其可见） | @@ -1483,6 +1484,73 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的 ### 属性层移动 +#### `tp-move-layer` - 移动属性层到指定位置 + +```elisp +;; 缓冲区/字符串区域 +(tp-move-layer START END FROM-ID TO-IDX OBJECT) + +;; 整个字符串 +(tp-move-layer STRING FROM-ID TO-IDX) +``` + +将属性层从一个位置移动到另一个位置。 + +- `FROM-ID` 标识要移动的层：可以是整数索引或层名称符号 +- `TO-IDX` 是目标位置（整数索引） +- 索引 0 表示顶层（可见），-1 表示底层 +- 两个索引都是指移动之前的位置 + +这是通用的属性层移动函数，`tp-raise-layer`、`tp-rotate-layer`、`tp-pin-layer` 和 `tp-switch-layer` 内部都使用它来实现。 + +**示例：** + +```elisp +;; 将索引 2 的层移动到索引 0（顶部） +(progn + (tp-layer-reset) + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-define-layer layer3 (face underline)) + (with-temp-buffer + (insert "Hello World") + (tp-push-layer 1 10 'layer1) + (tp-push-layer 1 10 'layer2) + (tp-push-layer 1 10 'layer3) + ;; 堆栈: layer3 (0), layer2 (1), layer1 (2) + (tp-move-layer 1 10 2 0) + (tp-layer-top 1 10))) +;; => layer1 + +;; 按名称移动层到底部 +(progn + (tp-layer-reset) + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (with-temp-buffer + (insert "Hello World") + (tp-push-layer 1 10 'layer1) + (tp-push-layer 1 10 'layer2) + ;; 堆栈: layer2 (顶), layer1 (底) + (tp-move-layer 1 10 'layer2 -1) + (tp-layer-top 1 10))) +;; => layer1 + +;; 在字符串上移动 +(let ((str (copy-sequence "Hello"))) + (tp-layer-reset) + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-push-layer str 'layer1) + (tp-push-layer str 'layer2) + ;; layer2 在顶部 + (tp-move-layer str 'layer1 0) + (tp-at 0 'tp-name str)) +;; => layer1 +``` + +--- + #### `tp-raise-layer` - 上移/下移属性层 ```elisp diff --git a/tp-tests.el b/tp-tests.el index 87d7b77..8e8a76d 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -521,6 +521,73 @@ ;; layer1 should now be on top (should (eq (tp-layer-top 1 6) 'layer1)))) +(ert-deftest tp-test-move-layer-by-index () + "Test tp-move-layer moves layer by index." + (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: layer3 (0), layer2 (1), layer1 (2) + (should (eq (tp-layer-top 1 6) 'layer3)) + ;; Move layer at index 2 (layer1) to index 0 (top) + (tp-move-layer 1 6 2 0) + ;; layer1 should now be on top + (should (eq (tp-layer-top 1 6) 'layer1)))) + +(ert-deftest tp-test-move-layer-by-name () + "Test tp-move-layer moves layer by name." + (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: layer3 (0), layer2 (1), layer1 (2) + (should (eq (tp-layer-top 1 6) 'layer3)) + ;; Move layer1 to index 0 (top) + (tp-move-layer 1 6 'layer1 0) + ;; layer1 should now be on top + (should (eq (tp-layer-top 1 6) 'layer1)))) + +(ert-deftest tp-test-move-layer-negative-index () + "Test tp-move-layer with negative 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: layer3 (0/-3), layer2 (1/-2), layer1 (2/-1) + (should (eq (tp-layer-top 1 6) 'layer3)) + ;; Move top layer (0) to bottom (-1) + (tp-move-layer 1 6 0 -1) + ;; layer2 should now be on top + (should (eq (tp-layer-top 1 6) 'layer2)))) + +(ert-deftest tp-test-move-layer-on-string () + "Test tp-move-layer works on strings." + (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) + ;; layer2 is on top + (should (eq (tp-at 0 'tp-name str) 'layer2)) + ;; Move layer1 to top + (tp-move-layer str 'layer1 0) + ;; layer1 should now be on top + (should (eq (tp-at 0 'tp-name str) 'layer1)))) + (ert-deftest tp-test-put-layer-at-idx () "Test tp-put-layer inserts layer at specified index." (tp-test-with-temp-buffer diff --git a/tp.el b/tp.el index 7b12013..32fe1dd 100644 --- a/tp.el +++ b/tp.el @@ -1969,6 +1969,112 @@ Calling conventions: ((numberp start-or-string) (tp-delete-layer start-or-string end-or-object 0 object)))) +(defun tp--move-layer-in-stack (stack from-id to-idx) + "Move layer at FROM-ID to TO-IDX position in STACK. +FROM-ID can be an integer index or a layer name symbol. +TO-IDX must be an integer index. +Both indices refer to positions before the move and can be negative (counting from end). +Returns the new stack, or nil if FROM-ID is invalid." + (let* ((len (length stack)) + ;; Resolve from-id to actual index + (found (tp--get-layer-by-idx-or-name stack from-id)) + (actual-from (when found (car found))) + ;; Normalize to-idx + (actual-to (if (< to-idx 0) + (+ len to-idx) + to-idx))) + ;; Only proceed if from-id is valid + (when actual-from + (let* ((layer-props (cdr found)) + (stack-without (-remove-at actual-from stack)) + ;; Clamp to-idx to valid range for insertion + (clamped-to (max 0 (min actual-to (length stack-without))))) + (append (seq-take stack-without clamped-to) + (list layer-props) + (seq-drop stack-without clamped-to)))))) + +(defun tp--raise-layer-in-stack (stack from-id n) + "Raise layer at FROM-ID by N positions in STACK. +FROM-ID can be an integer index or a layer name symbol. +Positive N moves the layer up (toward top/visible). +Negative N moves the layer down (toward bottom). +Returns the new stack, or nil if FROM-ID is invalid." + (let* ((found (tp--get-layer-by-idx-or-name stack from-id)) + (actual-from (when found (car found)))) + (when actual-from + (let* ((len (length stack)) + ;; Calculate new position: subtracting N because lower index = higher in stack + (new-idx (max 0 (min (1- len) (- actual-from n))))) + (tp--move-layer-in-stack stack actual-from new-idx))))) + +(defun tp--switch-layers-in-stack (stack id1 id2) + "Swap layers at ID1 and ID2 positions in STACK. +ID1 and ID2 can be integer indices or layer name symbols. +Returns the new stack, or nil if either ID is invalid." + (let* ((found1 (tp--get-layer-by-idx-or-name stack id1)) + (found2 (tp--get-layer-by-idx-or-name stack id2))) + (when (and found1 found2) + (let* ((idx1 (car found1)) + (idx2 (car found2)) + (props1 (cdr found1)) + (props2 (cdr found2)) + (new-stack (copy-sequence stack))) + (setf (nth idx1 new-stack) props2) + (setf (nth idx2 new-stack) props1) + new-stack)))) + +(defun tp-move-layer (start-or-string &optional end-or-from from-or-to to-or-object object) + "Move a layer from one position to another in the layer stack. + +Calling conventions: +1. Buffer/string region: + (tp-move-layer START END FROM-ID TO-IDX OBJECT) + +2. Entire string: + (tp-move-layer STRING FROM-ID TO-IDX) + +FROM-ID identifies the layer to move: +- An integer index (0 = top, 1 = second from top, -1 = bottom, etc.) +- A layer name symbol + +TO-IDX is the target position (integer index): +- 0 means top (visible) +- Positive integers count from top +- -1 means bottom +- Negative integers count from bottom + +Both indices refer to positions before the move. +The layer at FROM-ID is removed and inserted at TO-IDX position. +OBJECT defaults to current buffer for region form." + (let (start end from-id to-idx obj) + (cond + ;; Entire string form: (tp-move-layer string from-id to-idx) + ((stringp start-or-string) + (setq obj start-or-string + start 0 + end (length start-or-string) + from-id end-or-from + to-idx from-or-to)) + ;; Region form: (tp-move-layer start end from-id to-idx object) + ((numberp start-or-string) + (setq start start-or-string + end end-or-from + from-id from-or-to + to-idx to-or-object + obj object))) + + (tp-intervals-map + (lambda (i-start i-end top belows) + (let* ((current-stack (tp--layer-stack-to-list top belows)) + (new-stack (tp--move-layer-in-stack current-stack from-id to-idx))) + (when new-stack + (set-text-properties + (+ start i-start) (+ start i-end) + (tp--build-layer-props new-stack) + obj)))) + start end obj) + nil)) + (defun tp-raise-layer (start-or-string &optional end-or-idx idx-or-n n-or-object object) "Raise a layer by N positions in the stack. @@ -1980,7 +2086,9 @@ Calling conventions: (tp-raise-layer STRING IDX/LAYER-NAME N) Positive N moves the layer up (toward top/visible). -Negative N moves the layer down (toward bottom)." +Negative N moves the layer down (toward bottom). + +Uses `tp--raise-layer-in-stack' internally, which is built on `tp--move-layer-in-stack'." (let (start end layer-id n obj) (cond ((stringp start-or-string) @@ -1999,20 +2107,12 @@ Negative N moves the layer down (toward bottom)." (tp-intervals-map (lambda (i-start i-end top belows) (let* ((current-stack (tp--layer-stack-to-list top belows)) - (found (tp--get-layer-by-idx-or-name current-stack layer-id))) - (when found - (let* ((old-idx (car found)) - (layer-props (cdr found)) - (new-idx (max 0 (min (- (length current-stack) 1) - (- old-idx n)))) - (stack-without (-remove-at old-idx current-stack)) - (new-stack (append (seq-take stack-without new-idx) - (list layer-props) - (seq-drop stack-without new-idx)))) - (set-text-properties - (+ start i-start) (+ start i-end) - (tp--build-layer-props new-stack) - obj))))) + (new-stack (tp--raise-layer-in-stack current-stack layer-id n))) + (when new-stack + (set-text-properties + (+ start i-start) (+ start i-end) + (tp--build-layer-props new-stack) + obj)))) start end obj) nil)) @@ -2024,30 +2124,14 @@ Calling conventions: (tp-rotate-layer START END OBJECT) 2. Entire string: - (tp-rotate-layer STRING)" - (let (start end obj) - (cond - ((stringp start-or-string) - (setq obj start-or-string - start 0 - end (length start-or-string))) - ((numberp start-or-string) - (setq start start-or-string - end end-or-object - obj object))) - - (tp-intervals-map - (lambda (i-start i-end top belows) - (let ((current-stack (tp--layer-stack-to-list top belows))) - (when (> (length current-stack) 1) - (let ((new-stack (append (cdr current-stack) - (list (car current-stack))))) - (set-text-properties - (+ start i-start) (+ start i-end) - (tp--build-layer-props new-stack) - obj))))) - start end obj) - nil)) + (tp-rotate-layer STRING) + +Uses `tp-move-layer' internally to move layer at index 0 to index -1." + (cond + ((stringp start-or-string) + (tp-move-layer start-or-string 0 -1)) + ((numberp start-or-string) + (tp-move-layer start-or-string end-or-object 0 -1 object)))) (defun tp-pin-layer (start-or-string &optional end-or-idx idx-or-object object) "Pin a layer to the top (make it visible). @@ -2057,34 +2141,14 @@ Calling conventions: (tp-pin-layer START END IDX/LAYER-NAME OBJECT) 2. Entire string: - (tp-pin-layer STRING IDX/LAYER-NAME)" - (let (start end layer-id obj) - (cond - ((stringp start-or-string) - (setq obj start-or-string - start 0 - end (length start-or-string) - layer-id end-or-idx)) - ((numberp start-or-string) - (setq start start-or-string - end end-or-idx - layer-id idx-or-object - obj object))) - - (tp-intervals-map - (lambda (i-start i-end top belows) - (let* ((current-stack (tp--layer-stack-to-list top belows)) - (found (tp--get-layer-by-idx-or-name current-stack layer-id))) - (when (and found (> (car found) 0)) - (let* ((layer-props (cdr found)) - (stack-without (-remove-at (car found) current-stack)) - (new-stack (cons layer-props stack-without))) - (set-text-properties - (+ start i-start) (+ start i-end) - (tp--build-layer-props new-stack) - obj))))) - start end obj) - nil)) + (tp-pin-layer STRING IDX/LAYER-NAME) + +Uses `tp-move-layer' internally to move the specified layer to index 0 (top)." + (cond + ((stringp start-or-string) + (tp-move-layer start-or-string end-or-idx 0)) + ((numberp start-or-string) + (tp-move-layer start-or-string end-or-idx idx-or-object 0 object)))) (defun tp-switch-layer (start-or-string &optional end-or-id1 id1-or-id2 id2-or-object object) "Switch between two layers by name or index. @@ -2094,7 +2158,9 @@ Calling conventions: (tp-switch-layer START END IDX1/NAME1 IDX2/NAME2 OBJECT) 2. Entire string: - (tp-switch-layer STRING IDX1/NAME1 IDX2/NAME2)" + (tp-switch-layer STRING IDX1/NAME1 IDX2/NAME2) + +Uses `tp--switch-layers-in-stack' internally." (let (start end id1 id2 obj) (cond ((stringp start-or-string) @@ -2113,21 +2179,12 @@ Calling conventions: (tp-intervals-map (lambda (i-start i-end top belows) (let* ((current-stack (tp--layer-stack-to-list top belows)) - (found1 (tp--get-layer-by-idx-or-name current-stack id1)) - (found2 (tp--get-layer-by-idx-or-name current-stack id2))) - (when (and found1 found2) - (let* ((idx1 (car found1)) - (idx2 (car found2)) - (props1 (cdr found1)) - (props2 (cdr found2)) - ;; Swap the layers - (new-stack (copy-sequence current-stack))) - (setf (nth idx1 new-stack) props2) - (setf (nth idx2 new-stack) props1) - (set-text-properties - (+ start i-start) (+ start i-end) - (tp--build-layer-props new-stack) - obj))))) + (new-stack (tp--switch-layers-in-stack current-stack id1 id2))) + (when new-stack + (set-text-properties + (+ start i-start) (+ start i-end) + (tp--build-layer-props new-stack) + obj)))) start end obj) nil))