Tk Source Code

Changes On Branch bug-f75190db19
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki
Patch Side-by-Side Diff

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch bug-f75190db19 Excluding Merge-Ins

This is equivalent to a diff from 178b2141 to 894a7a81

2022-02-25
23:26
Fix [f75190db19]: ::tk::fontchooser of contains a couple of issues. check-in: 39a07baf user: fvogel tags: core-8-6-branch
2022-01-13
22:49
Remove proc ::tk::fontchooser::actual as this does not look right to me and creates issue #15 (see ticket [f75190db19]). Closed-Leaf check-in: 894a7a81 user: fvogel tags: bug-f75190db19
21:50
Typo in comment check-in: 57e7ca4b user: fvogel tags: bug-f75190db19
2021-11-06
14:23
Fix [46c2f088a2]: ttk::radiobutton -compound accepts empty string. Only a very minor documentation wording changed. check-in: d1323655 user: fvogel tags: core-8-6-branch
12:52
Fix [f75190db19]: ::tk::fontchooser of contains a couple of issues check-in: 026142fc user: fvogel tags: bug-f75190db19
2021-11-05
22:26
merge 8.6 check-in: 37cf295c user: dgp tags: trunk, main
22:21
merge release check-in: 178b2141 user: dgp tags: core-8-6-branch
2021-11-02
18:17
Merge 8.6 Closed-Leaf check-in: b3fc94ce user: culler tags: rc2, release, core-8-6-12-rc, core-8-6-12
18:16
Add missing call to [parent endSheet]. check-in: fa412516 user: culler tags: core-8-6-branch

Changes to library/fontchooser.tcl.
︙
8
9
10
11
12
13
14
15

16
17
18
19
20




21
22
23
24
25
26
27
28
29

30
31





















32
33
34
35
36
37

38
39
40
41
42
43
44
45
46
47
48
49
50
51


52
53
54
55
56
57
58
59
60
61
62




63
64
65
66




67
68



69

70


71
72
73
74
75
76
77

8
9
10
11
12
13
14

15
16




17
18
19
20
21

22
23
24
25

26

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

56





57
58
59
60
61
62
63


64
65
66
67
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87


88
89
90
91
92

93
94
95
96
97
98
99
100
101








-
+

-
-
-
-
+
+
+
+

-




-

-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+
-
-
-
-
-







-
-
+
+










-
+
+
+
+




+
+
+
+
-
-
+
+
+

+
-
+
+








# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tk::fontchooser {
    variable S

    set S(W) .__tk__fontchooser
    set S(fonts) [lsort -dictionary [font families]]
    set S(fonts) [lsort -dictionary -unique [font families]]
    set S(styles) [list \
	[::msgcat::mc "Regular"] \
	[::msgcat::mc "Italic"] \
	[::msgcat::mc "Bold"] \
	[::msgcat::mc "Bold Italic"] \
            [::msgcat::mc Regular] \
            [::msgcat::mc Italic] \
            [::msgcat::mc Bold] \
            [::msgcat::mc {Bold Italic}] \
    ]

    set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72}
    set S(strike) 0
    set S(under) 0
    set S(first) 1
    set S(sampletext) [::msgcat::mc "AaBbYyZz01"]
    set S(-parent) .
    set S(-title) [::msgcat::mc "Font"]
    set S(-title) {}
    set S(-command) ""
    set S(-font) TkDefaultFont
    set S(bad) [list ]
}

proc ::tk::fontchooser::Canonical {} {
    variable S

    foreach style $S(styles) {
        lappend S(styles,lcase) [string tolower $style]
    }
    set S(sizes,lcase) $S(sizes)
    set S(sampletext) [::msgcat::mc "AaBbYyZz01"]

    # Canonical versions of font families, styles, etc. for easier searching
    set S(fonts,lcase) {}
    foreach font $S(fonts) {
        lappend S(fonts,lcase) [string tolower $font]
    }
    set S(styles,lcase) {}
    foreach style $S(styles) {
        lappend S(styles,lcase) [string tolower $style]
    }
}

