[1292] 采用 QML 对话框重构增加宏包弹窗并增加存在性校验 (#4534)

Co-authored-by: Claude <noreply@anthropic.com>

Author: da-liii

TeXmacs/plugins/lang/dic/en_US/zh_CN.scm

@@ -1946,6 +1946,8 @@
 ("overline" "上划线")
 ("overlined block" "上划线块")
 ("overview of the scheme extension language" "Scheme 扩展语言概览")
+("package added: " "宏包已添加: ")
+("package does not exist: " "宏包不存在: ")
 ("padded block" "补白块")
 ("padding" "补白")
 ("page bottom margin" "")

TeXmacs/progs/generic/document-menu.scm

@@ -79,7 +79,7 @@
   (-> "Add package"
     (link toggle-package-menu)
     ---
-    ("Add other package" (interactive add-style-package))
+    ("Add other package" (open-add-package-dialog))
   ) ;->
 ) ;menu-bind
 
@@ -1137,7 +1137,7 @@
   (-> "Add style package"
     (link add-package-menu)
     ---
-    ("Other package" (interactive add-style-package))
+    ("Other package" (open-add-package-dialog))
   ) ;->
 ) ;tm-menu
 
@@ -1225,7 +1225,7 @@
     (=> (balloon (icon "tm_add.xpm") "Add style package")
       (link add-package-menu)
       ---
-      ("Other package" (interactive add-style-package))
+      ("Other package" (open-add-package-dialog))
     ) ;=>
     (assuming (tree-is-buffer? t)
      ((balloon (icon "tm_focus_help.xpm") "Describe tag") (focus-help))

TeXmacs/progs/generic/document-style.scm

@@ -173,6 +173,32 @@
   (set-style-list (append (get-style-list) (list pack)))
 ) ;tm-define
 
