diff --git a/TeXmacs/progs/fonts/font-new-widgets.scm b/TeXmacs/progs/fonts/font-new-widgets.scm
index 232245f775..910dece3ee 100644
--- a/TeXmacs/progs/fonts/font-new-widgets.scm
+++ b/TeXmacs/progs/fonts/font-new-widgets.scm
@@ -15,6 +15,7 @@
(texmacs-module (fonts font-new-widgets)
(:use (kernel gui menu-widget)
+ (kernel texmacs pref-keys)
(fonts font-sample)
(generic format-edit)
(generic document-edit)
@@ -142,14 +143,14 @@
(when global?
;; NOTE: non global => ':default' values not yet implemented
(with vars
- (list "font"
- "font-base-size"
- "math-font"
- "prog-font"
- "font-family"
- "font-series"
- "font-shape"
- "font-effects"
+ (list (pref-font)
+ (pref-font-base-size)
+ (pref-math-font)
+ (pref-prog-font)
+ (pref-font-family)
+ (pref-font-series)
+ (pref-font-shape)
+ (pref-font-effects)
) ;list
(with (getter setter . other)
specs
@@ -285,11 +286,11 @@
(define (initial-font-data specs)
(let* ((getter (car specs))
- (fam (font-family-main (getter "font")))
- (var (getter "font-family"))
- (ser (getter "font-series"))
- (sh (getter "font-shape"))
- (sz (getter "font-base-size"))
+ (fam (font-family-main (getter (pref-font))))
+ (var (getter (pref-font-family)))
+ (ser (getter (pref-font-series)))
+ (sh (getter (pref-font-shape)))
+ (sz (getter (pref-font-base-size)))
(lf (logical-font-private fam var ser sh))
(fn (logical-font-search-exact lf))
) ;
@@ -313,23 +314,23 @@
(selector-get-font specs)
(with l
'()
- (when (!= (selector-font-effects specs) (getter "font-effects"))
- (set! l (cons* "font-effects" (selector-font-effects specs) l))
+ (when (!= (selector-font-effects specs) (getter (pref-font-effects)))
+ (set! l (cons* (pref-font-effects) (selector-font-effects specs) l))
) ;when
- (when (!= (selector-get specs :size) (getter "font-base-size"))
- (set! l (cons* "font-base-size" (selector-get specs :size) l))
+ (when (!= (selector-get specs :size) (getter (pref-font-base-size)))
+ (set! l (cons* (pref-font-base-size) (selector-get specs :size) l))
) ;when
- (when (!= (logical-font-shape fn) (getter "font-shape"))
- (set! l (cons* "font-shape" (logical-font-shape fn) l))
+ (when (!= (logical-font-shape fn) (getter (pref-font-shape)))
+ (set! l (cons* (pref-font-shape) (logical-font-shape fn) l))
) ;when
- (when (!= (logical-font-series fn) (getter "font-series"))
- (set! l (cons* "font-series" (logical-font-series fn) l))
+ (when (!= (logical-font-series fn) (getter (pref-font-series)))
+ (set! l (cons* (pref-font-series) (logical-font-series fn) l))
) ;when
- (when (!= (logical-font-variant fn) (getter "font-family"))
- (set! l (cons* "font-family" (logical-font-variant fn) l))
+ (when (!= (logical-font-variant fn) (getter (pref-font-family)))
+ (set! l (cons* (pref-font-family) (logical-font-variant fn) l))
) ;when
- (when (!= (logical-font-family* specs fn) (getter "font"))
- (set! l (cons* "font" (logical-font-family* specs fn) l))
+ (when (!= (logical-font-family* specs fn) (getter (pref-font)))
+ (set! l (cons* (pref-font) (logical-font-family* specs fn) l))
) ;when
l
) ;with
@@ -358,16 +359,6 @@
) ;let*
) ;define
-(define (selector-font-simulate-comment specs)
- (with (fn1 fn1+ fn2)
- (selector-font-simulate-data specs)
- (if (and (== fn1 fn1+) (== fn1 fn2))
- ""
- (string-append " (" fn1+ " -> " fn2 ")")
- ) ;if
- ) ;with
-) ;define
-
(tm-widget (selector-font-simulate-widget specs)
(with (fn1 fn1+ fn2)
(selector-font-simulate-data specs)
@@ -647,27 +638,6 @@
) ;resize
) ;tm-widget
-(tm-widget (font-family-selector specs)
- (vertical (bold (text "Font family"))
- ===
- (dynamic (font-family-selector* specs))
- ) ;vertical
-) ;tm-widget
-
-(tm-widget (font-style-selector specs)
- (vertical (bold (text "Style"))
- ===
- (resize "200px"
- "350px"
- (scrollable (choice (selector-set specs :style answer)
- (selected-styles specs (selector-get specs :family))
- (selector-get specs :style)
- ) ;choice
- ) ;scrollable
- ) ;resize
- ) ;vertical
-) ;tm-widget
-
(tm-widget (font-style-selector* specs)
(hlist (bold (text "Style"))
//
@@ -680,20 +650,6 @@
) ;hlist
) ;tm-widget
-(tm-widget (font-size-selector specs)
- (vertical (bold (text "Size"))
- ===
- (resize "75px"
- "350px"
- (scrollable (choice (selector-set specs :size answer)
- (font-default-sizes)
- (selector-get specs :size)
- ) ;choice
- ) ;scrollable
- ) ;resize
- ) ;vertical
-) ;tm-widget
-
(tm-widget (font-size-selector* specs)
(hlist (bold (text "Size"))
//
@@ -714,18 +670,6 @@
(if (== (get-preference "gui theme") "liii-night") "#e0e0e0" "black")
) ;define
-(tm-widget (font-sample-text specs)
- (texmacs-output `(with ,"bg-color"
- ,(font-sample-bg-color)
- ,"color"
- ,(font-sample-fg-color)
- ,"magnification"
- ,"1.6"
- ,(selector-font-demo-text specs))
- '(style "generic")
- ) ;texmacs-output
-) ;tm-widget
-
(tm-widget (font-properties-selector* specs)
(aligned
;; (item (text "Base family:")
@@ -835,13 +779,6 @@
;; >>>)
) ;tm-widget
-(tm-widget (font-properties-selector specs)
- (vertical (horizontal (glue #f #f 0 0) (bold (text "Filter")) (glue #f #f 0 0))
- ===
- (dynamic (font-properties-selector* specs))
- ) ;vertical
-) ;tm-widget
-
(define (font-effect-defaults which)
(cond ((== which "embold") '("1" "1.25" "1.5" "2" "2.5" "3" "3.5" "4" ""))
((== which "embbb") '("1" "1.5" "2" "2.5" "3" "3.5" "4" "4.5" "5" ""))
@@ -957,54 +894,6 @@
) ;vertical
) ;tm-widget
-(tm-widget (font-customized-selector specs)
- (assuming (selector-customize?)
- ===
- ===
- ===
- (hlist (bold (text "Font customization")) >>>)
- ===
- (horizontal (dynamic (font-effects-selector specs))
- >>>
- (dynamic (font-variant-selector specs))
- >>>
- (dynamic (font-math-selector specs))
- ) ;horizontal
- ===
- ===
- ===
- ) ;assuming
- (assuming (not (selector-customize?)) === === ===)
-) ;tm-widget
-
-(tm-widget ((font-customization-dialog specs) quit)
- (padded ===
- ===
- ===
- (hlist (bold (text "Font customization")) >>>)
- ===
- (horizontal (dynamic (font-effects-selector specs))
- >>>
- (dynamic (font-variant-selector specs))
- >>>
- (dynamic (font-math-selector specs))
- ) ;horizontal
- ===
- ===
- ===
- (explicit-buttons (hlist >>> ("Done" (quit))))
- ) ;padded
-) ;tm-widget
-
-(tm-widget (font-selector-demo specs)
- (hlist (bold (text "Sample text"))
- (text (selector-font-simulate-comment specs))
- >>>
- ) ;hlist
- ===
- (resize "880px" "225px" (scrollable (dynamic (font-sample-text specs))))
-) ;tm-widget
-
(tm-define (font-import name)
(font-database-extend-local name)
(refresh-now "font-family-selector")
@@ -1017,70 +906,6 @@
;; Main widgets
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(tm-widget ((font-selector specs global?) quit)
- (padded (horizontal (refreshable "font-family-selector" (dynamic (font-family-selector specs)))
- ///
- (refreshable "font-style-selector" (dynamic (font-style-selector specs)))
- ///
- (refreshable "font-size-selector" (dynamic (font-size-selector specs)))
- ///
- (dynamic (font-properties-selector specs))
- ) ;horizontal
- (refreshable "font-customized-selector"
- (dynamic (font-customized-selector specs))
- ) ;refreshable
- (refreshable "font-selector-demo"
- (promise (menu-dynamic (dynamic (font-selector-demo specs))))
- ) ;refreshable
- ===
- ===
- (explicit-buttons (hlist (enum (set-font-sample-kind answer)
- '("Standard"
- "Mathematics"
- "Selection"
- "ASCII"
- "Latin"
- "Greek"
- "Cyrillic"
- "CJK"
- "Hangul"
- "Math Symbols"
- "Math Extra"
- "Math Letters"
- "Unicode 0000-0fff"
- "Unicode 1000-1fff"
- "Unicode 2000-2fff"
- "Unicode 3000-3fff"
- "Unicode 4000-4fff")
- (get-font-sample-kind)
- "20em"
- ) ;enum
- >>>
- (assuming (not (selector-customize?))
- ("Advanced"
- (dialogue-window (font-customization-dialog specs)
- noop
- "Advanced font selector"
- ) ;dialogue-window
- ) ;
- //
- //
- ) ;assuming
- ("Import" (choose-file font-import "Import font" ""))
- //
- //
- (if global?
- ("Reset" (selector-restore specs global?))
- //
- //
- ("Ok" (quit (selector-get-changes specs get-init)))
- ) ;if
- (if (not global?) ("Ok" (quit (selector-get-changes specs get-env))))
- ) ;hlist
- ) ;explicit-buttons
- ) ;padded
-) ;tm-widget
-
(tm-tool* (font-tool win name getter setter global?)
(:name name)
(with tool
@@ -1135,12 +960,16 @@
;; High level window interface
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 三个 window 入口切到 QML:register-specs 存 specs 拿 int 句柄,cpp-font-selector-dialog
+;; exec QML 对话框,fontBridge 调 font-selector-* facade 透传交互。live 路径下
+;; selector-set 已实时写回,OK 经 font-selector-commit 补齐差异;Cancel 不回滚
+;; (既有契约)。返回 tree 仅测试用,正常路径忽略。
(tm-define (open-font-selector-window)
(:interactive #t)
(with specs
(list get-env make-multi-with #f)
(selector-clean specs)
- (dialogue-window (font-selector specs #f) make-multi-with "Font selector")
+ (cpp-font-selector-dialog (font-selector-register-specs specs))
) ;with
) ;tm-define
@@ -1149,7 +978,7 @@
(with specs
(list get-init init-multi #t)
(selector-clean specs)
- (dialogue-window (font-selector specs #t) init-multi "Document font selector")
+ (cpp-font-selector-dialog (font-selector-register-specs specs))
) ;with
) ;tm-define
@@ -1173,7 +1002,7 @@
(specs (list getter setter #t))
) ;
(selector-clean specs)
- (dialogue-window (font-selector specs #t) setter "Font selector")
+ (cpp-font-selector-dialog (font-selector-register-specs specs))
) ;let*
) ;tm-define
@@ -1213,7 +1042,7 @@
(let* ((getter (prefixed-get-init prefix)) (setter (prefixed-init-multi prefix)))
(open-font-tool "Font selector" getter setter #t)
) ;let*
- (open-document-other-font-selector prefix-window)
+ (open-document-other-font-selector-window prefix)
) ;if
) ;tm-define
@@ -1223,3 +1052,347 @@
(if (== name "sys-chinese") (translate "Font") (upcase-first (utf8->cork name)))
) ;with
) ;tm-define
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; QML font selector facade(record/qml/font-selector.md Phase 4)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; 把上面的 selector-* 状态机经一个内聚 facade 暴露给 C++ FontSelectorBridge。
+;; specs 含 getter/setter 过程,不能跨 glue 序列化,故维护 int 句柄注册表:开
+;; 对话框时存 specs 返回 key,key 注入 QML,bridge 每次调用带 key,facade 按 key
+;; 还原 specs。bridge 经 eval_scheme 调用本节 proc,无需逐个 glue。
+
+(define specs-registry (make-ahash-table))
+
+(define specs-registry-next 1)
+
+(tm-define (font-selector-register-specs specs)
+ (with key
+ specs-registry-next
+ (ahash-set! specs-registry key specs)
+ (set! specs-registry-next (+ specs-registry-next 1))
+ key
+ ) ;with
+) ;tm-define
+
+(tm-define (font-selector-lookup-specs key)
+ (or (ahash-ref specs-registry key)
+ (throw 'font-selector-qml "unknown specs key" key)
+ ) ;or
+) ;tm-define
+
+;; 三栏:family / style / size。返回 scheme list of string。
+(tm-define (font-selector-families key)
+ (selected-families (font-selector-lookup-specs key))
+) ;tm-define
+
+(tm-define (font-selector-styles key family)
+ (selected-styles (font-selector-lookup-specs key) family)
+) ;tm-define
+
+(tm-define (font-selector-sizes key) (font-default-sizes))
+
+(tm-define (font-selector-get key var)
+ (selector-get (font-selector-lookup-specs key) var)
+) ;tm-define
+
+;; live 写回:selector-set 经 selector-notify 实时写 buffer。refresh-now 对 QML
+;; 对话框里不存在的 tm-widget refreshable 标签是 no-op,Cancel 不回滚(既有契约)。
+(tm-define (font-selector-set key var val)
+ (selector-set (font-selector-lookup-specs key) var val)
+) ;tm-define
+
+;; 联动 setter:set 后一并返回需刷新的依赖 + 预览(光栅化 data URL),省 QML 二次
+;; 往返。返回 assoc list,bridge 转 QVariantMap。family 改动刷新 style 列表。
+(tm-define (font-selector-set-family key family)
+ (font-selector-set key :family family)
+ `((styles unquote (font-selector-styles key family))
+ (preview unquote (font-selector-preview key)))
+) ;tm-define
+
+(tm-define (font-selector-set-style key style)
+ (font-selector-set key :style style)
+ `((preview unquote (font-selector-preview key)))
+) ;tm-define
+(tm-define (font-selector-set-size key size)
+ (font-selector-set key :size size)
+ `((preview unquote (font-selector-preview key)))
+) ;tm-define
+
+;; 9 项 Filter 的可选项(原 tm-widget 内联于 font-properties-selector,集中复用)。
+;; var 用 string(无冒号),facade 内部 string->keyword 转;bridge/QML 全程普通
+;; string,避免 keyword 跨界。
+
+(define font-filter-options
+ (list (cons "weight" '("Any" "Thin" "Light" "Medium" "Bold" "Black"))
+ (cons "slant" '("Any" "Normal" "Italic" "Oblique"))
+ (cons "stretch" '("Any" "Condensed" "Unextended" "Wide"))
+ (cons "serif" '("Any" "Serif" "Sans Serif"))
+ (cons "spacing" '("Any" "Proportional" "Monospaced"))
+ (cons "case" '("Any" "Mixed" "Small Capitals"))
+ (cons "device"
+ '("Any" "Print" "Typewriter" "Digital" "Pen" "Art Pen" "Chalk" "Marker")
+ ) ;cons
+ (cons "category"
+ '("Any"
+ "Ancient"
+ "Attached"
+ "Calligraphic"
+ "Comic"
+ "Decorative"
+ "Distorted"
+ "Gothic"
+ "Handwritten"
+ "Initials"
+ "Medieval"
+ "Miscellaneous"
+ "Outline"
+ "Retro"
+ "Scifi"
+ "Title")
+ ) ;cons
+ (cons "glyphs"
+ '("Any"
+ "ASCII"
+ "Latin"
+ "Greek"
+ "Cyrillic"
+ "CJK"
+ "Hangul"
+ "Math Symbols"
+ "Math Extra"
+ "Math Letters")
+ ) ;cons
+ ) ;list
+) ;define
+
+(define font-filter-labels
+ (list (cons "weight" "Weight")
+ (cons "slant" "Slant")
+ (cons "stretch" "Stretch")
+ (cons "serif" "Serif")
+ (cons "spacing" "Spacing")
+ (cons "case" "Case")
+ (cons "device" "Device")
+ (cons "category" "Category")
+ (cons "glyphs" "Glyphs")
+ ) ;list
+) ;define
+
+(define (font-filter-label var)
+ (or (assoc-ref font-filter-labels var) "Filter")
+) ;define
+
+;; 返回 (label var (options...) value) 四元组列表,供 QML 一次性拉取全部 filter。
+;; var 为 string(无冒号),label 经 translate 跟随界面语言。
+(tm-define (font-selector-filter-meta key)
+ (with specs
+ (font-selector-lookup-specs key)
+ (map (lambda (cell)
+ (list (translate (font-filter-label (car cell)))
+ (car cell)
+ (cdr cell)
+ (selector-get specs (string->keyword (car cell)))
+ ) ;list
+ ) ;lambda
+ font-filter-options
+ ) ;map
+ ) ;with
+) ;tm-define
+
+;; selector-set* 是 tm-define-macro 不能直接调用;filter 写回走 selector-set,
+;; QML 由 bridge 返回刷新后的 families 驱动,不依赖 tm-widget refresh。
+;; var 为 string(无冒号),内部转 keyword。返回 {families, preview}。
+(tm-define (font-selector-set-filter key var val)
+ (selector-set (font-selector-lookup-specs key) (string->keyword var) val)
+ `((families unquote (font-selector-families key))
+ (preview unquote (font-selector-preview key)))
+) ;tm-define
+
+;; 预览光栅化:selector-font-demo-text + widget-texmacs-output + cpp-rasterize-widget,
+;; 同步返回 data URL。bg-color/magnification 包裹照搬 font-sample-text tm-widget。
+(tm-define (font-selector-preview key)
+ (with specs
+ (font-selector-lookup-specs key)
+ (cpp-rasterize-widget (widget-texmacs-output `(with ,"bg-color"
+ ,(font-sample-bg-color)
+ ,"color"
+ ,(font-sample-fg-color)
+ ,"magnification"
+ ,"1.6"
+ ,(selector-font-demo-text specs))
+ '(style "generic")
+ ) ;widget-texmacs-output
+ ) ;cpp-rasterize-widget
+ ) ;with
+) ;tm-define
+
+;; 样本类型。
+
+(define font-sample-kinds
+ '("Standard"
+ "Mathematics"
+ "Selection"
+ "ASCII"
+ "Latin"
+ "Greek"
+ "Cyrillic"
+ "CJK"
+ "Hangul"
+ "Math Symbols"
+ "Math Extra"
+ "Math Letters"
+ "Unicode 0000-0fff"
+ "Unicode 1000-1fff"
+ "Unicode 2000-2fff"
+ "Unicode 3000-3fff"
+ "Unicode 4000-4fff")
+) ;define
+
+(tm-define (font-selector-sample-kinds key) font-sample-kinds)
+(tm-define (font-selector-current-sample-kind key) sample-kind)
+;; 设样本类型,返回 {preview}(样本内容随类型变)。
+(tm-define (font-selector-set-sample-kind key kind)
+ (set-font-sample-kind kind)
+ `((preview unquote (font-selector-preview key)))
+) ;tm-define
+
+;; Advanced 定制(Effects / Variants / Mathematics)。每项返回
+;; (group label which (options...) value),QML 据此渲染 EnumCombo。
+
+(define font-effect-meta
+ (list (list "Effects" "Slant" "slant")
+ (list "Effects" "Embold" "embold")
+ (list "Effects" "Double stroke" "embbb")
+ (list "Effects" "Extended" "hextended")
+ (list "Effects" "Magnify horizontally" "hmagnify")
+ (list "Effects" "Magnify vertically" "vmagnify")
+ ) ;list
+) ;define
+
+(define font-variant-meta
+ (list (list "Variants" "Bold" "bold")
+ (list "Variants" "Italic" "italic")
+ (list "Variants" "Small capitals" "smallcaps")
+ (list "Variants" "Sans serif" "sansserif")
+ (list "Variants" "Typewriter" "typewriter")
+ ) ;list
+) ;define
+
+(define font-math-meta
+ (list (list "Mathematics" "Mathematics" "math")
+ (list "Mathematics" "Greek" "greek")
+ (list "Mathematics" "Blackboard bold" "bbb")
+ (list "Mathematics" "Calligraphic" "cal")
+ (list "Mathematics" "Fraktur" "frak")
+ ) ;list
+) ;define
+
+;; which 是否为子字体类(Variants/Mathematics 组),决定 options/value 来源。
+
+(define (font-selector-subfont? which)
+ (in? which
+ '("bold"
+ "italic"
+ "smallcaps"
+ "sansserif"
+ "typewriter"
+ "math"
+ "greek"
+ "bbb"
+ "cal"
+ "frak")
+ ) ;in?
+) ;define
+
+(define (font-selector-customize-get-value specs which)
+ (if (font-selector-subfont? which)
+ (selector-customize-get* specs which "Default")
+ (selector-customize-get specs which (font-effect-default which))
+ ) ;if
+) ;define
+
+(define (font-selector--customize-item specs meta)
+ (with (group label which)
+ meta
+ (list group
+ (translate label)
+ which
+ (if (font-selector-subfont? which)
+ (default-subfonts (selector-customize-get* specs which "Default"))
+ (font-effect-defaults which)
+ ) ;if
+ (font-selector-customize-get-value specs which)
+ ) ;list
+ ) ;with
+) ;define
+
+(tm-define (font-selector-customize-meta key)
+ (with specs
+ (font-selector-lookup-specs key)
+ (map (lambda (m) (font-selector--customize-item specs m))
+ (append font-effect-meta font-variant-meta font-math-meta)
+ ) ;map
+ ) ;with
+) ;tm-define
+
+(tm-define (font-selector-customize-get key which)
+ (font-selector-customize-get-value (font-selector-lookup-specs key) which)
+) ;tm-define
+
+;; 设定制项(影响 demo text 渲染,预览 live widget 自动重绘)。
+(tm-define (font-selector-customize-set key which val)
+ (with specs
+ (font-selector-lookup-specs key)
+ (if (font-selector-subfont? which)
+ (selector-customize-set!* specs which val)
+ (selector-customize-set! specs which val)
+ ) ;if
+ ) ;with
+) ;tm-define
+
+;; OK:取 changes 并应用 setter。live 路径下大部分已实时写入,此处补齐差异。
+(tm-define (font-selector-commit key)
+ (with specs
+ (font-selector-lookup-specs key)
+ (with (getter setter . other)
+ specs
+ (with changes
+ (selector-get-changes specs getter)
+ (when (nnull? changes)
+ (setter changes)
+ ) ;when
+ changes
+ ) ;with
+ ) ;with
+ ) ;with
+) ;tm-define
+
+(tm-define (font-selector-restore key)
+ (with specs
+ (font-selector-lookup-specs key)
+ (selector-restore specs (caddr specs))
+ ) ;with
+) ;tm-define
+
+;; Import 走 choose-file 模态,由 Import 按钮显式触发,QML 对话框在其下保持打开。
+(tm-define (font-selector-import key)
+ (choose-file font-import "Import font" "")
+) ;tm-define
+
+;; 固定 UI 文案(标题/按钮)的翻译,供 QML 一次性拉取。key 是稳定标识符,
+;; value 经 translate 跟随界面语言。与 form 引擎「C++ 注入已翻译文案」同思路,
+;; 但字体选择器文案在 scheme 集中定义,便于随字典更新。
+(tm-define (font-selector-ui-labels key)
+ `((family unquote (translate "Font family"))
+ (style unquote (translate "Style"))
+ (size unquote (translate "Size"))
+ (sample unquote (translate "Sample"))
+ (filter unquote (translate "Filter"))
+ (advanced unquote (translate "Advanced"))
+ (import unquote (translate "Import"))
+ (reset unquote (translate "Reset"))
+ (ok unquote (translate "Ok"))
+ (cancel unquote (translate "Cancel"))
+ (done unquote (translate "Done")))
+) ;tm-define
diff --git a/TeXmacs/progs/fonts/font-selector-test.scm b/TeXmacs/progs/fonts/font-selector-test.scm
new file mode 100644
index 0000000000..7a47018437
--- /dev/null
+++ b/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
diff --git a/TeXmacs/progs/kernel/texmacs/pref-keys.scm b/TeXmacs/progs/kernel/texmacs/pref-keys.scm
index d6442d50df..593221235c 100644
--- a/TeXmacs/progs/kernel/texmacs/pref-keys.scm
+++ b/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")
diff --git a/TeXmacs/progs/prog/glue-symbols.scm b/TeXmacs/progs/prog/glue-symbols.scm
index e6ec14fc48..129b71f6fd 100644
--- a/TeXmacs/progs/prog/glue-symbols.scm
+++ b/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"
diff --git a/TeXmacs/tests/2028.scm b/TeXmacs/tests/2028.scm
new file mode 100644
index 0000000000..9b53ad2e59
--- /dev/null
+++ b/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
diff --git a/ai-docs/qml/qml-dialog.html b/ai-docs/qml/qml-dialog.html
new file mode 100644
index 0000000000..f28f31df03
--- /dev/null
+++ b/ai-docs/qml/qml-dialog.html
@@ -0,0 +1,852 @@
+
+
+
+
+
+ QML 组件 HTML 模拟 · 左侧切换
+
+
+
+
+
+
+
+
+
ConfirmClose.qml 模拟
+ dialogMessage + dialogButtons + closeBridge.choose()
+
+
+
+
+
+ 是否保存当前更改?
+
+
+
+
+
+
+
+
+ 是否保存当前更改?
+
+
+
+
+
+
+
+
+ 对应 QML: message: dialogMessage
+ buttonLabels: dialogButtons
+ onClicked -> closeBridge.choose(index + 1)
+
+
+
+
+
+
+
+
+
+
+
字体
+
+ - Noto Sans CJK SC
+ - Source Han Serif SC
+ - LXGW WenKai
+ - Fira Sans
+ - Merriweather
+
+
+
+
字重
+
+ - 细体
+ - 常规
+ - 中等
+ - 粗体
+ - 特粗
+
+
+
+
字号
+
+ - 10
+ - 12
+ - 14
+ - 16
+ - 18
+
+
+
+
+
+
+
+
+
+ 示例
+
+
+
+ 预览文本: 这是 FontSelector 组件的 PreviewPane 区域。
+ 这是一段用于观察字形细节与笔画密度的示例文本。
+ 0123456789 / !@#$%^&*() / 甲乙丙丁戊己庚辛壬癸
+ 你可以在左上区域切换字体/字重/字号,在右侧调节筛选项。
+
+
+
+
+
+
+
+
+
+
+
+
+
+
粗细
+
宽度
+
倾斜
+
间距
+
厂商
+
字符集
+
设备
+
系列
+
扩展
+
+
+
+
+
+
字形提示
+
抗锯齿
+
字距调整
+
连字
+
回退策略
+
渲染
+
+
+
+
+
+
+
+
+
+
+
+
+ 对应 QML: fontBridge.requestPreview()
+ activeTab: 过滤 / 高级
+ setFamily/setStyle/setFilter/setCustomize
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/src/Plugins/Qt/FontSelectorBridge.cpp b/src/Plugins/Qt/FontSelectorBridge.cpp
new file mode 100644
index 0000000000..67c9a38914
--- /dev/null
+++ b/src/Plugins/Qt/FontSelectorBridge.cpp
@@ -0,0 +1,322 @@
+/******************************************************************************
+ * MODULE : FontSelectorBridge.cpp
+ * DESCRIPTION : 字体选择器 QML bridge 实现(见配套 .hpp)。
+ * COPYRIGHT : (C) 2026 Mogan STEM
+ *
+ * This software falls under the GNU general public license version 3 or later.
+ * It comes with NO WARRANTY whatsoever. Details see LICENSE.
+ ******************************************************************************/
+
+#include "FontSelectorBridge.hpp"
+
+#include "analyze.hpp" // as_string(int)
+#include "converter.hpp" // cork_to_utf8
+#include "qt_utilities.hpp"
+#include "s7_tm.hpp" // eval_scheme + tmscm helpers
+
+#include // scm_quote
+
+#include
+
+namespace {
+/**
+ * @brief scheme list of string → QStringList。非 string 项跳过。
+ */
+QStringList
+tmscm_to_stringlist (tmscm lst) {
+ QStringList out;
+ for (tmscm cur= lst; !tmscm_is_null (cur); cur= tmscm_cdr (cur)) {
+ tmscm item= tmscm_car (cur);
+ if (tmscm_is_string (item))
+ out << utf8_to_qstring (cork_to_utf8 (tmscm_to_string (item)));
+ }
+ return out;
+}
+
+/**
+ * @brief scheme 值 → QString,类型安全且编码确定。
+ * @details tmscm_to_string 内部调 s7_string,仅对 string 类型合法;对 symbol 会
+ * 解引用垃圾指针(SIGBUS)。scheme assoc 的 key 常是 symbol,故按类型分流。
+ * mogan string 内部是 Cork 编码,统一 cork_to_utf8 转 UTF-8 再 to QString——不用
+ * to_qstring(其 looks_utf8/looks_ascii 启发式对纯 Cork 中文不稳定)。
+ */
+QString
+tmscm_to_qstring (tmscm v) {
+ if (tmscm_is_string (v))
+ return utf8_to_qstring (cork_to_utf8 (tmscm_to_string (v)));
+ if (tmscm_is_symbol (v))
+ return utf8_to_qstring (cork_to_utf8 (tmscm_to_symbol (v)));
+ return QString ();
+}
+
+/**
+ * @brief 把 specsKey 拼成 scheme 整数字面。
+ */
+inline string
+key_token (int k) {
+ return as_string (k);
+}
+} // namespace
+
+//*****************************************************************************
+// helpers
+//*****************************************************************************
+
+QStringList
+FontSelectorBridge::evalStringList (const string& proc) {
+ string expr= "(" * proc * " " * key_token (m_specsKey) * ")";
+ return tmscm_to_stringlist (eval_scheme (expr));
+}
+
+QString
+FontSelectorBridge::evalString (const string& proc) {
+ string expr= "(" * proc * " " * key_token (m_specsKey) * ")";
+ return tmscm_to_qstring (eval_scheme (expr));
+}
+
+QString
+FontSelectorBridge::evalString1 (const string& proc, const string& arg) {
+ // arg 是 cork mogan string(如 ":family" 字面),直接 scm_quote,不经 QString
+ // 往返。
+ string expr= "(" * proc * " " * key_token (m_specsKey) * " " *
+ moebius::data::scm_quote (arg) * ")";
+ return tmscm_to_qstring (eval_scheme (expr));
+}
+
+QString
+FontSelectorBridge::evalPreview () {
+ return evalString ("font-selector-preview");
+}
+
+//*****************************************************************************
+// 三栏
+//*****************************************************************************
+
+QStringList
+FontSelectorBridge::requestFamilies () {
+ return evalStringList ("font-selector-families");
+}
+QStringList
+FontSelectorBridge::requestSizes () {
+ return evalStringList ("font-selector-sizes");
+}
+QString
+FontSelectorBridge::currentFamily () {
+ return evalString1 ("font-selector-get", ":family");
+}
+QString
+FontSelectorBridge::currentStyle () {
+ return evalString1 ("font-selector-get", ":style");
+}
+QString
+FontSelectorBridge::currentSize () {
+ return evalString1 ("font-selector-get", ":size");
+}
+
+/**
+ * @brief 联动 setter 通用实现:调 `(proc key 'arg')` 得 assoc list
+ * ((k . v) ...),转 QVariantMap。arg 是 cork mogan string,直接
+ * scm_quote 拼 scheme(确认式 utf8→cork 已在 from_qstring 完成,不再 to_qstring
+ * 启发式)。
+ */
+static QVariantMap
+eval_assoc_result (const string& proc, int key, const string& arg) {
+ string expr= "(" * proc * " " * as_string (key) * " " *
+ moebius::data::scm_quote (arg) * ")";
+ tmscm lst= eval_scheme (expr);
+ QVariantMap out;
+ for (tmscm cur= lst; !tmscm_is_null (cur); cur= tmscm_cdr (cur)) {
+ tmscm pair= tmscm_car (cur);
+ if (!tmscm_is_pair (pair)) continue;
+ QString k= tmscm_to_qstring (tmscm_car (pair));
+ tmscm v= tmscm_cdr (pair);
+ if (tmscm_is_string (v)) out.insert (k, tmscm_to_qstring (v));
+ else if (tmscm_is_list (v))
+ out.insert (k, QVariant::fromValue (tmscm_to_stringlist (v)));
+ }
+ return out;
+}
+
+QVariantMap
+FontSelectorBridge::setFamily (const QString& family) {
+ // set-family 返回 {styles}(filter 改 family 后 style 列表刷新)。
+ return eval_assoc_result ("font-selector-set-family", m_specsKey,
+ from_qstring (family));
+}
+QVariantMap
+FontSelectorBridge::setStyle (const QString& style) {
+ // set-style 仅触发 live 写回(预览实时 widget 自动刷新),返回空 map。
+ eval_scheme ("(font-selector-set-style " * key_token (m_specsKey) * " " *
+ moebius::data::scm_quote (from_qstring (style)) * ")");
+ return QVariantMap ();
+}
+QVariantMap
+FontSelectorBridge::setSize (const QString& size) {
+ eval_scheme ("(font-selector-set-size " * key_token (m_specsKey) * " " *
+ moebius::data::scm_quote (from_qstring (size)) * ")");
+ return QVariantMap ();
+}
+
+QStringList
+FontSelectorBridge::requestStyles (const QString& family) {
+ string expr= "(font-selector-styles " * key_token (m_specsKey) * " " *
+ qt_scheme_quote (family) * ")";
+ return tmscm_to_stringlist (eval_scheme (expr));
+}
+
+//*****************************************************************************
+// Filter
+//*****************************************************************************
+
+/**
+ * @brief filter-meta:list of (label var options value) → QVariantList of map。
+ * 每项 value 可能是 string;options 是 list。
+ */
+static QVariantList
+eval_filter_meta (int key) {
+ string expr= "(font-selector-filter-meta " * as_string (key) * ")";
+ tmscm lst = eval_scheme (expr);
+ QVariantList out;
+ for (tmscm cur= lst; !tmscm_is_null (cur); cur= tmscm_cdr (cur)) {
+ tmscm item= tmscm_car (cur);
+ if (!tmscm_is_list (item) || tmscm_is_null (item)) continue;
+ QVariantMap m;
+ m["label"] = tmscm_to_qstring (tmscm_car (item));
+ item = tmscm_cdr (item);
+ m["var"] = tmscm_to_qstring (tmscm_car (item));
+ item = tmscm_cdr (item);
+ m["options"]= QVariant::fromValue (tmscm_to_stringlist (tmscm_car (item)));
+ item = tmscm_cdr (item);
+ m["value"] = tmscm_to_qstring (tmscm_car (item));
+ out << m;
+ }
+ return out;
+}
+
+QVariantList
+FontSelectorBridge::filterMeta () {
+ return eval_filter_meta (m_specsKey);
+}
+QVariantMap
+FontSelectorBridge::setFilter (const QString& var, const QString& val) {
+ string expr= "(font-selector-set-filter " * key_token (m_specsKey) * " " *
+ qt_scheme_quote (var) * " " * qt_scheme_quote (val) * ")";
+ tmscm lst= eval_scheme (expr);
+ QVariantMap out;
+ for (tmscm cur= lst; !tmscm_is_null (cur); cur= tmscm_cdr (cur)) {
+ tmscm pair= tmscm_car (cur);
+ if (!tmscm_is_pair (pair)) continue;
+ QString k= tmscm_to_qstring (tmscm_car (pair));
+ tmscm v= tmscm_cdr (pair);
+ if (tmscm_is_string (v)) out.insert (k, tmscm_to_qstring (v));
+ else if (tmscm_is_list (v))
+ out.insert (k, QVariant::fromValue (tmscm_to_stringlist (v)));
+ }
+ return out;
+}
+
+//*****************************************************************************
+// 预览 / 样本
+//*****************************************************************************
+
+QString
+FontSelectorBridge::requestPreview () {
+ return evalPreview ();
+}
+QStringList
+FontSelectorBridge::sampleKinds () {
+ return evalStringList ("font-selector-sample-kinds");
+}
+QString
+FontSelectorBridge::currentSampleKind () {
+ return evalString ("font-selector-current-sample-kind");
+}
+QVariantMap
+FontSelectorBridge::setSampleKind (const QString& kind) {
+ return eval_assoc_result ("font-selector-set-sample-kind", m_specsKey,
+ from_qstring (kind));
+}
+
+//*****************************************************************************
+// Advanced 定制
+//*****************************************************************************
+
+QVariantList
+FontSelectorBridge::customizeMeta () {
+ string expr= "(font-selector-customize-meta " * key_token (m_specsKey) * ")";
+ tmscm lst = eval_scheme (expr);
+ QVariantList out;
+ for (tmscm cur= lst; !tmscm_is_null (cur); cur= tmscm_cdr (cur)) {
+ tmscm item= tmscm_car (cur);
+ if (!tmscm_is_list (item) || tmscm_is_null (item)) continue;
+ QVariantMap m;
+ m["group"] = tmscm_to_qstring (tmscm_car (item));
+ item = tmscm_cdr (item);
+ m["label"] = tmscm_to_qstring (tmscm_car (item));
+ item = tmscm_cdr (item);
+ m["which"] = tmscm_to_qstring (tmscm_car (item));
+ item = tmscm_cdr (item);
+ m["options"]= QVariant::fromValue (tmscm_to_stringlist (tmscm_car (item)));
+ item = tmscm_cdr (item);
+ m["value"] = tmscm_to_qstring (tmscm_car (item));
+ out << m;
+ }
+ return out;
+}
+QVariantMap
+FontSelectorBridge::setCustomize (const QString& which, const QString& val) {
+ string expr= "(font-selector-customize-set " * key_token (m_specsKey) * " " *
+ qt_scheme_quote (which) * " " * qt_scheme_quote (val) * ")";
+ tmscm lst= eval_scheme (expr);
+ QVariantMap out;
+ for (tmscm cur= lst; !tmscm_is_null (cur); cur= tmscm_cdr (cur)) {
+ tmscm pair= tmscm_car (cur);
+ if (!tmscm_is_pair (pair)) continue;
+ QString k= tmscm_to_qstring (tmscm_car (pair));
+ tmscm v= tmscm_cdr (pair);
+ if (tmscm_is_string (v)) out.insert (k, tmscm_to_qstring (v));
+ }
+ return out;
+}
+
+//*****************************************************************************
+// 动作
+//*****************************************************************************
+
+QVariantMap
+FontSelectorBridge::uiLabels () {
+ string expr= "(font-selector-ui-labels " * key_token (m_specsKey) * ")";
+ tmscm lst = eval_scheme (expr);
+ QVariantMap out;
+ for (tmscm cur= lst; !tmscm_is_null (cur); cur= tmscm_cdr (cur)) {
+ tmscm pair= tmscm_car (cur);
+ if (!tmscm_is_pair (pair)) continue;
+ out.insert (tmscm_to_qstring (tmscm_car (pair)),
+ tmscm_to_qstring (tmscm_cdr (pair)));
+ }
+ return out;
+}
+
+void
+FontSelectorBridge::importFont () {
+ string expr= "(font-selector-import " * key_token (m_specsKey) * ")";
+ eval_scheme (expr);
+}
+
+void
+FontSelectorBridge::reset () {
+ string expr= "(font-selector-restore " * key_token (m_specsKey) * ")";
+ eval_scheme (expr);
+}
+
+void
+FontSelectorBridge::submit () {
+ string expr= "(font-selector-commit " * key_token (m_specsKey) * ")";
+ eval_scheme (expr);
+ m_host->done (QDialog::Accepted);
+}
+
+void
+FontSelectorBridge::cancel () {
+ m_host->done (QDialog::Rejected);
+}
diff --git a/src/Plugins/Qt/FontSelectorBridge.hpp b/src/Plugins/Qt/FontSelectorBridge.hpp
new file mode 100644
index 0000000000..558e3b0f12
--- /dev/null
+++ b/src/Plugins/Qt/FontSelectorBridge.hpp
@@ -0,0 +1,141 @@
+/******************************************************************************
+ * MODULE : FontSelectorBridge.hpp
+ * DESCRIPTION : 字体选择器 QML 对话框的 C++↔QML 桥。透传、不持字体状态:
+ * scheme 侧 font-selector-* facade(font-new-widgets.scm)经
+ *specsKey 句柄持有 specs,bridge 每次 Q_INVOKABLE 调用都带上 specsKey,拼
+ * scheme 串经 eval_scheme 调 facade,把结果转 QML 可消费的类型。
+ * 详见 record/qml/font-selector.md Phase 2。
+ * COPYRIGHT : (C) 2026 Mogan STEM
+ *
+ * This software falls under the GNU general public license version 3 or later.
+ * It comes with NO WARRANTY whatsoever. Details see LICENSE.
+ ******************************************************************************/
+
+/*! @file FontSelectorBridge.hpp
+ * @brief QML 字体选择器 bridge:把 QML 的请求转发到 scheme facade。
+ *
+ * @par 设计
+ * - @b 透传无状态:字体状态真相源在 scheme(selector-table 按 buffer
+ * 为键),bridge 除 specsKey 外不持有任何字体数据。
+ * - @b specsKey 句柄:specs 含 getter/setter 过程,不能跨 glue 序列化。scheme
+ * 维护 specs-registry(int → specs),bridge 只存 int,每次调用带上。
+ * - @b eval_scheme 调 facade:每个 Q_INVOKABLE 方法拼 scheme 串调
+ * font-selector-* proc,结果(scheme list/string)转
+ * QStringList/QString/QVariantList。
+ * - @b 联动返回:setter 直接返回需刷新的依赖(如 setFamily 返回 styles +
+ * preview), QML 在同一 handler 更新 model,省二次往返。
+ *
+ * @par 不变量
+ * - @c selector-table 按 buffer 为键,同 buffer 单对话框(模态 exec 契约,见
+ * QTMQmlDialog.hpp)。bridge 不复刻此约束,依赖既有 scheme 契约。
+ * - @c live=true:selector-set 实时写 buffer,Cancel
+ * 不回滚(既有行为,非回归)。
+ *
+ * @note 生命周期仿 QmlDialogBridge:host 由调用方栈分配覆盖 exec(),bridge 不挂
+ * parent(须跨 host 存活以取最终值),调用方持指针用完 delete。
+ */
+
+#ifndef FONT_SELECTOR_BRIDGE_HPP
+#define FONT_SELECTOR_BRIDGE_HPP
+
+#include "boot.hpp"
+
+#include
+#include
+#include
+#include
+#include
+#include
+#include
+
+class FontSelectorBridge : public QObject {
+ Q_OBJECT
+
+public:
+ /**
+ * @brief 构造桥对象。
+ * @param host 宿主 QDialog(submit/cancel 结束模态),不挂 parent。
+ * @param specsKey scheme specs-registry 的 int 句柄。
+ */
+ FontSelectorBridge (QDialog* host, int specsKey)
+ : QObject (), m_host (host), m_specsKey (specsKey) {
+ ASSERT (host != NULL, "FontSelectorBridge expects a valid QDialog host");
+ }
+
+ // ---- 三栏:family / style / size ----
+ /// family 列表(据当前 filter)。
+ Q_INVOKABLE QStringList requestFamilies ();
+ /// 指定 family 下的 style 列表。
+ Q_INVOKABLE QStringList requestStyles (const QString& family);
+ /// 字号档列表。
+ Q_INVOKABLE QStringList requestSizes ();
+ /// 当前选中 family/style/size。
+ Q_INVOKABLE QString currentFamily ();
+ Q_INVOKABLE QString currentStyle ();
+ Q_INVOKABLE QString currentSize ();
+ /// 设 family,返回 {styles, preview} 供 QML 同步刷新 style 列表与预览。
+ Q_INVOKABLE QVariantMap setFamily (const QString& family);
+ /// 设 style,返回 {preview}。
+ Q_INVOKABLE QVariantMap setStyle (const QString& style);
+ /// 设 size,返回 {preview}。
+ Q_INVOKABLE QVariantMap setSize (const QString& size);
+
+ // ---- 9 项 Filter ----
+ /// 全部 filter 元数据:(label, var, options, value) ×9。
+ Q_INVOKABLE QVariantList filterMeta ();
+ /// 设 filter,返回 {families, preview}(filter 收窄 family 列表)。
+ Q_INVOKABLE QVariantMap setFilter (const QString& var, const QString& val);
+
+ // ---- 预览 ----
+ /// 同步返回 data URL(family/style/size/filter/customize 变更后拉取)。
+ Q_INVOKABLE QString requestPreview ();
+
+ // ---- 样本类型 ----
+ Q_INVOKABLE QStringList sampleKinds ();
+ Q_INVOKABLE QString currentSampleKind ();
+ /// 设样本类型,返回 {preview}。
+ Q_INVOKABLE QVariantMap setSampleKind (const QString& kind);
+
+ // ---- Advanced 定制 ----
+ /// 全部定制项元数据:(group, label, which, options, value) ×N。
+ Q_INVOKABLE QVariantList customizeMeta ();
+ Q_INVOKABLE QVariantMap setCustomize (const QString& which,
+ const QString& val);
+
+ // ---- 动作 ----
+ /// Advanced 子对话框用 QML Stack,无需新 glue;openAdvanced 仅占位通知。
+ Q_INVOKABLE void openAdvanced () {}
+ Q_INVOKABLE void importFont ();
+ Q_INVOKABLE void reset ();
+
+ /// 固定 UI 文案的翻译(family/style/size 标题、按钮等),QML 一次性拉取。
+ Q_INVOKABLE QVariantMap uiLabels ();
+
+ /// OK:scheme font-selector-commit 写回,host 以 Accepted 结束。
+ Q_INVOKABLE void submit ();
+ /// Cancel:host 以 Rejected 结束(live 写回不回滚,既有契约)。
+ Q_INVOKABLE void cancel ();
+
+ /**
+ * @brief 拖动无边框窗口,委托底层 QWindow 系统级移动。
+ */
+ Q_INVOKABLE void startMove () {
+ if (m_host && m_host->windowHandle ())
+ m_host->windowHandle ()->startSystemMove ();
+ }
+
+private:
+ /// 拼 `(proc specsKey)` 求 list of string → QStringList。
+ QStringList evalStringList (const string& proc);
+ /// 拼 `(proc specsKey)` 求单 string → QString。
+ QString evalString (const string& proc);
+ /// 拼 `(proc specsKey arg)` 求单 string → QString(arg 经 scheme quote)。
+ QString evalString1 (const string& proc, const string& arg);
+ /// 拼 `(proc specsKey)` 求 data URL → QString(同 evalString,语义清晰)。
+ QString evalPreview ();
+
+ QDialog* m_host;
+ int m_specsKey;
+};
+
+#endif // defined FONT_SELECTOR_BRIDGE_HPP
diff --git a/src/Plugins/Qt/QTMQmlDialog.cpp b/src/Plugins/Qt/QTMQmlDialog.cpp
index ac6230503b..1434393196 100644
--- a/src/Plugins/Qt/QTMQmlDialog.cpp
+++ b/src/Plugins/Qt/QTMQmlDialog.cpp
@@ -8,12 +8,14 @@
******************************************************************************/
#include "QTMQmlDialog.hpp"
+#include "FontSelectorBridge.hpp"
#include "QTMQmlDialogBridge.hpp"
#include "QTMQmlDialogInternal.hpp"
#include "analyze.hpp" // occurs
#include "gui.hpp" // tm_style_sheet
#include "qt_utilities.hpp"
+#include "s7_tm.hpp" // eval_scheme
#include "sys_utils.hpp" // lolly: get_env
#include // tree_to_scheme_tree / scm_unquote
@@ -351,3 +353,42 @@ cpp_form_dialog (tree fields) {
}
return r;
}
+
+// ---- 字体选择器 ------------------------------------------------------------
+
+/**
+ * @brief 字体选择器 QML 对话框(见 QTMQmlDialog.hpp 的
+ * cpp_font_selector_dialog)。
+ *
+ * @details 宿主拼装走 run_qml_dialog;FontSelectorBridge 作为 fontBridge
+ * context property 注入,承载 QML↔scheme 交互。字体状态在 scheme(specsKey
+ * 句柄),bridge 透传。实际写回由 bridge 的 submit → font-selector-commit
+ * 完成(live 路径),故本 入口返回的 tree 主要供自动化测试断言(OK 非空 /
+ * Cancel 空)。测试钩子 MOGAN_TEST_FONT_SELECTOR=ok|cancel 命中时不弹窗。
+ */
+tree
+cpp_font_selector_dialog (int specs_key) {
+ string preset= get_env ("MOGAN_TEST_FONT_SELECTOR");
+ if (preset == "cancel") return tree (TUPLE);
+ if (preset == "ok") {
+ // 测试钩子:仍走 font-selector-commit 验全链数据契约(live 写回),返回非空
+ // 标记 tuple 供调用方/测试区分 OK。
+ eval_scheme ("(font-selector-commit " * as_string (specs_key) * ")");
+ tree r (TUPLE);
+ r << tree ("ok");
+ return r;
+ }
+ FontSelectorBridge* fontBridge= nullptr;
+ int choice = run_qml_dialog (
+ "qrc:/qml/FontSelector.qml", "FontSelector.qml",
+ [&] (QQuickWidget* qw, QDialog& host) {
+ QmlDialogBridge* closeBridge= inject_common_context (qw, host);
+ (void) closeBridge; // closeBridge(choose/startMove)已注入;字体交互走
+ // fontBridge。
+ fontBridge= new FontSelectorBridge (&host, specs_key);
+ qw->rootContext ()->setContextProperty ("fontBridge", fontBridge);
+ },
+ 980, 600);
+ delete fontBridge;
+ return choice == QDialog::Accepted ? tree (TUPLE, tree ("ok")) : tree (TUPLE);
+}
diff --git a/src/Plugins/Qt/QTMQmlDialog.hpp b/src/Plugins/Qt/QTMQmlDialog.hpp
index 31b6b5b346..6e8b5119a7 100644
--- a/src/Plugins/Qt/QTMQmlDialog.hpp
+++ b/src/Plugins/Qt/QTMQmlDialog.hpp
@@ -131,4 +131,18 @@ string cpp_confirm_close (string message, bool scratch);
*/
tree cpp_form_dialog (tree fields);
+/**
+ * @brief 字体选择器 QML 对话框的 glue 入口。
+ * @param specs_key scheme specs-registry 的 int
+ * 句柄(font-selector-register-specs 返回值)。
+ * @return 用户点 OK 返回 `(tuple (tuple ) ...)`(与
+ * cpp-form-dialog 同形, 供 scheme 调用方 tree->stree 解构);Cancel /
+ * 关闭返回空 tree。
+ * @note 实际写回由 bridge 调 font-selector-commit 完成(live
+ * 路径),本入口返回值 主要供自动化测试断言;测试钩子
+ * MOGAN_TEST_FONT_SELECTOR=ok|cancel 命中时不弹窗。 详见
+ * record/qml/font-selector.md Phase 2。
+ */
+tree cpp_font_selector_dialog (int specs_key);
+
#endif // defined QTM_QML_DIALOG_H
diff --git a/src/Plugins/Qt/moganqml.qrc b/src/Plugins/Qt/moganqml.qrc
index 1799922793..612f80b1de 100644
--- a/src/Plugins/Qt/moganqml.qrc
+++ b/src/Plugins/Qt/moganqml.qrc
@@ -5,6 +5,9 @@
qml/DialogShell.qml
qml/DialogButtons.qml
qml/EnumCombo.qml
+ qml/SelectableList.qml
+ qml/PreviewPane.qml
+ qml/FontSelector.qml
qml/ConfirmClose.qml
qml/FormDialog.qml
diff --git a/src/Plugins/Qt/qml/FontSelector.qml b/src/Plugins/Qt/qml/FontSelector.qml
new file mode 100644
index 0000000000..78d7002003
--- /dev/null
+++ b/src/Plugins/Qt/qml/FontSelector.qml
@@ -0,0 +1,281 @@
+// FontSelector.qml — 字体选择器正文。全部由 Phase 0 原子板块拼装
+// (DialogShell / SelectableList / EnumCombo / PreviewPane / DialogButtons),
+// 交互经 fontBridge(C++ FontSelectorBridge)转发到 scheme facade(spec 句柄)。
+// 详见 record/qml/font-selector.md Phase 3。
+//
+// context property(C++ 注入):fontBridge、closeBridge、dpScale、isDark、specsKey。
+// fontBridge 的 setter 返回 {preview, styles/families} 等联动结果,QML 在同一
+// handler 更新 model + 预览,省二次往返。单一防抖 Timer 汇聚预览刷新。
+
+import QtQuick
+import "." // DialogShell / SelectableList / EnumCombo / PreviewPane / DialogButtons / Theme
+
+DialogShell {
+ id: root
+ implicitWidth: 980
+ implicitHeight: 600
+ onCancel: () => fontBridge.cancel()
+
+ // 预览 data URL。各 setter 返回新 preview 时更新;防抖 Timer 汇聚手动拉取。
+ property string previewUrl: fontBridge.requestPreview()
+ // 固定 UI 文案(scheme 翻译注入)。
+ property var labels: fontBridge.uiLabels()
+ // 选项卡:右侧面板 Filter / Advanced 切换(整合,不开第二个 exec)。
+ property string activeTab: "filter"
+
+ content: Item {
+ // 布局:上区 = 左三栏 + 右选项卡面板;下区 = 左预览图 + 右按钮组。
+ // 选项卡整合 Filter 与 Advanced(不再用整页翻转)。
+
+ // ---- 上区 ----
+ Item {
+ id: topArea
+ anchors.top: parent.top
+ anchors.left: parent.left
+ anchors.right: parent.right
+ height: 300 * Theme.scaleFactor
+
+ // 左:三栏 family/style/size(缩窄)。
+ Row {
+ id: columns3
+ anchors.left: parent.left
+ anchors.top: parent.top
+ anchors.bottom: parent.bottom
+ width: 444 * Theme.scaleFactor
+ spacing: 12 * Theme.scaleFactor
+
+ Column {
+ width: 200 * Theme.scaleFactor
+ height: parent.height
+ spacing: 6 * Theme.scaleFactor
+ Text { text: root.labels.family; color: Theme.fg; font.bold: true
+ font.pixelSize: 14 * Theme.scaleFactor }
+ SelectableList {
+ width: parent.width; height: parent.height - 20 * Theme.scaleFactor
+ items: familyModel.value
+ currentValue: fontBridge.currentFamily()
+ onSelected: function(v) {
+ var d = fontBridge.setFamily(v)
+ styleModel.value = d.styles
+ root.previewUrl = d.preview
+ }
+ }
+ }
+ Column {
+ width: 140 * Theme.scaleFactor
+ height: parent.height
+ spacing: 6 * Theme.scaleFactor
+ Text { text: root.labels.style; color: Theme.fg; font.bold: true
+ font.pixelSize: 14 * Theme.scaleFactor }
+ SelectableList {
+ width: parent.width; height: parent.height - 20 * Theme.scaleFactor
+ items: styleModel.value
+ currentValue: fontBridge.currentStyle()
+ onSelected: function(v) { root.previewUrl = fontBridge.setStyle(v).preview }
+ }
+ }
+ Column {
+ width: 80 * Theme.scaleFactor
+ height: parent.height
+ spacing: 6 * Theme.scaleFactor
+ Text { text: root.labels.size; color: Theme.fg; font.bold: true
+ font.pixelSize: 14 * Theme.scaleFactor }
+ SelectableList {
+ width: parent.width; height: parent.height - 20 * Theme.scaleFactor
+ items: fontBridge.requestSizes()
+ currentValue: fontBridge.currentSize()
+ onSelected: function(v) { root.previewUrl = fontBridge.setSize(v).preview }
+ }
+ }
+ }
+
+ // 右:选项卡面板(Filter / Advanced)。
+ Item {
+ anchors.left: columns3.right
+ anchors.leftMargin: 16 * Theme.scaleFactor
+ anchors.top: parent.top
+ anchors.right: parent.right
+ anchors.bottom: parent.bottom
+
+ // 选项卡行(自绘)。
+ Row {
+ id: tabBar
+ spacing: 4 * Theme.scaleFactor
+ Repeater {
+ model: [ { key: "filter", label: root.labels.filter }, { key: "advanced", label: root.labels.advanced } ]
+ delegate: Rectangle {
+ width: tabText.width + 24 * Theme.scaleFactor
+ height: 28 * Theme.scaleFactor
+ radius: 6 * Theme.scaleFactor
+ color: root.activeTab === modelData.key ? Theme.fieldBg : "transparent"
+ border.width: 1 * Theme.scaleFactor
+ border.color: root.activeTab === modelData.key ? Theme.borderClr : "transparent"
+ Text {
+ id: tabText
+ anchors.centerIn: parent
+ text: modelData.label
+ color: root.activeTab === modelData.key ? Theme.fg : Theme.borderClr
+ font.pixelSize: 13 * Theme.scaleFactor
+ font.bold: root.activeTab === modelData.key
+ }
+ MouseArea {
+ anchors.fill: parent
+ cursorShape: Qt.PointingHandCursor
+ onClicked: root.activeTab = modelData.key
+ }
+ }
+ }
+ }
+
+ // 选项卡内容。
+ Rectangle {
+ anchors.top: tabBar.bottom
+ anchors.topMargin: 4 * Theme.scaleFactor
+ anchors.left: parent.left
+ anchors.right: parent.right
+ anchors.bottom: parent.bottom
+ color: Theme.fieldBg
+ radius: 8 * Theme.scaleFactor
+ border.width: 1 * Theme.scaleFactor
+ border.color: Theme.borderClr
+ clip: true
+
+ // Filter 选项卡:9 项下拉,3 列。
+ Grid {
+ id: filterGrid
+ visible: root.activeTab === "filter"
+ anchors.fill: parent
+ anchors.margins: 8 * Theme.scaleFactor
+ columns: 3
+ columnSpacing: 12 * Theme.scaleFactor
+ rowSpacing: 6 * Theme.scaleFactor
+
+ Repeater {
+ model: fontBridge.filterMeta()
+ delegate: EnumCombo {
+ width: (filterGrid.width - 2 * filterGrid.columnSpacing) / 3
+ label: modelData.label
+ options: modelData.options
+ value: modelData.value
+ onChanged: function(v) {
+ var d = fontBridge.setFilter(modelData.var, v)
+ familyModel.value = d.families
+ root.previewUrl = d.preview
+ }
+ }
+ }
+ }
+
+ // Advanced 选项卡:定制下拉,3 列。
+ Grid {
+ id: customizeGrid
+ visible: root.activeTab === "advanced"
+ anchors.fill: parent
+ anchors.margins: 8 * Theme.scaleFactor
+ columns: 3
+ columnSpacing: 12 * Theme.scaleFactor
+ rowSpacing: 6 * Theme.scaleFactor
+
+ Repeater {
+ model: fontBridge.customizeMeta()
+ delegate: EnumCombo {
+ width: (customizeGrid.width - 2 * customizeGrid.columnSpacing) / 3
+ label: modelData.label
+ options: modelData.options
+ value: modelData.value
+ onChanged: function(v) {
+ root.previewUrl = fontBridge.setCustomize(modelData.which, v).preview
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ // ---- 下区:左预览 + 右按钮 ----
+ Item {
+ id: bottomArea
+ anchors.top: topArea.bottom
+ anchors.topMargin: 12 * Theme.scaleFactor
+ anchors.left: parent.left
+ anchors.right: parent.right
+ anchors.bottom: parent.bottom
+
+ // 左:样本类型 + 预览图(宽高比跟随图片)。
+ Column {
+ id: previewCol
+ anchors.left: parent.left
+ anchors.top: parent.top
+ anchors.bottom: parent.bottom
+ width: 500 * Theme.scaleFactor
+ spacing: 8 * Theme.scaleFactor
+
+ EnumCombo {
+ width: 240 * Theme.scaleFactor
+ label: root.labels.sample
+ options: fontBridge.sampleKinds()
+ value: fontBridge.currentSampleKind()
+ onChanged: function(v) { root.previewUrl = fontBridge.setSampleKind(v).preview }
+ }
+ PreviewPane {
+ width: parent.width
+ imageSource: root.previewUrl
+ // 固定高度:previewCol 高 - 样本下拉高(44×sf) - spacing(8×sf)。
+ // 预览内容超高时 PreviewPane 内部 Flickable 滚动,不撑破布局。
+ height: parent.height - 44 * Theme.scaleFactor - 8 * Theme.scaleFactor
+ }
+ }
+
+ // 右:高级/导入/重置(顶部)+ 确认/取消(底部),分别锚定。
+ Item {
+ anchors.left: previewCol.right
+ anchors.leftMargin: 16 * Theme.scaleFactor
+ anchors.right: parent.right
+ anchors.top: parent.top
+ anchors.bottom: parent.bottom
+
+ // 高级/导入/重置(顶部)。
+ DialogButtons {
+ id: actionBtns
+ anchors.top: parent.top
+ buttonLabels: [root.labels.advanced, root.labels["import"], root.labels.reset]
+ primaryIndex: -1
+ buttonWidth: 84 * Theme.scaleFactor
+ onClicked: function(i) {
+ if (i === 0) root.activeTab = "advanced"
+ else if (i === 1) fontBridge.importFont()
+ else if (i === 2) { fontBridge.reset(); root.refreshAll() }
+ }
+ }
+ // 确认/取消(底部,右对齐)。
+ DialogButtons {
+ anchors.bottom: parent.bottom
+ anchors.right: parent.right
+ buttonLabels: [root.labels.ok, root.labels.cancel]
+ primaryIndex: 0
+ buttonWidth: 84 * Theme.scaleFactor
+ onClicked: function(i) { i === 0 ? fontBridge.submit() : fontBridge.cancel() }
+ }
+ }
+ }
+ }
+
+ // family/style model 用 QtObject 持可变 list(SelectableList.items 绑定)。
+ // filter 改动刷新 family,family 改动刷新 style——这两个是动态的;size 静态。
+ QtObject {
+ id: familyModel
+ property var value: fontBridge.requestFamilies()
+ }
+ QtObject {
+ id: styleModel
+ property var value: fontBridge.requestStyles(fontBridge.currentFamily())
+ }
+
+ // Reset 后整体重拉(family/style/preview 都可能变)。
+ function refreshAll() {
+ familyModel.value = fontBridge.requestFamilies()
+ styleModel.value = fontBridge.requestStyles(fontBridge.currentFamily())
+ previewUrl = fontBridge.requestPreview()
+ }
+}
diff --git a/src/Plugins/Qt/qml/PreviewPane.qml b/src/Plugins/Qt/qml/PreviewPane.qml
new file mode 100644
index 0000000000..59e4bfab9a
--- /dev/null
+++ b/src/Plugins/Qt/qml/PreviewPane.qml
@@ -0,0 +1,52 @@
+// PreviewPane.qml — 预览图区壳。显示 fontBridge 光栅化的样本 PNG(data URL)。
+//
+// 固定高度(外部给定),内部 Flickable 可滚动:样本类型切换(标准→中日韩)时
+// 内容变高,不撑破布局,而是纵向滚动浏览。Image 宽度铺满容器,高度按图片原
+// 比例(sourceSize 算),可能超出容器 → Flickable 滚动。光栅化产物已含 retina
+// factor(物理像素 2×),按逻辑尺寸显示清晰不糊。
+//
+// API:
+// imageSource : string —— "data:image/png;base64,..."。
+// 容器宽高由父给定(高度固定,宽度铺满)。
+
+import QtQuick
+
+Item {
+ id: root
+
+ property string imageSource: ""
+
+ Rectangle {
+ anchors.fill: parent
+ color: Theme.fieldBg
+ clip: true
+
+ Flickable {
+ id: flick
+ anchors.fill: parent
+ anchors.margins: 1 * Theme.scaleFactor
+ // content 跟随 Image 实际尺寸(宽度铺满,高度按比例可能超高)。
+ contentWidth: img.width
+ contentHeight: img.height
+ clip: true
+ boundsBehavior: Flickable.StopAtBounds
+ contentX: 0
+
+ Image {
+ id: img
+ // 宽度铺满容器;高度 = 宽度 / 图片宽高比(据 sourceSize)。
+ width: root.width - 2 * Theme.scaleFactor
+ height: (img.sourceSize.width > 0)
+ ? width * img.sourceSize.height / img.sourceSize.width
+ : root.height
+ fillMode: Image.PreserveAspectFit
+ horizontalAlignment: Image.AlignLeft
+ verticalAlignment: Image.AlignTop
+ source: root.imageSource
+ asynchronous: false
+ cache: false
+ smooth: true
+ }
+ }
+ }
+}
diff --git a/src/Plugins/Qt/qml/SelectableList.qml b/src/Plugins/Qt/qml/SelectableList.qml
new file mode 100644
index 0000000000..67cc6871e9
--- /dev/null
+++ b/src/Plugins/Qt/qml/SelectableList.qml
@@ -0,0 +1,87 @@
+// SelectableList.qml — 始终可见的可滚动单选列表(三栏 family/style/size 复用)。
+// 与 EnumCombo(下拉)相对:选项常驻、单击选中、高亮当前值。tm-widget 的
+// choice+scrollable 即此形态。组件层纯 QtQuick,不依赖 Controls,与同目录其它
+// 原子板块同构(Theme 单例取主题)。
+//
+// API:
+// items : list —— 可选项。
+// currentValue : string —— 当前选中值(高亮 + 滚到可见)。
+// signal selected(string value) —— 点击新项时发出。
+//
+// 用法(宽度/高度由父布局给定):
+// SelectableList {
+// width: 300; height: 350
+// items: fontBridge.requestFamilies(); currentValue: fontBridge.currentFamily()
+// onSelected: function(v) { /* 联动 */ }
+// }
+//
+// model 切换后 currentIndex 须据 currentValue 重算(scheme 是状态真相源,非 QML
+// index)—— 由 currentValue 绑定 + onItemsChanged 自动重算,调用方无需手动同步。
+
+import QtQuick
+
+Item {
+ id: root
+
+ property var items: []
+ property string currentValue: ""
+ signal selected(string value)
+
+ // currentValue 在 items 中的下标,不在则 -1。
+ readonly property int currentIndex: {
+ for (var i = 0; i < items.length; i++)
+ if (items[i] === currentValue) return i
+ return -1
+ }
+
+ Rectangle {
+ anchors.fill: parent
+ color: Theme.fieldBg
+ radius: 8 * Theme.scaleFactor
+ border.width: 1 * Theme.scaleFactor
+ border.color: Theme.borderClr
+ clip: true
+
+ ListView {
+ id: list
+ anchors.fill: parent
+ clip: true
+ interactive: true
+ boundsBehavior: Flickable.StopAtBounds
+ model: root.items
+ currentIndex: root.currentIndex
+
+ // currentValue 变化或 items 切换后,把当前项滚到可见。
+ onCurrentIndexChanged: if (currentIndex >= 0) positionViewAtIndex(currentIndex, ListView.Contain)
+
+ delegate: Rectangle {
+ width: list.width
+ height: 36 * Theme.scaleFactor
+ // 当前值高亮(accent 底 + 白字),hover 浅高亮。
+ color: isCurrent ? Theme.accent
+ : (ma.containsMouse ? Theme.fieldBgHover : Theme.fieldBg)
+ readonly property bool isCurrent: root.currentValue === modelData
+
+ Text {
+ anchors.fill: parent
+ anchors.leftMargin: 14 * Theme.scaleFactor
+ anchors.rightMargin: 10 * Theme.scaleFactor
+ verticalAlignment: Text.AlignVCenter
+ text: modelData
+ color: isCurrent ? "#ffffff" : Theme.fg
+ font.pixelSize: 14 * Theme.scaleFactor
+ elide: Text.ElideRight
+ }
+ MouseArea {
+ id: ma
+ anchors.fill: parent
+ hoverEnabled: true
+ cursorShape: Qt.PointingHandCursor
+ onClicked: {
+ if (!isCurrent) root.selected(modelData)
+ }
+ }
+ }
+ }
+ }
+}
diff --git a/src/Plugins/Qt/qml/qmldir b/src/Plugins/Qt/qml/qmldir
index 92ff51f0a2..fb8077a807 100644
--- a/src/Plugins/Qt/qml/qmldir
+++ b/src/Plugins/Qt/qml/qmldir
@@ -2,3 +2,5 @@ singleton Theme 1.0 Theme.qml
DialogShell 1.0 DialogShell.qml
DialogButtons 1.0 DialogButtons.qml
EnumCombo 1.0 EnumCombo.qml
+SelectableList 1.0 SelectableList.qml
+PreviewPane 1.0 PreviewPane.qml
diff --git a/src/Plugins/Qt/qt_widget_rasterize.cpp b/src/Plugins/Qt/qt_widget_rasterize.cpp
new file mode 100644
index 0000000000..e48a8e3e73
--- /dev/null
+++ b/src/Plugins/Qt/qt_widget_rasterize.cpp
@@ -0,0 +1,74 @@
+
+/******************************************************************************
+ * MODULE : qt_widget_rasterize.cpp
+ * DESCRIPTION : 把一个 TeXmacs widget 光栅化为 PNG data URL(见配套 .hpp)。
+ * COPYRIGHT : (C) 2026 Mogan STEM
+ *
+ * This software falls under the GNU general public license version 3 or later.
+ * It comes with NO WARRANTY whatsoever. Details see LICENSE.
+ ******************************************************************************/
+
+#include "qt_widget_rasterize.hpp"
+
+#include "qt_renderer.hpp"
+#include "qt_simple_widget.hpp"
+#include "qt_utilities.hpp"
+
+#include "qt_gui.hpp" // the_gui
+
+#include
+#include
+
+/**
+ * @brief 照搬 impress()(qt_simple_widget.cpp),目标改为 QImage。
+ *
+ * @details QImage 按 retina_factor 放大物理分辨率(hidpi 2× 像素),QML Image
+ * 按逻辑 尺寸降采样显示,清晰不糊。the_qt_renderer()->begin(void*) 接受任意
+ * QPaintDevice*, QImage 即 QPaintDevice,无需额外 surface。wid 非
+ * simple_widget 时返回空。
+ */
+string
+rasterize_widget_to_png_data_url (widget wid) {
+ qt_simple_widget_rep* rep= concrete_simple_widget (wid);
+ if (rep == nullptr) return "";
+
+ int width, height;
+ rep->handle_get_size_hint (width, height);
+ QSize s = to_qsize (width, height);
+ QSize phys_s= s;
+ phys_s*= retina_factor;
+
+ QImage img (phys_s, QImage::Format_ARGB32_Premultiplied);
+ if (img.isNull ()) return "";
+ img.fill (Qt::transparent);
+ {
+ qt_renderer_rep* ren= the_qt_renderer ();
+ ren->begin (static_cast (&img));
+ rectangle r= rectangle (0, 0, phys_s.width (), phys_s.height ());
+ ren->set_origin (0, 0);
+ ren->encode (r->x1, r->y1);
+ ren->encode (r->x2, r->y2);
+ ren->set_clipping (r->x1, r->y2, r->x2, r->y1);
+ {
+ // 与 impress() 同:绘制期间不希望被事件中断。the_gui 在非主程序上下文
+ // (单测)可能未构造 = nullptr,守卫之。
+ bool has_gui= (the_gui != nullptr);
+ if (has_gui) the_gui->set_check_events (false);
+ rep->handle_repaint (ren, r->x1, r->y2, r->x2, r->y1);
+ if (has_gui) the_gui->set_check_events (true);
+ }
+ ren->end ();
+ }
+
+ QByteArray ba;
+ QBuffer buf (&ba);
+ if (!buf.open (QIODevice::WriteOnly)) return "";
+ if (!img.save (&buf, "PNG")) return "";
+ string data_url= "data:image/png;base64,";
+ return data_url * from_qstring (QString::fromLatin1 (ba.toBase64 ()));
+}
+
+string
+cpp_rasterize_widget (widget wid) {
+ return rasterize_widget_to_png_data_url (wid);
+}
diff --git a/src/Plugins/Qt/qt_widget_rasterize.hpp b/src/Plugins/Qt/qt_widget_rasterize.hpp
new file mode 100644
index 0000000000..92515f2d17
--- /dev/null
+++ b/src/Plugins/Qt/qt_widget_rasterize.hpp
@@ -0,0 +1,49 @@
+
+/******************************************************************************
+ * MODULE : qt_widget_rasterize.hpp
+ * DESCRIPTION : 把 TeXmacs widget 光栅化为 PNG data URL,供 QML Image 显示。
+ * COPYRIGHT : (C) 2026 Mogan STEM
+ *
+ * This software falls under the GNU general public license version 3 or later.
+ * It comes with NO WARRANTY whatsoever. Details see LICENSE.
+ ******************************************************************************/
+
+/*! @file qt_widget_rasterize.hpp
+ * @brief widget → QImage → base64 PNG data URL 的光栅化入口。
+ *
+ * @par 用途
+ * 字体选择器 QML 预览:scheme 侧把样本 tree 经 texmacs_output_widget 排版成 box
+ * widget,本函数把它光栅化成 data URL,喂 QML Image。复用 impress()
+ * 的渲染路径。
+ *
+ * @par 清晰度
+ * QImage 按 retina_factor 放大物理分辨率渲染(hidpi 自动 2× 像素),QML Image
+ * 按 逻辑尺寸显示时降采样 → 清晰不糊。retina_factor 在 qt_utilities
+ * 取自系统设备像素 比。勿再手动翻倍 QImage 尺寸。
+ *
+ * @note 同步、亚帧级:样本 box 已被 texmacs_output_widget
+ * 排版好,handle_repaint 仅绘制。
+ */
+
+#ifndef QT_WIDGET_RASTERIZE_H
+#define QT_WIDGET_RASTERIZE_H
+
+#include "string.hpp"
+#include "widget.hpp"
+
+/**
+ * @brief 把 widget 光栅化为 PNG data URL。
+ * @param wid 已排版的 widget(经 texmacs_output_widget 构造)。
+ * @return 形如 "data:image/png;base64,..." 的 string;wid 非 simple_widget
+ * 或光栅化失败返回空 string。
+ */
+string rasterize_widget_to_png_data_url (widget wid);
+
+/**
+ * @brief glue 入口(cpp-rasterize-widget):转发到
+ * rasterize_widget_to_png_data_url。
+ * @note 头不含 Qt 头,可安全被生成的 glue 代码 include。
+ */
+string cpp_rasterize_widget (widget wid);
+
+#endif // defined QT_WIDGET_RASTERIZE_H
diff --git a/src/Scheme/L5/glue_l5_extra.hpp b/src/Scheme/L5/glue_l5_extra.hpp
index 527b41ff51..3e469852f8 100644
--- a/src/Scheme/L5/glue_l5_extra.hpp
+++ b/src/Scheme/L5/glue_l5_extra.hpp
@@ -33,6 +33,7 @@
#ifdef QTTEXMACS
#include "qt_chat_controller.hpp"
#include "qt_floating_search_bar.hpp"
+#include "qt_widget_rasterize.hpp"
#endif
#include "tm_debug.hpp"
#include "tree_observer.hpp"
diff --git a/src/Scheme/L5/glue_qt.lua b/src/Scheme/L5/glue_qt.lua
index 84d74ed873..c3539c75ef 100644
--- a/src/Scheme/L5/glue_qt.lua
+++ b/src/Scheme/L5/glue_qt.lua
@@ -49,6 +49,14 @@ function main()
"tree"
}
},
+ {
+ scm_name = "cpp-font-selector-dialog",
+ cpp_name = "cpp_font_selector_dialog",
+ ret_type = "tree",
+ arg_list = {
+ "int"
+ }
+ },
{
scm_name = "qt-clipboard-format",
cpp_name = "qt_clipboard_format",
diff --git a/src/Scheme/L5/glue_widget.lua b/src/Scheme/L5/glue_widget.lua
index d8a64a1f89..3a3fdda2c1 100644
--- a/src/Scheme/L5/glue_widget.lua
+++ b/src/Scheme/L5/glue_widget.lua
@@ -411,6 +411,14 @@ function main()
"content"
}
},
+ {
+ scm_name = "cpp-rasterize-widget",
+ cpp_name = "cpp_rasterize_widget",
+ ret_type = "string",
+ arg_list = {
+ "widget"
+ }
+ },
{
scm_name = "widget-texmacs-input",
cpp_name = "texmacs_input_widget",
diff --git a/tests/Plugins/Qt/font_selector_bridge_test.cpp b/tests/Plugins/Qt/font_selector_bridge_test.cpp
new file mode 100644
index 0000000000..e07dc2be02
--- /dev/null
+++ b/tests/Plugins/Qt/font_selector_bridge_test.cpp
@@ -0,0 +1,61 @@
+/******************************************************************************
+ * MODULE : font_selector_bridge_test.cpp
+ * DESCRIPTION: 单元测试字体选择器 glue 入口 cpp_font_selector_dialog 的测试钩子
+ * (MOGAN_TEST_FONT_SELECTOR=cancel 时不弹窗返回空 tree)。
+ * =ok 钩子经 font-selector-commit(需完整 scheme boot)走 GUI 集成
+ * 测试(TeXmacs/tests/2027.scm)覆盖;真实弹窗路径(Qt
+ *exec)无法在 C++ 单测里跑。bridge 的 Q_INVOKABLE 方法(eval_scheme 转 facade)
+ * 同样需 boot,见 2027.scm。
+ * 详见 record/qml/font-selector.md Phase 2。
+ * COPYRIGHT : (C) 2026 Mogan STEM
+ *******************************************************************************
+ * This software falls under the GNU general public license version 3 or later.
+ * It comes with NO WARRANTY whatsoever. Details see LICENSE.
+ ******************************************************************************/
+
+#include "Qt/QTMQmlDialog.hpp" // cpp_font_selector_dialog
+#include "base.hpp"
+
+#include "sys_utils.hpp" // set_env
+#include "tree_helper.hpp"
+
+#include
+
+// 测试钩子环境变量的 RAII 守卫:构造时设值,析构时还原为空(不命中弹窗路径)。
+struct EnvHook {
+ string key;
+ EnvHook (string k, string v) : key (k) { set_env (k, v); }
+ ~EnvHook () { set_env (key, ""); }
+};
+
+class TestFontSelectorBridge : public QObject {
+ Q_OBJECT
+
+private slots:
+ void init () { init_lolly (); }
+
+ // =cancel 钩子:不弹窗,直接返回空 tree(调用方 tree->stree 后 cdr 得 (),
+ // for-each no-op,不写回)。
+ void test_cancel_hook_returns_empty ();
+
+ // 未命中钩子(非法/空值)时不在此断言——真实弹窗路径会 exec() 阻塞,无法在
+ // C++ 单测跑;仅确认钩子判定逻辑对未知值不短路(此处无法调用,留 GUI 测试)。
+};
+
+void
+TestFontSelectorBridge::test_cancel_hook_returns_empty () {
+ EnvHook hook ("MOGAN_TEST_FONT_SELECTOR", "cancel");
+ tree r= cpp_font_selector_dialog (0);
+ QVERIFY (is_compound (r));
+ QCOMPARE (N (r), 0);
+}
+
+#ifdef QTTEXMACS
+QTEST_MAIN (TestFontSelectorBridge)
+#else
+int
+main () {
+ return 0;
+}
+#endif
+#include "font_selector_bridge_test.moc"
diff --git a/tests/Plugins/Qt/widget_rasterize_test.cpp b/tests/Plugins/Qt/widget_rasterize_test.cpp
new file mode 100644
index 0000000000..b433263748
--- /dev/null
+++ b/tests/Plugins/Qt/widget_rasterize_test.cpp
@@ -0,0 +1,67 @@
+/******************************************************************************
+ * MODULE : widget_rasterize_test.cpp
+ * DESCRIPTION: 单元测试 widget → QImage → base64 PNG data URL 光栅化。
+ * COPYRIGHT : (C) 2026 Mogan STEM
+ *******************************************************************************
+ * This software falls under the GNU general public license version 3 or later.
+ * It comes with NO WARRANTY whatsoever. Details see LICENSE.
+ ******************************************************************************/
+
+#include "qt_simple_widget.hpp" // qt_simple_widget_rep / concrete_simple_widget
+#include "qt_widget_rasterize.hpp" // rasterize_widget_to_png_data_url
+
+#include "base.hpp"
+#include "renderer.hpp" // renderer + set_brush 等
+
+#include
+
+static const int DATA_URL_PREFIX_LEN= 22;
+
+// 测试本地 stub:固定 100×60 逻辑像素,handle_repaint 填一个红色矩形。
+class stub_simple_widget_rep : public qt_simple_widget_rep {
+public:
+ void handle_get_size_hint (SI& w, SI& h) override {
+ w= 100 * PIXEL;
+ h= 60 * PIXEL;
+ }
+ void handle_repaint (renderer win, SI x1, SI y1, SI x2, SI y2) override {
+ win->set_background (rgb_color (200, 40, 40));
+ win->clear (x1, y1, x2, y2);
+ }
+};
+
+class TestWidgetRasterize : public QObject {
+ Q_OBJECT
+
+private slots:
+ void init () { init_lolly (); }
+
+ void test_rasterize_simple_widget ();
+ void test_rasterize_nil_returns_empty ();
+};
+
+void
+TestWidgetRasterize::test_rasterize_simple_widget () {
+ widget wid (tm_new ());
+ QVERIFY (!is_nil (wid));
+ string url= rasterize_widget_to_png_data_url (wid);
+ QVERIFY2 (starts (url, "data:image/png;base64,"), "data URL 前缀不对");
+ QVERIFY2 (N (url) > DATA_URL_PREFIX_LEN + 200, "光栅化产物过小,疑似空图");
+}
+
+void
+TestWidgetRasterize::test_rasterize_nil_returns_empty () {
+ widget wid; // nil widget
+ string url= rasterize_widget_to_png_data_url (wid);
+ QCOMPARE (url, string (""));
+}
+
+#ifdef QTTEXMACS
+QTEST_MAIN (TestWidgetRasterize)
+#else
+int
+main () {
+ return 0;
+}
+#endif
+#include "widget_rasterize_test.moc"