proc ::tk::fontchooser::Setup {} {
    variable S

    # Canonical versions of font families, styles, etc. for easier searching
    Canonical
    set S(fonts,lcase) {}
    foreach font $S(fonts) {lappend S(fonts,lcase) [string tolower $font]}
    set S(styles,lcase) {}
    foreach style $S(styles) {lappend S(styles,lcase) [string tolower $style]}
    set S(sizes,lcase) $S(sizes)

    ::ttk::style layout FontchooserFrame {
        Entry.field -sticky news -border true -children {
            FontchooserFrame.padding -sticky news
        }
    }
    bind [winfo class .] <<ThemeChanged>> \
        [list +ttk::style layout FontchooserFrame \
             [ttk::style layout FontchooserFrame]]
            [list +ttk::style layout FontchooserFrame \
                    [ttk::style layout FontchooserFrame]]

    namespace ensemble create -map {
        show ::tk::fontchooser::Show
        hide ::tk::fontchooser::Hide
        configure ::tk::fontchooser::Configure
    }
}
::tk::fontchooser::Setup

proc ::tk::fontchooser::Show {} {
    variable S
    variable S 

    Canonical

    if {![winfo exists $S(W)]} {
        Create
        wm transient $S(W) [winfo toplevel $S(-parent)]
        tk::PlaceWindow $S(W) widget $S(-parent)
        if {[string trim $S(-title)] eq ""} {
            wm title $S(W) [::msgcat::mc "Font"]
        } else {
            wm title $S(W) $S(-title)
    }
    set S(fonts) [lsort -dictionary [font families]]
        }
    }
    set S(fonts) [lsort -dictionary -unique [font families]]
    set S(fonts,lcase) {}
    foreach font $S(fonts) {
    foreach font $S(fonts) { lappend S(fonts,lcase) [string tolower $font]}
        lappend S(fonts,lcase) [string tolower $font]
    }
    wm deiconify $S(W)
}

proc ::tk::fontchooser::Hide {} {
    variable S
    wm withdraw $S(W)
}
︙
87
88
89
90
91
92
93
94

95
96
97

98
99
100
101
102
103
104
105
106
107
108
109


110
111
112
113

114
115
116

117
118
119
120
121
122
123
124
125
126














127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143



144
145
146
147
148
149
150
151
152
153
154
155
156

157
158

159
160

161
162
163
164


165
166
167


168
169
170


171
172
173
174
175
176
177



178
179
180
181



182
183
184
185

186
187

188
189

190
191
192
193
194
195
196
197
198
199

200
201

202
203

204
205



206
207
208
209
210
211
212

111
112
113
114
115
116
117

118
119
120

121
122
123
124
125
126
127
128
129
130
131


132
133
134

135

136
137
138

139
140
141
142
143






144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

189
190

191
192

193
194
195


196
197
198


199
200
201


202
203
204
205
206
207



208
209
210
211



212
213
214
215
216
217

218
219

220
221

222
223
224
225
226
227
228
229
230
231

232
233

234
235

236
237

238
239
240
241
242
243
244
245
246
247








-
+


-
+










-
-
+
+

-

-
+


-
+




-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-
+
+
+












-
+

-
+

-
+


-
-
+
+

-
-
+
+

-
-
+
+




-
-
-
+
+
+

-
-
-
+
+
+



-
+

-
+

-
+









-
+

-
+

-
+

