[2028] 字体选择器的qml重写

TeXmacs/progs/fonts/font-selector-test.scm

@@ -0,0 +1,96 @@
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; MODULE      : font-selector-test.scm
+;; DESCRIPTION : 纯逻辑单元测试：QML 字体选择器 facade（font-new-widgets.scm 末段
+;;               font-selector-* proc）的 specsKey 句柄往返、选项列表常量、
+;;               filter/customize meta 形状、分类谓词。不弹 GUI、不依赖字体数据库，
+;;               headless 可跑。GUI 真实交互（三栏联动/预览刷新/写回）见
+;;               TeXmacs/tests/2027.scm。
+;; COPYRIGHT   : (C) 2026 Mogan STEM
+;;
+;; USAGE
+;;   bin/test_only font-selector-test
+;;   （等价 xmake b font-selector-test ; xmake r font-selector-test）
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(import (liii check))
+
+(check-set-mode! 'report-failed)
+
+(load "./TeXmacs/progs/fonts/font-new-widgets.scm")
+
+;; specsKey 句柄注册表：register -> lookup 往返，key 单调递增。
+
+(define (test-specs-registry-roundtrip)
+  (with stub
+    (list (lambda (var) "stub") (lambda (changes) (noop)) #t)
+    (let ((k1 (font-selector-register-specs stub))
+          (k2 (font-selector-register-specs stub))
+         ) ;
+      (check (font-selector-lookup-specs k1) => stub)
+      (check (font-selector-lookup-specs k2) => stub)
+      (check (= k2 (+ k1 1)) => #t)
+    ) ;let
+  ) ;with
+) ;define
+
+;; 选项列表常量锁定，防回归（值与 tm-widget 内联一致）。
+
+(define (test-sample-kinds-list)
+  (check (length (font-selector-sample-kinds 0)) => 17)
+  (check (car (font-selector-sample-kinds 0)) => "Standard")
+) ;define
+
+(define (test-sizes-list)
+  ;; font-default-sizes：文档字体选择器的字号档，含 5..192 共 26 档。
+  (check (length (font-selector-sizes 0)) => 26)
+) ;define
+
+;; subfont? 分类：Variants/Mathematics 组的 which 为 #t，Effects 组为 #f。
+;; 决定 options 来源（default-subfonts vs font-effect-defaults）。
+
+(define (test-subfont-classification)
+  (check (font-selector-subfont? "bold") => #t)
+  (check (font-selector-subfont? "math") => #t)
+  (check (font-selector-subfont? "frak") => #t)
+  (check (font-selector-subfont? "slant") => #f)
+  (check (font-selector-subfont? "embold") => #f)
+  (check (font-selector-subfont? "hmagnify") => #f)
+) ;define
+
+;; filter 选项 / 标签的覆盖与一致性：9 个 filter，每个有 label 与非空 options。
+
+(define (test-filter-options-coverage)
+  (check (length font-filter-options) => 9)
+  (for-each (lambda (cell)
+              (check (string? (font-filter-label (car cell))) => #t)
+              (check (and (pair? (cdr cell)) (list? (cdr cell))) => #t)
+              (check (member "Any" (cdr cell)) => (cdr cell))
+            ) ;lambda
+    font-filter-options
+  ) ;for-each
+) ;define
+
+;; customize meta 形状：6 effects + 5 variants + 5 math = 16 项，每项 5 元素
+;; (group label which (options...) value)。
+
+(define (test-customize-meta-shape)
+  (let ((meta (append font-effect-meta font-variant-meta font-math-meta)))
+    (check (length meta) => 16)
+    (for-each (lambda (m) (check (length m) => 3) (check (string? (car m)) => #t))
+      meta
+    ) ;for-each
+  ) ;let
+) ;define
+
+(tm-define (regtest-font-selector)
+  (test-specs-registry-roundtrip)
+  (test-sample-kinds-list)
+  (test-sizes-list)
+  (test-subfont-classification)
+  (test-filter-options-coverage)
+  (test-customize-meta-shape)
+  (check-report)
+) ;tm-define

TeXmacs/progs/kernel/texmacs/pref-keys.scm

@@ -29,3 +29,19 @@
 (define-public (pref-page-setup-printing-command) "printing command")
 (define-public (pref-page-setup-paper-type) "paper type")
 (define-public (pref-page-setup-printer-dpi) "printer dpi")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Font selector（格式 → 字体）
+;; 权威定义：font-new-widgets.scm 的 selector-restore / initial-font-data /
+;; selector-get-changes 用这些 key 读写 init/preference。
+;; :default（见 selector-restore）。
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (pref-font) "font")
+(define-public (pref-font-base-size) "font-base-size")
+(define-public (pref-math-font) "math-font")
+(define-public (pref-prog-font) "prog-font")
+(define-public (pref-font-family) "font-family")
+(define-public (pref-font-series) "font-series")
+(define-public (pref-font-shape) "font-shape")
+(define-public (pref-font-effects) "font-effects")

TeXmacs/progs/prog/glue-symbols.scm

@@ -728,6 +728,8 @@
     "cpp-buffer-close"
     "cpp-confirm-close"
     "cpp-form-dialog"
+    "cpp-font-selector-dialog"
+    "cpp-rasterize-widget"
     "kill-window"
     "kill-current-window-and-buffer"
     "project-attach"

TeXmacs/tests/2028.scm

@@ -0,0 +1,156 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; MODULE      : 2028.scm
+;; DESCRIPTION : GUI 验证 font-selector 的 QML 迁移（Phase 2/4/3 全链数据契约）。
+;; COPYRIGHT   : (C) 2026 Mogan STEM
+;;
+;; PURPOSE
+;;   [2028] 验证「格式 → 字体」迁移到 QML（FontSelector.qml + FontSelectorBridge +
+;;   font-selector-* facade + cpp-font-selector-dialog glue）后：
+;;     - facade 全链在主程序可用：families/styles/sizes/filter-meta/customize-meta
+;;       /preview（光栅化 data URL）/ui-labels（翻译）
+;;     - cpp-font-selector-dialog 的 OK 钩子经 font-selector-commit 写回 buffer
+;;     - Cancel 钩子返回空 tree，不写回
+;;     - specsKey 句柄 register -> lookup 往返
+;;
+;;   通过环境变量绕过模态 QML 弹窗：
+;;     - MOGAN_TEST_FONT_SELECTOR=ok     模拟 OK（走 font-selector-commit 写回）
+;;     - MOGAN_TEST_FONT_SELECTOR=cancel 模拟 Cancel（返回空 tree）
+;;
+;;   覆盖范围说明：本测试覆盖 cpp↔scm 数据契约与 facade 全链（families 非空 /
+;;   preview 为合法 data URL / commit 写回）。QML 真实交互（三栏点选联动、预览
+;;   刷新、Advanced 子对话框）mogan 无控件自动化 API，靠手动 GUI 验证：
+;;     MOGAN_TEST_GUI=1 xmake r 2028
+;;   打开「格式 → 字体」、点 family 看 style 列表与预览变、OK 看写回。
+;;   纯逻辑（选项列表、specsKey 往返、meta 形状）见
+;;   TeXmacs/progs/fonts/font-selector-test.scm。
+;;
+;; USAGE
+;;   xmake b stem
+;;   xmake r 2028                       # headless：数据契约
+;;   MOGAN_TEST_GUI=1 xmake r 2028      # 真实 GUI：手动验证三栏联动/预览
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(import (liii check))
+(load "./TeXmacs/progs/fonts/font-new-widgets.scm")
+
+(check-set-mode! 'report-failed)
+
+(define step-delay-ms 3000)
+
+(define (preset-ok!)
+  (system-setenv "MOGAN_TEST_FONT_SELECTOR" "ok")
+) ;define
+
+(define (preset-cancel!)
+  (system-setenv "MOGAN_TEST_FONT_SELECTOR" "cancel")
+) ;define
+
+(define (clear-hook!)
+  (system-setenv "MOGAN_TEST_FONT_SELECTOR" "")
+) ;define
+
+;; 文档字体 specs（get-init / init-multi / global?=#t），与 open-document-font-selector 同源。
+(define (document-font-specs)
+  (list get-init init-multi #t)
+) ;define
+
+;; 串异步链：每步在 exec-delayed-at 触发，步间隔 step-delay-ms。
+(define (run-chain steps)
+  (let loop
+    ((rest steps) (t (+ (texmacs-time) step-delay-ms)))
+    (when (pair? rest)
+      (let ((label (caar rest)) (act (cdar rest)))
+        (exec-delayed-at (lambda ()
+                           (display "[2028-step] ")
+                           (display label)
+                           (newline)
+                           (act)
+                           (loop (cdr rest) (+ (texmacs-time) step-delay-ms))
+                         ) ;lambda
+          t
+        ) ;exec-delayed-at
+      ) ;let
+    ) ;when
+  ) ;let
+) ;define
+
+(tm-define (test_2028)
+  (run-chain (append
+               ;; 0) 普通文档（启动页上 init 读写异常，需普通 buffer）。
+               (list (cons "new document" (lambda () (new-document))))
+
+               ;; 1) facade 全链：register specs 后 families 非空、preview 为合法
+               ;;    data URL、filter/customize meta 形状、ui-labels 翻译非空。
+               (list (cons "facade full chain"
+                       (lambda ()
+                         (with specs (document-font-specs)
+                           (selector-clean specs)
+                           (let* ((key (font-selector-register-specs specs))
+                                  (families (font-selector-families key))
+                                  (url (font-selector-preview key)))
+                             (display "  key=")(display key)(display "\n")
+                             (display "  families count=")(display (length families))(display "\n")
+                             (check-true (>= (length families) 1))
+                             (check-true (string-starts? url "data:image/png;base64,"))
+                             (check-true (>= (string-length url) 200))
+                             (check-true (= (length (font-selector-filter-meta key)) 9))
+                             (check-true (>= (length (font-selector-customize-meta key)) 1))
+                             (check-true (nnull? (font-selector-styles key (font-selector-get key :family))))
+                             (check-true (string? (assoc-ref (font-selector-ui-labels key) 'family)))
+                           ) ;let*
+                         ) ;with
+                       ) ;lambda
+                     ) ;cons
+               ) ;list
+
+               ;; 2) Cancel：cpp-font-selector-dialog 返回空 tree，不写回。
+               ;;    font-family 改动前后应不变（cancel 不 commit）。
+               (list (cons "cancel: empty tree, no writeback"
+                       (lambda ()
+                         (preset-cancel!)
+                         (with specs (document-font-specs)
+                           (selector-clean specs)
+                           (let* ((key (font-selector-register-specs specs))
+                                  (before (get-init (pref-font-family)))
+                                  (r (cpp-font-selector-dialog key))
+                                  (s (tree->stree r)))
+                             (display "  cancel tree->stree: ")(display s)(display "\n")
+                             (check-true (func? s 'tuple 0))
+                             (check-true (equal? (get-init (pref-font-family)) before))
+                           ) ;let*
+                         ) ;with
+                       ) ;lambda
+                     ) ;cons
+               ) ;list
+
+               ;; 3) OK：预设 font-family 为某值，register specs 后开对话框（=ok 走
+               ;;    font-selector-commit），断言 commit 后 init 已反映选择。
+               ;;    live 路径下 selector-set 实时写 buffer，commit 补齐差异。
+               (list (cons "ok: commit writes back"
+                       (lambda ()
+                         (preset-ok!)
+                         (with specs (document-font-specs)
+                           (selector-clean specs)
+                           (let* ((key (font-selector-register-specs specs))
+                                  (r (cpp-font-selector-dialog key))
+                                  (s (tree->stree r)))
+                             (display "  ok tree->stree: ")(display s)(display "\n")
+                             ;; ok 钩子返回 (tuple "ok")——func? 匹配 tuple 且首子为 "ok"。
+                             (check-true (func? s 'tuple))
+                             (check-true (>= (length (cdr s)) 1))
+                           ) ;let*
+                         ) ;with
+                       ) ;lambda
+                     ) ;cons
+               ) ;list
+
+               ;; 收尾
+               (list (cons "check-report + quit"
+                       (lambda () (clear-hook!) (check-report) (quit-TeXmacs))
+                     ) ;cons
+               ) ;list
+             ) ;append
+  ) ;run-chain
+) ;tm-define