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

@@ -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

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

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

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)))
+              (new-stack (tp--raise-layer-in-stack current-stack layer-id n)))
-         (when found
+         (when new-stack
-           (let* ((old-idx (car found))
+           (set-text-properties
-                  (layer-props (cdr found))
+            (+ start i-start) (+ start i-end)
-                  (new-idx (max 0 (min (- (length current-stack) 1)
+            (tp--build-layer-props new-stack)
-                                       (- old-idx n))))
+            obj))))
-                  (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)))))
      start end obj)
     nil))
 
@@ -2024,30 +2124,14 @@ Calling conventions:
    (tp-rotate-layer START END OBJECT)
    
 2. Entire string:
-   (tp-rotate-layer STRING)"
+   (tp-rotate-layer STRING)
-  (let (start end obj)
+
-    (cond
+Uses `tp-move-layer' internally to move layer at index 0 to index -1."
-     ((stringp start-or-string)
+  (cond
-      (setq obj start-or-string
+   ((stringp start-or-string)
-            start 0
+    (tp-move-layer start-or-string 0 -1))
-            end (length start-or-string)))
+   ((numberp start-or-string)
-     ((numberp start-or-string)
+    (tp-move-layer start-or-string end-or-object 0 -1 object))))
-      (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))
 
 (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)"
+   (tp-pin-layer STRING IDX/LAYER-NAME)
-  (let (start end layer-id obj)
+
-    (cond
+Uses `tp-move-layer' internally to move the specified layer to index 0 (top)."
-     ((stringp start-or-string)
+  (cond
-      (setq obj start-or-string
+   ((stringp start-or-string)
-            start 0
+    (tp-move-layer start-or-string end-or-idx 0))
-            end (length start-or-string)
+   ((numberp start-or-string)
-            layer-id end-or-idx))
+    (tp-move-layer start-or-string end-or-idx idx-or-object 0 object))))
-     ((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))
 
 (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))
+              (new-stack (tp--switch-layers-in-stack current-stack id1 id2)))
-              (found2 (tp--get-layer-by-idx-or-name current-stack id2)))
+         (when new-stack
-         (when (and found1 found2)
+           (set-text-properties
-           (let* ((idx1 (car found1))
+            (+ start i-start) (+ start i-end)
-                  (idx2 (car found2))
+            (tp--build-layer-props new-stack)
-                  (props1 (cdr found1))
+            obj))))
-                  (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)))))
      start end obj)
     nil))