-
+
+
+








    }

    if {[llength $args] == 0} {
        set result {}
        foreach spec $specs {
            foreach {name xx yy default} $spec break
            lappend result $name \
                [expr {[info exists S($name)] ? $S($name) : $default}]
                    [expr {[info exists S($name)] ? $S($name) : $default}]
        }
        lappend result -visible \
            [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}]
                [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}]
        return $result
    }
    if {[llength $args] == 1} {
        set option [lindex $args 0]
        if {[string equal $option "-visible"]} {
            return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}]
        } elseif {[info exists S($option)]} {
            return $S($option)
        }
        return -code error -errorcode [list TK LOOKUP OPTION $option] \
	    "bad option \"$option\": must be\
            -command, -font, -parent, -title or -visible"
                "bad option \"$option\": must be\
                -command, -font, -parent, -title or -visible"
    }

    set cache [dict create -parent $S(-parent) -title $S(-title) \
                   -font $S(-font) -command $S(-command)]
            -font $S(-font) -command $S(-command)]
    set r [tclParseConfigSpec [namespace which -variable S] $specs DONTSETDEFAULTS $args]
    if {![winfo exists $S(-parent)]} {
	set code [list TK LOOKUP WINDOW $S(-parent)]
        set code [list TK LOOKUP WINDOW $S(-parent)]
        set err "bad window path name \"$S(-parent)\""
        array set S $cache
        return -code error -errorcode $code $err
    }
    if {[string trim $S(-title)] eq ""} {
        set S(-title) [::msgcat::mc "Font"]
    }
    if {[winfo exists $S(W)] && ("-font" in $args)} {
	Init $S(-font)
	event generate $S(-parent) <<TkFontchooserFontChanged>>

    if {[winfo exists $S(W)]} {
        if {{-font} in $args} {
            Init $S(-font)
            event generate $S(-parent) <<TkFontchooserFontChanged>>
        }

        if {[string trim $S(-title)] eq {}} {
            wm title $S(W) [::msgcat::mc Font]
        } else {
            wm title $S(W) $S(-title)
        }
        $S(W).ok configure -state $S(nstate)
        $S(W).apply configure -state $S(nstate)
    }
    return $r
}

proc ::tk::fontchooser::Create {} {
    variable S
    set windowName __tk__fontchooser
    if {$S(-parent) eq "."} {
        set S(W) .$windowName
    } else {
        set S(W) $S(-parent).$windowName
    }

    # Now build the dialog
    if {![winfo exists $S(W)]} {
        toplevel $S(W) -class TkFontDialog
        if {[package provide tcltest] ne {}} {set ::tk_dialog $S(W)}
        if {[package provide tcltest] ne {}} {
            set ::tk_dialog $S(W)
        }
        wm withdraw $S(W)
        wm title $S(W) $S(-title)
        wm transient $S(W) [winfo toplevel $S(-parent)]

        set scaling [tk scaling]
        set sizeWidth [expr {int([string length [::msgcat::mc "&Size:"]] * $scaling)}]

        set outer [::ttk::frame $S(W).outer -padding {10 10}]
        ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"]
        ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"]
        ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] -width $sizeWidth
        ttk::entry $S(W).efont -width 18 \
            -textvariable [namespace which -variable S](font)
                -textvariable [namespace which -variable S](font)
        ttk::entry $S(W).estyle -width 10 \
            -textvariable [namespace which -variable S](style)
                -textvariable [namespace which -variable S](style)
        ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \
            -width 3 -validate key -validatecommand {string is double %P}
                -width 3 -validate key -validatecommand {regexp -- {^-*[0-9]*$} %P}

        ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \
            -selectmode browse -activestyle none \
            -listvariable [namespace which -variable S](fonts)
                -selectmode browse -activestyle none \
                -listvariable [namespace which -variable S](fonts)
        ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \
            -selectmode browse -activestyle none \
            -listvariable [namespace which -variable S](styles)
                -selectmode browse -activestyle none \
                -listvariable [namespace which -variable S](styles)
        ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \
            -selectmode browse -activestyle none \
            -listvariable [namespace which -variable S](sizes)
                -selectmode browse -activestyle none \
                -listvariable [namespace which -variable S](sizes)

        set WE $S(W).effects
        ::ttk::labelframe $WE -text [::msgcat::mc "Effects"]
        ::tk::AmpWidget ::ttk::checkbutton $WE.strike \
            -variable [namespace which -variable S](strike) \
            -text [::msgcat::mc "Stri&keout"] \
            -command [namespace code [list Click strike]]
                -variable [namespace which -variable S](strike) \
                -text [::msgcat::mc "Stri&keout"] \
                -command [namespace code [list Click strike]]
        ::tk::AmpWidget ::ttk::checkbutton $WE.under \
            -variable [namespace which -variable S](under) \
            -text [::msgcat::mc "&Underline"] \
            -command [namespace code [list Click under]]
                -variable [namespace which -variable S](under) \
                -text [::msgcat::mc "&Underline"] \
                -command [namespace code [list Click under]]

        set bbox [::ttk::frame $S(W).bbox]
        ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\
            -command [namespace code [list Done 1]]
                -command [namespace code [list Done 1]]
        ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \
            -command [namespace code [list Done 0]]
                -command [namespace code [list Done 0]]
        ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \
            -command [namespace code [list Apply]]
                -command [namespace code [list Apply]]
        wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]]

        # Calculate minimum sizes
        ttk::scrollbar $S(W).tmpvs
        set scroll_width [winfo reqwidth $S(W).tmpvs]
        destroy $S(W).tmpvs
        set minsize(gap) 10
        set minsize(bbox) [winfo reqwidth $S(W).ok]
        set minsize(fonts) \
            [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}]
                [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}]
        set minsize(styles) \
            [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}]
                [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}]
        set minsize(sizes) \
            [expr {[font measure TkDefaultFont "-99"] + $scroll_width}]
                [expr {[font measure TkDefaultFont "-99"] + $scroll_width}]
        set min [expr {$minsize(gap) * 4}]
        foreach {what width} [array get minsize] {incr min $width}
        foreach {what width} [array get minsize] {
            incr min $width
        }
        wm minsize $S(W) $min 260

        bind $S(W) <Return> [namespace code [list Done 1]]
        bind $S(W) <Escape> [namespace code [list Done 0]]
        bind $S(W) <Map> [namespace code [list Visibility %W 1]]
        bind $S(W) <Unmap> [namespace code [list Visibility %W 0]]
        bind $S(W) <Destroy> [namespace code [list Visibility %W 0]]
