From 5f01060a69998c82ada495ed854a8a3027a82fe3 Mon Sep 17 00:00:00 2001 From: wumo Date: Wed, 4 Feb 2026 16:48:35 +0800 Subject: [PATCH 1/4] =?UTF-8?q?=E4=BD=BF=E7=94=A8json=E6=9D=A5=E5=AD=98?= =?UTF-8?q?=E5=82=A8=E6=9C=80=E8=BF=91=E4=BD=BF=E7=94=A8=E7=9A=84=E6=96=87?= =?UTF-8?q?=E4=BB=B6?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- TeXmacs/progs/kernel/texmacs/tm-dialogue.scm | 144 ++++++++++++++++++- TeXmacs/progs/texmacs/menus/file-menu.scm | 4 +- TeXmacs/progs/texmacs/texmacs/tm-files.scm | 3 +- devel/201_71.md | 10 ++ 4 files changed, 153 insertions(+), 8 deletions(-) create mode 100644 devel/201_71.md diff --git a/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm b/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm index 7ed401dd9b..46e7349fce 100644 --- a/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm +++ b/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm @@ -13,7 +13,10 @@ (texmacs-module (kernel texmacs tm-dialogue) (:use (kernel texmacs tm-define))) - +(import (liii json) + (liii time) + (liii list) + (liii path)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Questions with user interaction ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -158,6 +161,98 @@ (define interactive-arg-table (make-ahash-table)) + +(define interactive-arg-recent-file-json + '((meta . ((total . 0))) + (files . #()))) + + +(define-public (recent-files-remove-by-path path) + (let ((idx (recent-files-index-by-path interactive-arg-recent-file-json path))) + (when idx + (set! interactive-arg-recent-file-json + (json-drop interactive-arg-recent-file-json 'files idx))))) + + + +(define (recent-files-apply-lru recent-files limit) + (let* ((files (json-ref recent-files 'files)) + (n (vector-length files)) + (indexed + (let loop ((i 0) (acc '())) + (if (>= i n) acc + (let* ((item (vector-ref files i)) + (t (json-ref item 'last_open)) + (t (if (number? t) t 0))) + (loop (+ i 1) (cons (cons i t) acc)))))) + (sorted (sort indexed (lambda (a b) (> (cdr a) (cdr b)))))) + (if (<= n limit) + (json-set recent-files 'files + (list->vector + (map (lambda (p) (vector-ref files (car p))) sorted))) + (let* ((keep (take sorted limit)) + (drop (drop sorted limit)) + (new-files + (list->vector + (append + (map (lambda (p) + (let* ((item (vector-ref files (car p)))) + (json-set item 'show #t))) + keep) + (map (lambda (p) + (let* ((item (vector-ref files (car p)))) + (json-set item 'show #f))) + drop))))) + (json-set recent-files 'files new-files))))) + +(define (recent-files-add recent-files path name) + (let* ((files (json-ref recent-files 'files)) + (idx (vector-length files)) + (item `((path . ,path) + (name . ,name) + (last_open . ,(current-second)) + (open_count . 1) + (show . #t))) + (total (json-ref recent-files 'meta 'total)) + (total (if (number? total) total 0)) + (r1 (json-set + (json-push recent-files 'files idx item) + 'meta 'total (+ total 1)))) + (recent-files-apply-lru r1 25))) + +(define (recent-files-set recent-files idx) + (let* ((item (json-ref recent-files 'files idx)) + (path* (json-ref item 'path)) + (name* (json-ref item 'name)) + (count* (json-ref item 'open_count)) + (count* (if (number? count*) count* 0)) + (new-item `((path . ,path*) + (name . ,name*) + (last_open . ,(current-second)) + (open_count . ,(+ count* 1)) + (show . #t))) + (r1 (json-set recent-files 'files idx new-item))) + (recent-files-apply-lru r1 25))) + + + +(define (recent-files-index-by-path recent-files path) + (let ((files (json-ref recent-files 'files))) + (let loop ((i 0)) + (if (>= i (vector-length files)) + #f + (let ((item (vector-ref files i))) + (if (equal? (json-ref item 'path) path) + i + (loop (+ i 1)))))))) + +(define (recent-files-paths recent-files) + (let ((files (json-ref recent-files 'files))) + (map (lambda (item) + (list (cons "0" (json-ref item 'path)))) + (vector->list files)))) + + (define (list-but l1 l2) (cond ((null? l1) l1) ((in? (car l1) l2) (list-but (cdr l1) l2)) @@ -179,6 +274,16 @@ (and-with name (procedure-symbol-name fun) (symbol->string name))) +(define (recent-buffer-json file-path) + (let* ((name (url->system (url-tail (system->url file-path)))) + (idx (recent-files-index-by-path interactive-arg-recent-file-json file-path))) + (if idx + (set! interactive-arg-recent-file-json + (recent-files-set interactive-arg-recent-file-json idx)) + (set! interactive-arg-recent-file-json + (recent-files-add interactive-arg-recent-file-json file-path name))))) + + (define-public (learn-interactive fun assoc-t) "Learn interactive values for @fun" (set! assoc-t (map (lambda (x) (cons (car x) (as-stree (cdr x)))) assoc-t)) @@ -186,18 +291,38 @@ (when (symbol? fun) (let* ((l1 (or (ahash-ref interactive-arg-table fun) '())) (l2 (cons assoc-t (list-but l1 (list assoc-t))))) - (ahash-set! interactive-arg-table fun l2)))) + (case fun + ((recent-buffer) + (recent-buffer-json (cdr (car (car l2))))) + (else (ahash-set! interactive-arg-table fun l2))) + ))) + (define-public (learned-interactive fun) "Return learned list of interactive values for @fun" (set! fun (procedure-symbol-name fun)) - (or (ahash-ref interactive-arg-table fun) '())) + (case fun + ((recent-buffer) + (recent-files-paths interactive-arg-recent-file-json)) + (else + (or (ahash-ref interactive-arg-table fun) '())))) + + + (define-public (forget-interactive fun) "Forget interactive values for @fun" (set! fun (procedure-symbol-name fun)) (when (symbol? fun) - (ahash-remove! interactive-arg-table fun))) + (case fun + ((recent-buffer) + (set! interactive-arg-recent-file-json + (json-set + (json-set interactive-arg-recent-file-json 'files #()) + 'meta 'total 0))) + (else + (ahash-remove! interactive-arg-table fun))))) + (define (learned-interactive-arg fun nr) (let* ((l (learned-interactive fun)) @@ -310,7 +435,9 @@ (define (save-learned) (with l (ahash-table->list interactive-arg-table) - (save-object "$TEXMACS_HOME_PATH/system/interactive.scm" l))) + (save-object "$TEXMACS_HOME_PATH/system/interactive.scm" l) + (path-write-text "$TEXMACS_HOME_PATH/system/recent-files.json" + (json->string interactive-arg-recent-file-json)))) (define (ahash-set-2! t x) (with (key . l) x @@ -342,7 +469,12 @@ (let* ((l (load-object "$TEXMACS_HOME_PATH/system/interactive.scm")) (old? (and (pair? l) (pair? (car l)) (list-2? (caar l)))) (decode (if old? decode-old list->ahash-table))) - (set! interactive-arg-table (decode l))))) + (set! interactive-arg-table (decode l)))) + (if (url-exists? "$TEXMACS_HOME_PATH/system/recent-files.json") + (set! interactive-arg-recent-file-json + (string->json + (path-read-text "$TEXMACS_HOME_PATH/system/recent-files.json"))))) + (on-entry (retrieve-learned)) (on-exit (save-learned)) diff --git a/TeXmacs/progs/texmacs/menus/file-menu.scm b/TeXmacs/progs/texmacs/menus/file-menu.scm index b09a57f10e..39143e7506 100644 --- a/TeXmacs/progs/texmacs/menus/file-menu.scm +++ b/TeXmacs/progs/texmacs/menus/file-menu.scm @@ -86,7 +86,9 @@ (let* ((short-name `(verbatim ,(short-menu-name name))) (long-name `(verbatim ,(long-menu-name name)))) ((balloon (eval short-name) (eval long-name)) - (if win? (load-document name) (load-buffer name)))))) + (begin + (if win? (load-document name) (load-buffer name)) + (when (not (url-exists? (url->system name))) (recent-files-remove-by-path (url->system name)))))))) (tm-define (recent-file-list nr) (let* ((l1 (map cdar (learned-interactive "recent-buffer"))) diff --git a/TeXmacs/progs/texmacs/texmacs/tm-files.scm b/TeXmacs/progs/texmacs/texmacs/tm-files.scm index 62988d10b2..0afd353366 100644 --- a/TeXmacs/progs/texmacs/texmacs/tm-files.scm +++ b/TeXmacs/progs/texmacs/texmacs/tm-files.scm @@ -177,7 +177,8 @@ u))) (tm-define (buffer->windows-of-tabpage buf) - (remove (lambda (vw) (url-none? vw)) (map view->window-of-tabpage (buffer->views buf)))) + (remove (lambda (vw) (or (not vw) (url-none? vw))) + (map view->window-of-tabpage (buffer->views buf)))) (tm-define (switch-to-buffer* buf) (let* ((wins (buffer->windows-of-tabpage buf)) diff --git a/devel/201_71.md b/devel/201_71.md new file mode 100644 index 0000000000..13c0018a28 --- /dev/null +++ b/devel/201_71.md @@ -0,0 +1,10 @@ +# [201_71] 使用json来存储最近使用的文件 + +## 如何测试 +1. 点击`文件->打开`，打开几个文件。 +2. 点击`文件->最近使用`，能看到刚刚打开的几个文件。 +3. 关闭一个文件a,再点击`文件->最近使用`打开文件a,观察能否打开成功，随后点击`文件->最近使用`，文件a的选项在第一处。 +4. 点击`文件->最近使用`，选择一个已经打开的文件，会跳转过去，随后点击`文件->最近使用`，选择的文件位于第一处。 +5. 删除一个文件，再尝试通过`文件->最近使用`打开它，会弹出窗口提示文件不存在，随后点击`文件->最近使用`，观察该文件是否存在。 + +## 2026/02/04 使用json来存储最近使用的文件 \ No newline at end of file From 41d7b99e80b7b8010bb025a02af54b970bf0b8f0 Mon Sep 17 00:00:00 2001 From: wumo Date: Thu, 5 Feb 2026 11:20:48 +0800 Subject: [PATCH 2/4] wip --- TeXmacs/progs/kernel/texmacs/tm-dialogue.scm | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm b/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm index 46e7349fce..badfcf346e 100644 --- a/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm +++ b/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm @@ -15,8 +15,7 @@ (:use (kernel texmacs tm-define))) (import (liii json) (liii time) - (liii list) - (liii path)) + (liii list)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Questions with user interaction ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -436,8 +435,9 @@ (define (save-learned) (with l (ahash-table->list interactive-arg-table) (save-object "$TEXMACS_HOME_PATH/system/interactive.scm" l) - (path-write-text "$TEXMACS_HOME_PATH/system/recent-files.json" - (json->string interactive-arg-recent-file-json)))) + (string-save + (json->string interactive-arg-recent-file-json) + (string->url "$TEXMACS_HOME_PATH/system/recent-files.json")))) (define (ahash-set-2! t x) (with (key . l) x @@ -473,7 +473,8 @@ (if (url-exists? "$TEXMACS_HOME_PATH/system/recent-files.json") (set! interactive-arg-recent-file-json (string->json - (path-read-text "$TEXMACS_HOME_PATH/system/recent-files.json"))))) + (string-load + (string->url "$TEXMACS_HOME_PATH/system/recent-files.json")))))) (on-entry (retrieve-learned)) From 83c0db4bcca87d0f36f34d46937fdf9fd0307de5 Mon Sep 17 00:00:00 2001 From: wumo Date: Mon, 9 Feb 2026 14:26:41 +0800 Subject: [PATCH 3/4] wip --- devel/{201_71.md => 201_78.md} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename devel/{201_71.md => 201_78.md} (100%) diff --git a/devel/201_71.md b/devel/201_78.md similarity index 100% rename from devel/201_71.md rename to devel/201_78.md From 547f10e9caacf3a7b5b55615e35c8e738ae8964f Mon Sep 17 00:00:00 2001 From: wumo Date: Mon, 9 Feb 2026 14:56:06 +0800 Subject: [PATCH 4/4] wip --- TeXmacs/progs/kernel/texmacs/tm-dialogue.scm | 82 +++++++++++++++++++- TeXmacs/progs/texmacs/menus/file-menu.scm | 3 +- 2 files changed, 83 insertions(+), 2 deletions(-) diff --git a/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm b/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm index badfcf346e..fa5d03b4ec 100644 --- a/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm +++ b/TeXmacs/progs/kernel/texmacs/tm-dialogue.scm @@ -166,6 +166,32 @@ (files . #()))) +#| +recent-files-remove-by-path +按路径从最近文件缓存中删除对应条目。 + +语法 +---- +(recent-files-remove-by-path path) + +参数 +---- +path : string + 目标文件路径。用于在 `interactive-arg-recent-file-json` 的 `files` + 列表中定位要移除的记录。 + +返回值 +---- +unspecified +- 函数通过副作用更新全局变量 `interactive-arg-recent-file-json`。 +- 若路径不存在，则不做任何修改。 + +逻辑 +---- +1. 调用 `recent-files-index-by-path` 查找 `path` 在 `files` 中的索引。 +2. 若找到索引，调用 `json-drop` 删除该项。 +3. 将删除后的 JSON 结构回写到 `interactive-arg-recent-file-json`。 +|# (define-public (recent-files-remove-by-path path) (let ((idx (recent-files-index-by-path interactive-arg-recent-file-json path))) (when idx @@ -297,6 +323,33 @@ ))) +#| +learned-interactive +读取交互命令已学习的参数候选值。 + +语法 +---- +(learned-interactive fun) + +参数 +---- +fun : procedure | symbol | string + 目标命令。函数内部会先调用 `procedure-symbol-name` 归一化为符号。 + +返回值 +---- +list +- 当命令是 `recent-buffer` 时：返回最近文件路径列表，元素形如 + `(("0" . 文件路径))`。 +- 其他命令：返回 `interactive-arg-table` 中为该命令记录的历史参数列表。 +- 若无记录，返回空列表 `()`。 + +逻辑 +---- +1. 归一化：将 `fun` 转为符号名。 +2. 分支：`recent-buffer` 走最近文件 JSON 缓存分支。 +3. 默认：从 `interactive-arg-table` 读取命令历史，缺省为 `()`。 +|# (define-public (learned-interactive fun) "Return learned list of interactive values for @fun" (set! fun (procedure-symbol-name fun)) @@ -309,6 +362,33 @@ +#| +forget-interactive +清除指定交互命令的已学习参数。 + +语法 +---- +(forget-interactive fun) + +参数 +---- +fun : procedure | symbol | string + 目标命令。函数内部会先调用 `procedure-symbol-name` 归一化为符号。 + +返回值 +---- +unspecified +- 通过副作用修改全局状态。 +- 若 `fun` 不能归一化为符号，则不执行清除操作。 + +逻辑 +---- +1. 归一化：将 `fun` 转为符号名。 +2. 校验：仅当 `fun` 是符号时继续。 +3. 分支清理： + - `recent-buffer`：将最近文件列表重置为空向量 `#()`，并把计数清零。 + - 其他命令：从 `interactive-arg-table` 中删除对应键。 +|# (define-public (forget-interactive fun) "Forget interactive values for @fun" (set! fun (procedure-symbol-name fun)) @@ -470,7 +550,7 @@ (old? (and (pair? l) (pair? (car l)) (list-2? (caar l)))) (decode (if old? decode-old list->ahash-table))) (set! interactive-arg-table (decode l)))) - (if (url-exists? "$TEXMACS_HOME_PATH/system/recent-files.json") + (when (url-exists? "$TEXMACS_HOME_PATH/system/recent-files.json") (set! interactive-arg-recent-file-json (string->json (string-load diff --git a/TeXmacs/progs/texmacs/menus/file-menu.scm b/TeXmacs/progs/texmacs/menus/file-menu.scm index 39143e7506..d68b9d7a3c 100644 --- a/TeXmacs/progs/texmacs/menus/file-menu.scm +++ b/TeXmacs/progs/texmacs/menus/file-menu.scm @@ -88,7 +88,8 @@ ((balloon (eval short-name) (eval long-name)) (begin (if win? (load-document name) (load-buffer name)) - (when (not (url-exists? (url->system name))) (recent-files-remove-by-path (url->system name)))))))) + (when (not (url-exists? (url->system name))) + (recent-files-remove-by-path (url->system name)))))))) (tm-define (recent-file-list nr) (let* ((l1 (map cdar (learned-interactive "recent-buffer")))