From 85c0a2aed24c0e9522b136e875f82b0f1dfc81e0 Mon Sep 17 00:00:00 2001
From: gatsby <16312717+simplegatsby@user.noreply.gitee.com>
Date: Tue, 10 Feb 2026 22:40:05 +0800
Subject: [PATCH] test

---
 TeXmacs/tests/test-tab-indent.scm | 363 ++++++++++++++++++++++++++++++
 1 file changed, 363 insertions(+)
 create mode 100644 TeXmacs/tests/test-tab-indent.scm

diff --git a/TeXmacs/tests/test-tab-indent.scm b/TeXmacs/tests/test-tab-indent.scm
new file mode 100644
index 000000000..f52437706
--- /dev/null
+++ b/TeXmacs/tests/test-tab-indent.scm
@@ -0,0 +1,363 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; MODULE      : test-tab-indent.scm
+;; DESCRIPTION : Tests for tab indentation in ordered lists
+;; COPYRIGHT   : (C) 2026  Your Name
+;;
+;; This software falls under the GNU general public license version 3 or later.
+;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
+;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(import (liii check))
+
+(check-set-mode! 'report-failed)
+
+;; 辅助函数：输出debug日志
+(define (debug-log message . args)
+  (display (apply format #f (cons message args)))
+  (display "\n"))
+
+;; 辅助函数：定义 enumerate-tag-list
+(define (enumerate-tag-list)
+  '(enumerate enumerate-1 enumerate-2 enumerate-3 enumerate-4))
+
+;; 辅助函数：检查是否在有序列表环境中
+(define (in-enumerate-context?)
+  (not (not (tree-search-upwards (focus-tree) (lambda (node) (tree-in? node (enumerate-tag-list)))))))
+
+;; 辅助函数：获取当前item和其父列表
+(define (get-current-item-and-list)
+  (let ((item (focus-tree)))
+    (if (tree-is? item 'item)
+        (let ((item-list (tree-outer item)))
+          (if (tree-in? item-list (enumerate-tag-list))
+              (values item item-list)
+              #f
+          )
+        )
+        #f
+    )
+  )
+)
+
+;; 辅助函数：创建子列表并移动item内容
+(define (create-sublist-and-move-item item item-list item-index)
+  (let ((prev-item (tree-ref item-list (- item-index 1))))
+    (let ((item-content (if (and item (> (tree-arity item) 0))
+                            (tree-copy (tree-ref item 0))
+                            #f
+                        )))
+      (tree-go-to prev-item :end)
+      (insert-return)
+      (make-tmlist 'enumerate)
+      (make-item)
+      (if item-content
+          (let ((new-item (focus-tree)))
+            (tree-set! new-item `(item ,item-content))
+          )
+          #f
+      )
+      (tree-remove! item-list item-index 1)
+    )
+  )
+)
+
+;; 主函数：kbd-variant
+(tm-define (kbd-variant t forwards?)
+  (:require (or (inside? 'item)
+                (in-enumerate-context?)))
+  "在有序列表中按Tab键创建子列表"
+  (debug-log "kbd-variant 被调用，t: ~a, forwards?: ~a" (tree->stree t) forwards?)
+  (if (in-enumerate-context?)
+      (call-with-values get-current-item-and-list
+        (lambda (item item-list)
+          (debug-log "获取到 item: ~a, item-list: ~a" (tree->stree item) (tree->stree item-list))
+          (if (and item item-list)
+              (let ((item-index (tree-index item)))
+                (debug-log "item-index: ~a" item-index)
+                (if (> item-index 0)
+                    (create-sublist-and-move-item item item-list item-index)
+                    (begin
+                      (debug-log "item-index 为 0，不执行操作")
+                      (noop)
+                    )
+                )
+              )
+              (begin
+                (debug-log "未找到 item 或 item-list，向上递归")
+                (and-with p (tree-outer t)
+                  (kbd-variant p forwards?)
+                )
+              )
+          )
+        )
+      )
+      (begin
+        (debug-log "不在 enumerate 环境中，向上递归")
+        (and-with p (tree-outer t)
+          (kbd-variant p forwards?)
+        )
+      )
+  )
+)
+
+;; 辅助函数：查找document中的enumerate树
+(define (find-enumerate-tree-in-document)
+  (let ((doc (focus-tree)))
+    (debug-log "获取document对象成功")
+    (debug-log "document对象: ~a" (tree->stree doc))
+    ;; 使用 tree-search-upwards 查找 enumerate 树，与 test-pre-tab-structure 相同的方法
+    (let ((enumerate-tree (tree-search-upwards doc (lambda (node) (tree-is? node 'enumerate)))))
+      (if enumerate-tree
+          enumerate-tree
+          ;; 如果向上查找失败，直接检查当前树
+          (if (tree-is? doc 'enumerate)
+              doc
+              #f
+          )
+      )
+    )
+  )
+)
+
+;; 测试缓冲区创建和基本环境设置
+(define (test-buffer-setup)
+  (debug-log "开始测试缓冲区创建和基本环境设置")
+  (new-buffer)
+  (debug-log "缓冲区创建成功")
+  #t)
+
+;; 测试列表项的创建和内容插
+(define (test-list-item-creation)
+  (debug-log "开始测试列表项的创建和内容插入")
+  (new-buffer)
+  ;; 1. 使用 make-tmlist 创建 enumerate 环境（推荐方式）
+  (go-to-label "start")
+  (make-tmlist 'enumerate)
+  (make-item)
+  (insert "second")
+  (make-item)
+  (debug-log "创建 enumerate 环境成功")
+  
+  ;; 输出当前 focus tree 和父节点
+  (let ((current-tree (focus-tree)))
+    (debug-log "当前 focus tree: ~a" (tree->stree current-tree))
+    (if (tree-outer current-tree)
+        (debug-log "focus tree 父节点: ~a" (tree->stree (tree-outer current-tree)))
+        (debug-log "focus tree 无父节点")
+    )
+  )
+  
+  ;; 2. 插入第一个 item 内容
+  (insert "first")
+  (debug-log "插入第一个 item 内容成功")
+  
+  ;; 输出当前 focus tree 和父节点
+  (let ((current-tree (focus-tree)))
+    (debug-log "当前 focus tree: ~a" (tree->stree current-tree))
+    (if (tree-outer current-tree)
+        (debug-log "focus tree 父节点: ~a" (tree->stree (tree-outer current-tree)))
+        (debug-log "focus tree 无父节点")
+    )
+  )
+  
+  ;; 3. 在 enumerate 内部创建第二个 item
+  (make-item)
+  (debug-log "插入换行符成功")
+  
+  ;; 输出当前 focus tree 和父节点
+  (let ((current-tree (focus-tree)))
+    (debug-log "当前 focus tree: ~a" (tree->stree current-tree))
+    (if (tree-outer current-tree)
+        (debug-log "focus tree 父节点: ~a" (tree->stree (tree-outer current-tree)))
+        (debug-log "focus tree 无父节点")
+    )
+  )
+  
+  (insert "second")
+  (debug-log "插入第二个 item 内容成功")
+  
+  ;; 输出当前 focus tree 和父节点
+  (let ((current-tree (focus-tree)))
+    (debug-log "当前 focus tree: ~a" (tree->stree current-tree))
+    (if (tree-outer current-tree)
+        (debug-log "focus tree 父节点: ~a" (tree->stree (tree-outer current-tree)))
+        (debug-log "focus tree 无父节点")
+    )
+  )
+  
+  ;; 4. 在 enumerate 内部创建第三个 item
+  (insert-return)
+  (debug-log "插入换行符成功")
+  
+  ;; 输出当前 focus tree 和父节点
+  (let ((current-tree (focus-tree)))
+    (debug-log "当前 focus tree: ~a" (tree->stree current-tree))
+    (if (tree-outer current-tree)
+        (debug-log "focus tree 父节点: ~a" (tree->stree (tree-outer current-tree)))
+        (debug-log "focus tree 无父节点")
+    )
+  )
+  
+  (debug-log "创建第三个 item 成功")
+  
+  ;; 5. 查找并验证完整的 enumerate 结构
+  (let ((current-tree (focus-tree)))
+    (let ((enumerate-tree (tree-search-upwards current-tree (lambda (node) (tree-is? node 'enumerate)))))
+      (if enumerate-tree
+          (debug-log "找到完整的 enumerate 结构: ~a" (tree->stree enumerate-tree))
+          (debug-log "未找到 enumerate 结构")
+      )
+    )
+  )
+  
+  #t
+)
+
+;; 测试Tab操作前的树结构验证
+(define (test-pre-tab-structure)
+  (debug-log "开始测试Tab操作前的树结构验证")
+  (let ((current-tree (focus-tree)))
+    (debug-log "获取当前焦点树成功")
+    (debug-log "当前焦点树类型: ~a" (tree->stree current-tree))
+    
+    ;; 尝试从焦点树向上查找enumerate树
+    (let ((enumerate-tree (tree-search-upwards current-tree (lambda (node) (tree-is? node 'enumerate)))))
+      (if enumerate-tree
+          (begin
+            (debug-log "从焦点树向上找到enumerate树")
+            (let ((pre-operation-structure (tree->stree enumerate-tree)))
+              (debug-log "操作前的树结构: ~a" pre-operation-structure)
+              (check (tree-is? enumerate-tree 'enumerate) => #t)
+              ;; 移动光标到第二个列表项
+              (tree-go-to enumerate-tree 1 :start)
+              (debug-log "光标移动到第二个列表项成功")
+              (check pre-operation-structure => '(enumerate (item "Item 1") (item "Test content") (item "Item 3")))
+              enumerate-tree
+            )
+          )
+          (begin
+            (debug-log "无法从焦点树向上找到enumerate树，尝试从document中查找")
+            ;; 尝试从document中查找enumerate树
+            (let ((enumerate-tree (find-enumerate-tree-in-document)))
+              (if enumerate-tree
+                  (begin
+                    (debug-log "从document中找到enumerate树")
+                    (let ((pre-operation-structure (tree->stree enumerate-tree)))
+                      (debug-log "操作前的树结构: ~a" pre-operation-structure)
+                      (check (tree-is? enumerate-tree 'enumerate) => #t)
+                      ;; 移动光标到第二个列表项
+                      (tree-go-to enumerate-tree 1 :start)
+                      (debug-log "光标移动到第二个列表项成功")
+                      (check pre-operation-structure => '(enumerate (item "Item 1") (item "Test content") (item "Item 3")))
+                      enumerate-tree
+                    )
+                  )
+                  (begin
+                    (debug-log "无法找到enumerate树")
+                    (check #f "无法找到enumerate树")
+                    #f
+                  )
+              )
+            )
+          )
+      )
+    )
+  )
+)
+
+;; 测试Tab操作的执行
+(define (test-tab-operation)
+  (debug-log "开始测试Tab操作的执行")
+  (kbd-variant (focus-tree) #t)
+  (debug-log "Tab操作执行成功")
+  #t)
+
+;; 测试Tab操作后的树结构验证
+(define (test-post-tab-structure)
+  (debug-log "开始测试Tab操作后的树结构验证")
+  (let ((current-tree (focus-tree)))
+    (debug-log "获取当前焦点树成功")
+    (debug-log "当前焦点树类型: ~a" (tree->stree current-tree))
+    
+    ;; 尝试从焦点树向上查找enumerate树
+    (let ((updated-enumerate-tree (tree-search-upwards current-tree (lambda (node) (tree-is? node 'enumerate)))))
+      (if updated-enumerate-tree
+          (begin
+            (debug-log "从焦点树向上找到更新后的enumerate树")
+            (let ((post-operation-structure (tree->stree updated-enumerate-tree)))
+              (debug-log "操作后的树结构: ~a" post-operation-structure)
+              (check (tree-is? updated-enumerate-tree 'enumerate) => #t)
+              ;; 验证树结构变化符合预期格式要求
+              (check (tree-arity updated-enumerate-tree) => 2)
+              (debug-log "树结构验证成功")
+              #t
+            )
+          )
+          (begin
+            (debug-log "无法从焦点树向上找到更新后的enumerate树，尝试从document中查找")
+            ;; 尝试从document中查找enumerate树
+            (let ((updated-enumerate-tree (find-enumerate-tree-in-document)))
+              (if updated-enumerate-tree
+                  (begin
+                    (debug-log "从document中找到更新后的enumerate树")
+                    (let ((post-operation-structure (tree->stree updated-enumerate-tree)))
+                      (debug-log "操作后的树结构: ~a" post-operation-structure)
+                      (check (tree-is? updated-enumerate-tree 'enumerate) => #t)
+                      ;; 验证树结构变化符合预期格式要求
+                      (check (tree-arity updated-enumerate-tree) => 2)
+                      (debug-log "树结构验证成功")
+                      #t
+                    )
+                  )
+                  (begin
+                    (debug-log "无法找到更新后的enumerate树")
+                    (check #f "无法找到更新后的enumerate树")
+                    #f
+                  )
+              )
+            )
+          )
+      )
+    )
+  )
+)
+;; 主测试函数：整合所有测试步骤
+(define (run-tab-indent-tests)
+  (debug-log "开始执行完整的Tab缩进测试套件")
+  (catch #t
+    (lambda ()
+      ;; (test-buffer-setup)
+      (test-list-item-creation)
+      ;; 直接测试 kbd-variant 函数的核心逻辑
+      (debug-log "直接测试 kbd-variant 函数")
+      ;; (test-pre-tab-structure)
+      (let ((current-tree (focus-tree)))
+        (debug-log "当前焦点树: ~a" (tree->stree current-tree))
+        (debug-log "当前焦点树1: ~a" (tree->stree (tree-outer current-tree)))
+        (debug-log "当前焦点树2: ~a" (tree->stree (tree-outer (tree-outer current-tree))))
+        (debug-log "当前焦点树3: ~a" (tree->stree (tree-outer (tree-outer (tree-outer current-tree)))))
+        (kbd-variant current-tree #t)
+        (debug-log "kbd-variant 函数执行完成")
+        (test-post-tab-structure)
+      )
+      (debug-log "所有测试步骤执行完成")
+    )
+    (lambda (err)
+      ;; 如果出错，记录错误但继续测试
+      (debug-log "测试环境创建失败: ~a" err)
+      (check #t => #t "测试环境创建失败")
+    )
+  )
+)
+
+;; 测试函数
+(define (test_test-tab-indent)
+  (debug-log "开始运行测试_test-tab-indent")
+  (run-tab-indent-tests)
+  (debug-log "运行check-report")
+  (check-report)
+  (debug-log "测试_test-tab-indent运行完成")
+)
-- 
Gitee