︙
220
221
222
223
224
225
226
227

228
229
230
231
232
233
234
235
236
237

238
239
240
241
242
243
244
245

255
256
257
258
259
260
261

262
263
264
265
266
267
268
269
270


271

272
273
274
275
276
277
278








-
+








-
-
+
-








        bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]]
        bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke]
        bind $WE.under <<AltUnderlined>> [list $WE.under invoke]

        set WS $S(W).sample
        ::ttk::labelframe $WS -text [::msgcat::mc "Sample"]
        ::ttk::label $WS.sample -relief sunken -anchor center \
            -textvariable [namespace which -variable S](sampletext)
                -textvariable [namespace which -variable S](sampletext)
        set S(sample) $WS.sample
        grid $WS.sample -sticky news -padx 6 -pady 4
        grid rowconfigure $WS 0 -weight 1
        grid columnconfigure $WS 0 -weight 1
        grid propagate $WS 0

        grid $S(W).ok     -in $bbox -sticky new -pady {0 2}
        grid $S(W).cancel -in $bbox -sticky new -pady 2
        if {$S(-command) ne ""} {
            grid $S(W).apply -in $bbox -sticky new -pady 2
        grid $S(W).apply  -in $bbox -sticky new -pady 2
        }
        grid columnconfigure $bbox 0 -weight 1

        grid $WE.strike -sticky w -padx 10
        grid $WE.under -sticky w -padx 10 -pady {0 30}
        grid columnconfigure $WE 1 -weight 1

        grid $S(W).font   x $S(W).style   x $S(W).size   x       -in $outer -sticky w
︙
258
259
260
261
262
263
264
265

266
267

268
269
270
271








272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292


293

294
295




296
297
298
299
300
301
302

291
292
293
294
295
296
297

298
299

300
301



302
303
304
305
306
307
308
309

310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333


334
335
336
337
338
339
340
341
342
343
344








-
+

-
+

-
-
-
+
+
+
+
+
+
+
+
-




















+
+

+
-
-
+
+
+
+








        grid $outer -sticky news
        grid rowconfigure $S(W) 0 -weight 1
        grid columnconfigure $S(W) 0 -weight 1

        Init $S(-font)

        trace add variable [namespace which -variable S](size) \
            write [namespace code [list Tracer]]
                write [namespace code [list Tracer]]
        trace add variable [namespace which -variable S](style) \
            write [namespace code [list Tracer]]
                write [namespace code [list Tracer]]
        trace add variable [namespace which -variable S](font) \
            write [namespace code [list Tracer]]
    } else {
        Init $S(-font)
                write [namespace code [list Tracer]]
        trace add variable [namespace which -variable S](strike) \
                write [namespace code [list Tracer]]
        trace add variable [namespace which -variable S](under) \
                write [namespace code [list Tracer]]
    }

    Init $S(-font)
    }

    return
}

