Skip to content

[201_98] 实现shift+tab 反缩进，优化缩进能力 #3101

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
da-liii merged 3 commits into from
Apr 13, 2026
+354 −77
Merged

[201_98] 实现shift+tab 反缩进，优化缩进能力 #3101

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
7a996a8
shift tab unindetn
GatsbyUSTC Apr 3, 2026
254d070
实现了shift tap,优化了 tap 逻辑
GatsbyUSTC Apr 3, 2026
e792e12
resolve comments
GatsbyUSTC Apr 13, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
252 changes: 215 additions & 37 deletions TeXmacs/progs/generic/generic-edit.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -168,7 +168,9 @@

;; 辅助函数：定义 enumerate-tag-list
(define (enumerate-tag-list)
'(enumerate enumerate-1 enumerate-2 enumerate-3 enumerate-4))
'(enumerate enumerate-numeric enumerate-roman
enumerate-Roman enumerate-alpha enumerate-Alpha
enumerate-circle enumerate-hanzi enumerate-numeric-paren))

;; 辅助函数：定义 itemize-tag-list
(define (itemize-tag-list)
Expand All @@ -190,13 +192,10 @@
(define (in-description-context?)
(not (not (tree-search-upwards (focus-tree) (lambda (node) (tree-in? node (description-tag-list)))))))

;; 辅助函数：获取当前列表的类型
(define (get-list-type)
(cond
((in-description-context?) 'description)
((in-itemize-context?) 'itemize)
((in-enumerate-context?) 'enumerate)
(else #f)))
;; 辅助函数：获取当前实际列表的精确标签，保留 itemize-dot 等变体样式
(define (get-current-list-label item)
(and-with list-node (tree-search-upwards item list-node?)
(tree-label list-node)))

;; 辅助函数：查找包含 item 的 concat 包装和真正的 item list
(define (find-item-wrapper-and-list item)
Expand Down Expand Up @@ -226,44 +225,223 @@
(let ((item-index (tree-index item)))
(tree-remove! item-list item-index 1))))

(define (list-item-node? t)
(or (tree-is? t 'item)
(tree-is? t 'item*)
(and (tree-is? t 'concat)
(> (tree-arity t) 0)
(or (tree-is? (tree-ref t 0) 'item)
(tree-is? (tree-ref t 0) 'item*)))))

(define (list-node? t)
(and t (tree-in? t (list-tag-list))))

(define (list-family label)
(cond ((in? label (enumerate-tag-list)) 'enumerate)
((in? label (itemize-tag-list)) 'itemize)
((in? label (description-tag-list)) 'description)
(else label)))

(define (same-list-family? lhs rhs)
(and lhs rhs (== (list-family lhs) (list-family rhs))))

(define (find-previous-item-index item-list start)
(let loop ((i (- start 1)))
(cond ((< i 0) #f)
((list-item-node? (tree-ref item-list i)) i)
(else (loop (- i 1))))))

(define (find-following-list-index item-list start end list-type)
(let loop ((i (+ start 1)))
(cond ((>= i end) #f)
((and (list-node? (tree-ref item-list i))
(same-list-family? (tree-label (tree-ref item-list i)) list-type))
i)
(else (loop (+ i 1))))))

(define (append-strees-to-document doc strees)
(if (null? strees) doc
(tree-insert doc (tree-arity doc) strees)))

;; 在有序和无序列表中实现缩进功能
(tm-define (kbd-variant t forwards?)
(:require
(or
;; 有序列表或者无序列表
(and (or in-enumerate-context? in-itemize-context?) (tree-is? (focus-tree) 'item))
;; 描述列表
(and in-description-context? (tree-is? (focus-tree) 'item*))))
(and forwards?
(or
;; 有序列表或者无序列表
(and (or in-enumerate-context? in-itemize-context?) (tree-is? (focus-tree) 'item))
;; 描述列表
(and in-description-context? (tree-is? (focus-tree) 'item*)))))

(let ((item (focus-tree)))
;; 步骤 1: 查找包装和列表
;; 查找包装和列表
(call-with-values (lambda () (find-item-wrapper-and-list item))
(lambda (wrapper item-list)
(if (and item item-list)
(let ((item-index (if wrapper (tree-index wrapper) (tree-index item))))
(let* ((item-index (if wrapper (tree-index wrapper) (tree-index item)))
(list-type (list-family (or (get-current-list-label item) 'enumerate)))
(item-stree (tree->stree (if wrapper wrapper item)))
(next-index (+ item-index 1))
(attached-sublist-idx
(and (< next-index (tree-arity item-list))
(let ((next-node (tree-ref item-list next-index)))
;; 当前 item 后面如果紧跟同一大类的子列表，缩进时一并并入目标子列表。
(and (list-node? next-node)
(same-list-family? (tree-label next-node) list-type)
next-index)))))
(if (> item-index 0)
(let ((prev-item (tree-ref item-list (- item-index 1))))
;; 步骤 2: 提取内容
(let ((item-content (extract-item-content wrapper)))
;; 步骤 3: 创建子列表并移动内容
(tree-go-to prev-item :end)
(insert-return)
(let ((list-type (get-list-type)))
(if list-type
(make-tmlist list-type)
(make-tmlist 'enumerate))) ; 默认使用有序列表
;; 步骤4：拷贝内容
(if item-content
(let ((new-item (focus-tree))
(list-type (get-list-type)))

(let ((content-stree (tree->stree item-content)))
(if (eq? list-type 'description)
(tree-set! new-item `(concat (item*), content-stree))
(tree-set! new-item `(concat (item), content-stree)))
(tree-go-to new-item))))
;; 步骤 5: 从原列表中移除
(remove-item-from-list item wrapper item-list))))))))))
(let* ((prev-item-index (find-previous-item-index item-list item-index))
(target-sublist-idx
(and prev-item-index
;; 优先复用前一个 item 已有的同一大类子列表，避免制造相邻碎片列表。
(find-following-list-index item-list prev-item-index
item-index list-type))))
(when prev-item-index
;; 当前一个 item 还没有子列表时，才在当前 item 前插入一个空子列表。
(when (not target-sublist-idx)
(set! item-list
(tree-insert item-list item-index
(list `(,list-type (document)))))
(set! target-sublist-idx item-index)
(set! item-index (+ item-index 1))
;; 新插入的空子列表会让原 item 和其后置子列表整体右移一位。
(if attached-sublist-idx
(set! attached-sublist-idx (+ attached-sublist-idx 1))))

(let* ((target-sublist (tree-ref item-list target-sublist-idx))
(target-doc (tree-ref target-sublist 0))
(target-pos (tree-arity target-doc))
(attached-items
(if attached-sublist-idx
(map (lambda (i)
(tree->stree
(tree-copy
(tree-ref (tree-ref (tree-ref item-list attached-sublist-idx) 0) i))))
(iota (tree-arity (tree-ref (tree-ref item-list attached-sublist-idx) 0))))
'())))
;; 目标子列表依次接收：当前 item，以及它后面原来挂着的同类型子列表内容。
(set! target-doc
(append-strees-to-document target-doc
(append (list item-stree) attached-items)))
;; 从右往左删除，避免索引漂移。
(when attached-sublist-idx
(set! item-list (tree-remove! item-list attached-sublist-idx 1)))
(set! item-list (tree-remove! item-list item-index 1))
;; concat 包装的 item 需要落到第 0 个子元素末尾，普通 item 直接定位。
(let ((moved-item (tree-ref target-doc target-pos)))
(if (tree-is? moved-item 'concat)
(tree-go-to moved-item 0 :end)
(tree-go-to target-doc target-pos :end)))))))))))))

;; 在有序和无序列表中实现反缩进功能
;;
;; 处理逻辑：
;; 当用户按 Shift+Tab 时，将当前 item 从当前子列表中移出到外层列表。
;; 如果当前列表已经是最外层列表，则不再继续反缩进。
;;
;; 两种 Case：
;; 1. NOT first item: 当前 item 前面还有其他 items
;; - 保留原 sublist（因为前面还有 items）
;; - 从当前 sublist 的 document 中移除当前 item 和后续 items
;; - 在 parent-list 中 sublist 之后插入当前 item
;; - 如有后续 items，在当前 item 后面重建一个同类型 sublist
;;
;; 2. FIRST item: 当前 item 是第一个，后面可能有 items
;; - 从当前 sublist 的 document 中移除当前 item（保留后续 items）
;; - 从 parent-list 中移除整个 sublist
;; - 在 parent-list 中原 sublist 位置插入当前 item
;; - 如有后续 items，在当前 item 后面重建一个同类型 sublist
;;
(tm-define (kbd-variant t forwards?)
(:require
(and (not forwards?)
(or
(and (or in-enumerate-context? in-itemize-context?) (tree-is? (focus-tree) 'item))
(and in-description-context? (tree-is? (focus-tree) 'item*)))))

(let* ((item (focus-tree))
(item-stree (tree->stree item))
(wrapper #f)
(doc (tree-outer item)))

;; 处理 concat 包装
(when (tree-is? doc 'concat)
(set! wrapper doc)
(set! doc (tree-outer wrapper))
(set! item-stree (tree->stree wrapper)))

;; 仅在 item 直接位于列表 document 中时才执行反缩进。
(when (tree-is? doc 'document)
(let* ((sublist (tree-outer doc))
(parent-list (if sublist (tree-outer sublist) #f))
;; 只有在当前子列表外面还能找到另一层列表时，才允许继续反缩进；
;; 这样最外层列表会直接止住。
(outer-list (and parent-list
(tree-search-upwards parent-list list-node?))))

(when (and parent-list outer-list)
(let* ((sublist-idx (tree-index sublist))
(doc-arity (tree-arity doc))
(item-idx (if wrapper (tree-index wrapper) (tree-index item)))
(items-before-count item-idx)
(items-after-count (- doc-arity item-idx 1)))

;; 先保存当前 item 后面的所有兄弟节点，后面需要重建 trailing sublist。
(with items-after-stree
(if (> items-after-count 0)
(map (lambda (i)
(tree->stree (tree-copy (tree-ref doc (+ item-idx 1 i)))))
(iota items-after-count))
'())

;; 两个 case 都会得到同样的结果：更新后的 parent-list 和插入位置。
(let* ((current-doc (tree-ref sublist 0))
(current-parent (tree-outer sublist))
(item-insert-pos #f))

;; 先处理“原 sublist 要保留还是删除”这部分差异。
(if (> items-before-count 0)
;; Case 1: 不是第一个 item，保留 sublist
(begin
;; 从 doc 中移除当前 item 和后续 items
(let loop ((i (- doc-arity 1))
(cd current-doc))
(when (>= i item-idx)
(set! cd (tree-remove! cd i 1))
(loop (- i 1) cd)))
;; 重新获取 current-doc（修改后）
(set! current-doc (tree-ref sublist 0))
;; item 插入位置：sublist 之后
(set! item-insert-pos (+ sublist-idx 1)))

;; Case 2: 是第一个 item，删除 sublist
(begin
;; 从 doc 中移除当前 item
(set! current-doc (tree-remove! current-doc item-idx 1))
;; 从 parent-list 中移除 sublist
(set! current-parent (tree-remove! current-parent sublist-idx 1))
;; item 插入位置：原 sublist 位置
(set! item-insert-pos sublist-idx)))

;; 共同逻辑：在 parent-list 中插入当前 item
(set! current-parent (tree-insert current-parent item-insert-pos (list item-stree)))

;; 如有后续 items，则在当前 item 后面重建一个同类型 sublist。
(when (> (length items-after-stree) 0)
(let ((new-sublist-stree `(,(tree-label sublist) (document ,@items-after-stree)))
(sublist-pos (+ item-insert-pos 1)))
(set! current-parent (tree-insert current-parent sublist-pos (list new-sublist-stree)))))

;; 共同逻辑：移动光标到新插入的 item
(with moved-item (tree-ref current-parent item-insert-pos)
;; 根据 moved-item 类型决定光标位置
(if (tree-is? moved-item 'concat)
;; concat 包装：定位到第0个子元素（document）的结束位置
(tree-go-to moved-item 0 :end)
;; item: 从 parent 定位
(begin
(tree-go-to current-parent item-insert-pos :end))))))))))))


(tm-define (kbd-variant t forwards?)
(:require (and (tree-in? t '(label reference pageref eqref smart-ref))
Expand Down
3 changes: 2 additions & 1 deletion TeXmacs/progs/utils/library/tree.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,8 @@
(tm-define (tree-insert t pos x)
(cond ((string? x) (tree-var-insert t pos x))
((list? x) (tree-var-insert t pos (cons 'tuple x)))
(else (texmacs-error "tree-insert" "~S is not a string or a list" x))))
((tree? x) (tree-var-insert t pos x))
(else (texmacs-error "tree-insert" "~S is not a string, list, or tree" x))))

(tm-define tree-insert! tree-insert)
(tm-define tree-remove! tree-remove)
Expand Down
54 changes: 54 additions & 0 deletions TeXmacs/tests/tmu/201_98.tmu
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,54 @@
<TMU|<tuple|1.1.0|2026.2.1-rc5>>

<style|<tuple|generic|chinese|table-captions-above|number-europe|preview-ref>>

<\body>
<\enumerate>
<item>

<item>

<\enumerate>
<item>

<item>

<item>

<item>

<item>

<item>

<\enumerate>
<item>

<item>

<item>sadf
</enumerate>

<item>

<item>

<item>asfsad

<item>

<item>
</enumerate>

<item>

<item>
</enumerate>
</body>

<\initial>
<\collection>
<associate|page-medium|paper>
<associate|page-screen-margin|false>
</collection>
</initial>
Loading