+;; 从 cpp-add-package-dialog 的返回 tree 里取宏包名。
+;; OK 返回 (tuple (tuple "package" <name>))，Cancel / 关闭返回空 tuple。#f 表示无有效输入。
+(define-public (add-package-result result)
+  (with kvs (cdr (tree->stree result)) (if (nnull? kvs) (caddr (car kvs)) #f))
+) ;define-public
+
+;; 焦点 / 文档 → 增加宏包 → 其他宏包：专用 QML 弹窗（DialogShell + InputField，run_qml_dialog）。
+;; OK 时检查宏包是否存在：存在则 add-style-package 追加；不存在则弹 QML 确认弹窗提示并不予添加。空串 / Cancel / 关闭不追加。
+(tm-define (open-add-package-dialog)
+  (:interactive #t)
+  (with pack
+    (add-package-result (cpp-add-package-dialog))
+    (when (and (string? pack) (!= pack ""))
+      (if (package-exists? pack)
+        (begin
+          (add-style-package pack)
+          (set-message (string-append (translate "Package added: ") pack) "Package")
+        ) ;begin
+        (cpp-confirm-question (string-append (translate "Package does not exist: ") pack)
+          (list (translate "OK"))
+        ) ;cpp-confirm-question
+      ) ;if
+    ) ;when
+  ) ;with
+) ;tm-define
+
 (tm-define (remove-style-package pack)
   (:argument pack "Remove package")
   (:proposals pack (with l (get-style-list) (if (null? l) l (cdr l))))
@@ -196,23 +222,32 @@
   ) ;if
 ) ;tm-define
 
-(define (url-resolve-package name)
+(define-public (url-resolve-package name)
   (let* ((stem-name (string-append name ".stem"))
          (ts-name (string-append name ".ts"))
          (stem-url (url-append "$TEXMACS_STYLE_PATH" stem-name))
-         (stem-local (url-relative (current-buffer) stem-name))
+         (buf (current-buffer))
+         (has-local? (and (url? buf) (not (url-scratch? buf)) (not (url-rooted-tmfs? buf)))
+         ) ;has-local?
+         (stem-local (if has-local? (url-relative buf stem-name) (url-none)))
+         (stem-pkg (url-append "$TEXMACS_PATH/packages" stem-name))
          (ts-url (url-append "$TEXMACS_STYLE_PATH" ts-name))
-         (ts-local (url-relative (current-buffer) ts-name))
+         (ts-local (if has-local? (url-relative buf ts-name) (url-none)))
+         (ts-pkg (url-append "$TEXMACS_PATH/packages" ts-name))
         ) ;
     (with stem-resolved
-      (url-resolve (url-or stem-url stem-local) "r")
+      (url-resolve (url-or stem-url (url-or stem-local stem-pkg)) "r")
       (if (url-none? stem-resolved)
-        (url-resolve (url-or ts-url ts-local) "r")
+        (url-resolve (url-or ts-url (url-or ts-local ts-pkg)) "r")
         stem-resolved
       ) ;if
     ) ;with
   ) ;let*
-) ;define
+) ;define-public
+
+(define-public (package-exists? name)
+  (and (string? name) (!= name "") (not (url-none? (url-resolve-package name))))
+) ;define-public
 
 (tm-define (edit-package-source name)
   (with file-name

TeXmacs/progs/prog/glue-symbols.scm

@@ -216,29 +216,29 @@
     "window-set-buffer" "window-focus" "switch-to-window" "new-buffer"
     "open-buffer-in-window" "open-window" "open-window-geometry" "clone-window"
     "cpp-buffer-close" "cpp-confirm-close" "cpp-confirm-restart"
-    "cpp-form-dialog" "cpp-search-recent-dialog" "cpp-font-selector-dialog"
-    "cpp-paragraph-format-dialog" "cpp-preferences-dialog"
-    "cpp-print-to-file-dialog" "cpp-statistics-dialog" "cpp-version-dialog"
-    "cpp-export-pdf-dialog" "cpp-updater-dialog-open" "cpp-updater-dialog-close"
-    "cpp-wait-dialog-open" "cpp-wait-dialog-close" "cpp-rasterize-widget"
-    "kill-window" "kill-current-window-and-buffer" "project-attach"
-    "project-detach" "project-attached?" "project-get" "alt-window-handle"
-    "alt-window-create-quit" "alt-window-create-plain" "alt-window-create-popup"
-    "alt-window-create-tooltip" "alt-window-delete" "alt-window-show"
-    "alt-window-hide" "alt-window-get-size" "alt-window-set-size"
-    "alt-window-get-position" "alt-window-set-position" "alt-window-search"
-    "supports-bibtex?" "bibtex-run" "bib-add-period" "bib-locase-first"
-    "bib-upcase-first" "bib-locase" "bib-upcase" "bib-default-preserve-case"
-    "bib-default-upcase-first" "bib-purify" "bib-text-length" "bib-prefix"
-    "bib-empty?" "bib-field" "bib-abbreviate" "extract-attachments"
-    "pdf-make-attachments" "pdf-get-linked-file-paths" "pdf-replace-linked-path"
-    "pdf-get-attached-main-tm" "array-url-append" "insert-kbd-wildcard"
-    "set-variant-keys" "kbd-pre-rewrite" "kbd-post-rewrite" "kbd-system-rewrite"
-    "set-font-rules" "window-get-serial" "window-set-property"
-    "window-get-property" "show-header" "show-icon-bar" "show-side-tools"
-    "show-bottom-tools" "show-footer" "visible-header?" "visible-icon-bar?"
-    "visible-side-tools?" "visible-bottom-tools?" "visible-footer?"
-    "full-screen-mode" "full-screen?" "full-screen-edit?"
+    "cpp-form-dialog" "cpp-search-recent-dialog" "cpp-add-package-dialog"
+    "cpp-font-selector-dialog" "cpp-paragraph-format-dialog"
+    "cpp-preferences-dialog" "cpp-print-to-file-dialog" "cpp-statistics-dialog"
+    "cpp-version-dialog" "cpp-export-pdf-dialog" "cpp-updater-dialog-open"
+    "cpp-updater-dialog-close" "cpp-wait-dialog-open" "cpp-wait-dialog-close"
+    "cpp-rasterize-widget" "kill-window" "kill-current-window-and-buffer"
+    "project-attach" "project-detach" "project-attached?" "project-get"
+    "alt-window-handle" "alt-window-create-quit" "alt-window-create-plain"
+    "alt-window-create-popup" "alt-window-create-tooltip" "alt-window-delete"
+    "alt-window-show" "alt-window-hide" "alt-window-get-size"
+    "alt-window-set-size" "alt-window-get-position" "alt-window-set-position"
+    "alt-window-search" "supports-bibtex?" "bibtex-run" "bib-add-period"
+    "bib-locase-first" "bib-upcase-first" "bib-locase" "bib-upcase"
+    "bib-default-preserve-case" "bib-default-upcase-first" "bib-purify"
+    "bib-text-length" "bib-prefix" "bib-empty?" "bib-field" "bib-abbreviate"
+    "extract-attachments" "pdf-make-attachments" "pdf-get-linked-file-paths"
+    "pdf-replace-linked-path" "pdf-get-attached-main-tm" "array-url-append"
+    "insert-kbd-wildcard" "set-variant-keys" "kbd-pre-rewrite"
+    "kbd-post-rewrite" "kbd-system-rewrite" "set-font-rules" "window-get-serial"
+    "window-set-property" "window-get-property" "show-header" "show-icon-bar"
+    "show-side-tools" "show-bottom-tools" "show-footer" "visible-header?"
+    "visible-icon-bar?" "visible-side-tools?" "visible-bottom-tools?"
+    "visible-footer?" "full-screen-mode" "full-screen?" "full-screen-edit?"
     "set-window-zoom-factor" "get-window-zoom-factor" "shell" "dialogue-end"
     "cpp-choose-file" "tm-interactive" "cpp-style-clear-cache"
     "set-script-status" "set-printing-command" "set-printer-paper-type"

TeXmacs/tests/1292.scm

@@ -0,0 +1,84 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; MODULE      : 1292.scm
+;; DESCRIPTION : 「焦点/文档 → 增加宏包 → 其他宏包」QML 迁移的数据契约测试。
+;; COPYRIGHT   : (C) 2026 Mogan STEM
+;;
+;; PURPOSE
+;;   [1292] 验证「其他宏包」改用专用 QML 弹窗后：
+;;     - add-package-result 从 cpp-add-package-dialog 返回 tree 提取宏包名
+;;     - 测试钩子 cancel 返回空 tuple；ok 返回空宏包名；指定包名返回相应包名
+;;     - package-exists? 校验宏包是否存在
+;;     - open-add-package-dialog 在宏包不存在时弹确认提示并不追加，存在时追加宏包
+;;
+;; USAGE
+;;   xmake b stem
+;;   xmake r 1292
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(import (liii check))
+
+(load "./TeXmacs/progs/generic/document-style.scm")
+
+(check-set-mode! 'report-failed)
+
+(define (check-result-ok)
+  (check (add-package-result (stree->tree '(tuple (tuple "package"
+                                                    "preview-ref"))))
+    =>
+    "preview-ref"
+  ) ;check
+) ;define
+
+(define (check-result-cancel)
+  (check (add-package-result (stree->tree '(tuple))) => #f)
+) ;define
+
+(define (check-hook)
+  (system-setenv "MOGAN_TEST_ADD_PACKAGE" "cancel")
+  (check (add-package-result (cpp-add-package-dialog)) => #f)
+  (system-setenv "MOGAN_TEST_ADD_PACKAGE" "ok")
+  (check (add-package-result (cpp-add-package-dialog)) => "")
+  (system-setenv "MOGAN_TEST_ADD_PACKAGE" "preview-ref")
+  (check (add-package-result (cpp-add-package-dialog)) => "preview-ref")
+  (system-setenv "MOGAN_TEST_ADD_PACKAGE" "")
+) ;define
+
+(define (check-package-exists)
+  (check (package-exists? "chinese") => #t)
+  (check (package-exists? "preview-ref") => #t)
+  (check (package-exists? "non-existent-pkg-xyz-12345") => #f)
+  (check (package-exists? "") => #f)
+) ;define
+
+(define (check-dialog-nonexistent-package)
+  (let* ((orig-style (get-style-list)))
+    (system-setenv "MOGAN_TEST_ADD_PACKAGE" "non-existent-pkg-xyz-12345")
+    (system-setenv "MOGAN_TEST_CONFIRM_QUESTION" "0")
+    (open-add-package-dialog)
+    (check (get-style-list) => orig-style)
+    (system-setenv "MOGAN_TEST_ADD_PACKAGE" "")
+    (system-setenv "MOGAN_TEST_CONFIRM_QUESTION" "")
+  ) ;let*
+) ;define
+
+(define (check-dialog-valid-package)
+  (let* ((orig-style (get-style-list)))
+    (system-setenv "MOGAN_TEST_ADD_PACKAGE" "preview-ref")
+    (open-add-package-dialog)
+    (check (has-style-package? "preview-ref") => #t)
+    (system-setenv "MOGAN_TEST_ADD_PACKAGE" "")
+    (set-style-list orig-style)
+  ) ;let*
+) ;define
+
+(tm-define (test_1292)
+  (check-result-ok)
+  (check-result-cancel)
+  (check-hook)
+  (check-package-exists)
+  (check-dialog-nonexistent-package)
+  (check-dialog-valid-package)
+  (check-report)
+) ;tm-define

ai-docs/qml/README.md

@@ -161,6 +161,7 @@ OK 时算与快照的 diff → `prefBridge.submit(diff)` 一次性应用；Cance
 | `FormDialog` | `run_qml_dialog`（exec） | 本地暂存 `values`，OK 一次性 submit（页面设置走此弹窗） |
 | `PrintToFile` | `run_qml_dialog`（exec） | 路径 + 页码一次提交；Browse 走原生保存框 |
 | `SearchRecent` | `run_qml_dialog`（exec） | 搜索词一次提交，scheme 走 `docgrep-in-recent` |
+| `AddPackage` | `run_qml_dialog`（exec） | 宏包名称一次提交，校验存在性后走 `add-style-package` |
 | `FontSelector` | `run_modal_qml_dialog`（setModal+show） | live 写回文档，OK 落定 / Cancel 快照撤销 / Reset 按 global? 分流（文档级系统默认、段落级回快照） |
 | `ParagraphFormat` | `run_modal_qml_dialog`（setModal+show） | live 写回（段落 with / 文档 initial），按 scope 撤销 |
 | `Statistics` | `run_qml_dialog`（exec） | 纯展示统计行（`statsItems` 注入 `{label,value}`），Close 即关，无返回值 |

devel/1292.md

@@ -0,0 +1,64 @@
+# [1292] 增加宏包弹窗 QML 重构
+
+## 1 相关文档
+- [ai-docs/qml/README.md](../ai-docs/qml/README.md) — QML 弹窗体系（DialogShell + atoms + run_qml_dialog；新增成品弹窗/原子的登记流程）
+
+## 2 任务相关的代码文件
+- `src/Plugins/Qt/qml/AddPackage.qml` — 「增加宏包」成品弹窗（DialogShell + InputField + DialogButtons，run_qml_dialog）
+- `src/Plugins/Qt/qml/atoms/InputField.qml` — 增加 `forceFocus()` 辅助方法供打开弹窗时光标自聚焦
+- `src/Plugins/Qt/QTMQmlDialog.cpp` — `cpp_add_package_dialog` glue 实现（run_qml_dialog + 注入 packageLabel/packageName；测试钩子 `MOGAN_TEST_ADD_PACKAGE`）
+- `src/Plugins/Qt/QTMQmlDialog.hpp` — `cpp_add_package_dialog` 声明
+- `src/Plugins/Qt/moganqml.qrc` + `src/Plugins/Qt/qml/qmldir` — AddPackage 注册
+- `TeXmacs/progs/prog/glue-symbols.scm` — `cpp-add-package-dialog` glue 符号
+- `src/Scheme/L5/glue_qt.lua` — `cpp-add-package-dialog` ↔ `cpp_add_package_dialog`
+- `TeXmacs/progs/generic/document-style.scm` — `add-package-result` + `package-exists?` + `open-add-package-dialog`（宏包存在时调 `add-style-package`，不存在时弹 QML 确认弹窗提示）
+- `TeXmacs/plugins/lang/dic/en_US/zh_CN.scm` — 增加「宏包不存在: 」翻译
+- `TeXmacs/progs/generic/document-menu.scm` — 菜单与工具栏中「其他宏包」/「增加其他宏包」改调 `(open-add-package-dialog)`
+- `tests/Plugins/Qt/qml_load_test.cpp` — `test_add_package_loads`（AddPackage.qml 加载断言）
+- `TeXmacs/tests/1292.scm` — 契约与集成测试（add-package-result 提取 + `MOGAN_TEST_ADD_PACKAGE` 钩子）
+- `ai-docs/qml/README.md` — 登记 AddPackage 成品弹窗
+
+## 3 如何测试
+
+### 3.1 确定性测试
+```bash
+# QML 加载回归：AddPackage.qml 仍能 Ready
+xmake b qml_load_test
+xmake r qml_load_test
+
+# 纯逻辑与契约测试：add-package-result 提取 + 钩子 ok/cancel/<name>（headless）
+xmake b stem
+xmake r 1292
+```
+
+### 3.2 手动 GUI 测试
+```bash
+MOGAN_TEST_GUI=1 xmake r 1292
+```
+或直接启动 Mogan：
+点击顶部菜单「文档 → 增加宏包 → 增加其他宏包」或焦点工具栏中的「增加宏包 → 其它宏包」，弹出 QML 对话框，输入宏包名称（如 `preview-ref`），回车或点击 OK，验证文档样式列表成功添加该宏包；按 Esc 或点击取消，验证宏包未被添加。
+
+## 4 如何提交
+```bash
+gf fmt --changed-since=main
+```
+
+## 5 What
+1. 使用专用 QML 弹窗（`DialogShell` + `InputField` + `DialogButtons` + `run_qml_dialog`）重构「增加宏包 -> 其他宏包...」弹窗，替换旧的 `(interactive add-style-package)` C++ 遗留对话框。
+2. 在 Scheme 侧新增 `(open-add-package-dialog)` 统一入口，解构返回值并调用 `(add-style-package pack)`。
+3. 替换 `document-menu.scm` 中焦点菜单、焦点图标栏及文档菜单中的调用点。
+4. 校验输入的宏包是否存在：若不存在，弹出 QML 确认弹窗提示并不予添加。
+
+## 6 Why
+- 原有 `(interactive add-style-package)` 依赖 C++ 遗留的 `qt_inputs_list_widget_rep` 对话框，风格陈旧且无法适配现代 UI 主题。
+- 与其他已迁移至 QML 的模态弹窗（如搜索最近打开的文档、打印到文件、页面设置等）保持一致的交互与视觉体验。
+
+## 7 How
+- `AddPackage.qml` 基于 `DialogShell` 和 `InputField` 构建，提供宏包名称输入、回车提交及 Esc 取消。
+- C++ 层 `cpp_add_package_dialog` 通过 `run_qml_dialog` 启动模态对话框，注入已翻译文案，并提供 `MOGAN_TEST_ADD_PACKAGE` 测试钩子。
+- Scheme 侧 `open-add-package-dialog` 接收结果后验证包名非空，先调用 `package-exists?` 检测宏包是否存在；存在则触发 `add-style-package`，不存在则调用 `cpp-confirm-question` 弹窗告知用户。
+
+## 8 简化清理（/simplify）
+- `QTMQmlDialog.cpp`：启用已有但从未被调用的 `kv_map_to_tree`，替换 form / 搜索最近文档 / 打印到文件 / 增加宏包四处逐键拷贝的 QVariantMap→tree 循环（导出 PDF 走 `from_qstring_utf8`，保持原样）；合并 `MOGAN_TEST_ADD_PACKAGE` 钩子 ok 与 `<name>` 两个重复分支。
+- `document-style.scm`：`open-add-package-dialog` 去掉只消费一次的外层 `with result`。
+- `InputField.qml`：删除无消费者的 `isComposing` 只读属性。