# ::tk::fontchooser::Done --
#
#       Handles teardown of the dialog, calling -command if needed
#
# Arguments:
#       ok              true if user pressed OK
#
proc ::tk::fontchooser::Done {ok} {
    variable S

    if {! $ok} {
        set S(result) ""
    }
    trace vdelete S(size) w [namespace code [list Tracer]]
    trace vdelete S(style) w [namespace code [list Tracer]]
    trace vdelete S(font) w [namespace code [list Tracer]]
    trace vdelete S(strike) w [namespace code [list Tracer]]
    trace vdelete S(under) w [namespace code [list Tracer]]
    destroy $S(W)
    if {$ok} {
    if {$ok && $S(-command) ne ""} {
        uplevel #0 $S(-command) [list $S(result)]
        if {$S(-command) ne ""} {
            uplevel #0 $S(-command) [list $S(result)]
        }
        event generate $S(-parent) <<TkFontchooserFontChanged>>
    }
}

# ::tk::fontchooser::Apply --
#
#	Call the -command procedure appending the current font
#	Errors are reported via the background error mechanism
︙
318
319
320
321
322
323
324

325
326
327
328
329
330

331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380


381
382

383
384
385
386
387




388
389
390
391
392








393
394
395
396
397
398
399
400
401












402


403
404






405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
















421

422
423
424
425
426
427
428
429
430
431
432
433
434
435

436
437
438
439
440
441
442

360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377

378
379
380
381
382
383
384

385
386



387
388
389
390
391
392
393
394
395
396
397

398
399
400
401
402
403
404

405
406
407
408
409
410
411
412
413
414
415


416
417


418





419
420
421
422
423




424
425
426
427
428
429
430
431









432
433
434
435
436
437
438
439
440
441
442
443
444
445
446


447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462






463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493

494
495
496
497
498
499
500
501








+






+



-







-


-
-
-











-







-











-
-
+
+
-
-
+
-
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
+
+
+
+
+
+










-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+













-
+








# Arguments:
#       defaultFont     font to use as the default
#
proc ::tk::fontchooser::Init {{defaultFont ""}} {
    variable S

    if {$S(first) || $defaultFont ne ""} {
        Canonical
        if {$defaultFont eq ""} {
            set defaultFont [[entry .___e] cget -font]
            destroy .___e
        }
        array set F [font actual $defaultFont]
        set S(font) $F(-family)
        set S(style) [::msgcat::mc "Regular"]
        set S(size) $F(-size)
        set S(strike) $F(-overstrike)
        set S(under) $F(-underline)
        set S(style) [::msgcat::mc "Regular"]
        if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} {
            set S(style) [::msgcat::mc "Bold Italic"]
        } elseif {$F(-weight) eq "bold"} {
            set S(style) [::msgcat::mc "Bold"]
        } elseif {$F(-slant) eq "italic"} {
            set S(style) [::msgcat::mc "Italic"]
        }

        set S(first) 0
    }

    Tracer a b c
    Update
}

# ::tk::fontchooser::Click --
#
#       Handles all button clicks, updating the appropriate widgets
#
# Arguments:
#       who             which widget got pressed
#
proc ::tk::fontchooser::Click {who} {
    variable S

    if {$who eq "font"} {
        set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]]
    } elseif {$who eq "style"} {
        set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]]
    } elseif {$who eq "size"} {
        set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]]
    }
    Update
}

# ::tk::fontchooser::Tracer --
#
#       Handles traces on key variables, updating the appropriate widgets
#
# Arguments:
#       standard trace arguments (not used)
#
proc ::tk::fontchooser::Tracer {var1 var2 op} {
    variable S

    set bad 0
    # We don't need to process strike and under
    if {$var2 ni [list strike under]} {
    set nstate normal
    # Make selection in each listbox
        # Make selection in listbox
    foreach var {font style size} {
        set value [string tolower $S($var)]
        $S(W).l${var}s selection clear 0 end
        set n [lsearch -exact $S(${var}s,lcase) $value]
        $S(W).l${var}s selection set $n
        set value [string tolower $S($var2)]
        $S(W).l${var2}s selection clear 0 end
        set n [lsearch -exact $S(${var2}s,lcase) $value]
        $S(W).l${var2}s selection set $n
        if {$n >= 0} {
            set S($var) [lindex $S(${var}s) $n]
            $S(W).e$var icursor end
            $S(W).e$var selection clear
        } else {                                ;# No match, try prefix
            set S($var2) [lindex $S(${var2}s) $n]
            $S(W).e$var2 icursor end
            $S(W).e$var2 selection clear
            if {[set i [lsearch $S(bad) $var2]] >= 0} {
                set S(bad) [lreplace $S(bad) $i $i]
            }
        } else {
            # No match, try prefix
            # Size is weird: valid numbers are legal but don't display
            # unless in the font size list
            set n [lsearch -glob $S(${var}s,lcase) "$value*"]
            set bad 1
            if {$var ne "size" || ! [string is double -strict $value]} {
                set nstate disabled
            }
        }
        $S(W).l${var}s see $n
            set n [lsearch -glob $S(${var2}s,lcase) "$value*"]
            if {$var2 ne "size" || !([regexp -- {^(-[0-9]+|[0-9]+)$} $value] && $value >= -4096 && $value <= 4096)} {
                 if {[lsearch $S(bad) $var2] < 0} {
                     lappend S(bad) $var2
                 }
            } else {
                if {[set i [lsearch $S(bad) $var2]] >= 0} {
                    set S(bad) [lreplace $S(bad) $i $i]
                }
            }
        }
        $S(W).l${var2}s see $n
    }
    if {[llength $S(bad)] == 0} {
        set S(nstate) normal
    if {!$bad} {Update}
    $S(W).ok configure -state $nstate
        Update
    } else {
        set S(nstate) disabled
    }
    $S(W).ok configure -state $S(nstate)
    $S(W).apply configure -state $S(nstate)
}

# ::tk::fontchooser::Update --
#
#       Shows a sample of the currently selected font
#
proc ::tk::fontchooser::Update {} {
    variable S

    set S(result) [list $S(font) $S(size)]
    if {$S(style) eq [::msgcat::mc "Bold"]} {lappend S(result) bold}
    if {$S(style) eq [::msgcat::mc "Italic"]} {lappend S(result) italic}
    if {$S(style) eq [::msgcat::mc "Bold Italic"]} {lappend S(result) bold italic}
    if {$S(strike)} {lappend S(result) overstrike}
    if {$S(under)} {lappend S(result) underline}

    if {$S(style) eq [::msgcat::mc "Bold"]} {
        lappend S(result) bold
    }
    if {$S(style) eq [::msgcat::mc "Italic"]} {
        lappend S(result) italic
    }
    if {$S(style) eq [::msgcat::mc "Bold Italic"]} {
        lappend S(result) bold italic
    }
    if {$S(strike)} {
        lappend S(result) overstrike
    }
    if {$S(under)} {
        lappend S(result) underline
    }

    $S(sample) configure -font $S(result)
    set S(-font) $S(result)
}

# ::tk::fontchooser::Visibility --
#
#	Notify the parent when the dialog visibility changes
#
proc ::tk::fontchooser::Visibility {w visible} {
    variable S
    if {$w eq $S(W)} {
        event generate $S(-parent) <<TkFontchooserVisibility>>
    }
}

# ::tk::fontchooser::ttk_listbox --
# ::tk::fontchooser::ttk_slistbox --
#
#	Create a properly themed scrolled listbox.
#	This is exactly right on XP but may need adjusting on other platforms.
#
proc ::tk::fontchooser::ttk_slistbox {w args} {
    set f [ttk::frame $w -style FontchooserFrame -padding 2]
    if {[catch {
︙
This page was generated in about 0.019s by Fossil 2.26 [dfc0f1b41f] 2025-03-13 10:34:34