Bwidget Source Code
Check-in [0044eccdb1]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:
* font.tcl: Added support for two new flags: -families and -styles; -families allows you to specify one of all, fixed, or variable, to limit the choice of fonts to those fonts; -styles allows you to specify a list of styles that can be set with the widget (ie, bold, italic, etc).
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0044eccdb1b65bd0c16e96aecd59bf251b07a6f5
User & Date: ericm 1999-10-25 21:54:31
Context
1999-10-25
23:00
Fixed some issues with the new -style flag. check-in: 3d735e7800 user: ericm tags: trunk
21:54
* font.tcl: Added support for two new flags: -families and -styles; -families allows you to specify one of all, fixed, or variable, to limit the choice of fonts to those fonts; -styles allows you to specify a list of styles that can be set with the widget (ie, bold, italic, etc).
check-in: 0044eccdb1 user: ericm tags: trunk
1999-10-22
18:16
* tree.tcl: Added support for keyboard-based scrolling. check-in: c82174bca6 user: ericm tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.








1
2
3
4
5
6
7
8
9
10
11
12
13






1999-10-22  Eric Melski  <[email protected]>

	* tree.tcl: Fixed some problems with keyboard traversal.  Added
	support for left/right arrows a la MS Explorer.
	Added support for keyboard-based scrolling.

1999-10-21  Eric Melski  <[email protected]>

	* tree.tcl: Added a -selectable option to tree nodes, which
	controls whether or not a given node is selectable (duh).  This
	works with the new -selectcommand option for the tree, and with
	keyboard traversal (also new).  Now, whenever the tree gets a
	"selection set", it calls the given -selectcommand with the name
>
>
>
>
>
>
>





|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
1999-10-25  Eric Melski  <[email protected]>

	* font.tcl: Added support for two new flags: -families and -styles; 
	-families allows you to specify one of all, fixed, or variable, to limit 
	the choice of fonts to those fonts; -styles allows you to specify a list
	of styles that can be set with the widget (ie, bold, italic, etc).

1999-10-22  Eric Melski  <[email protected]>

	* tree.tcl: Fixed some problems with keyboard traversal.  Added
	support for left/right arrows a la MS Explorer.
	Added support for keyboard-based scrolling.
	
1999-10-21  Eric Melski  <[email protected]>

	* tree.tcl: Added a -selectable option to tree nodes, which
	controls whether or not a given node is selectable (duh).  This
	works with the new -selectcommand option for the tree, and with
	keyboard traversal (also new).  Now, whenever the tree gets a
	"selection set", it calls the given -selectcommand with the name

Changes to font.tcl.

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
..
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
...
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152
153
154
155
156
...
180
181
182
183
184
185
186
187

188
189
190
191
192
193
194
...
234
235
236
237
238
239
240
241


242
243
244
245
246
247
248
249
250








251
252
253
254
255
256
257
...
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
345
346
...
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
    Widget::declare SelectFont {
        {-title      String     "Font selection" 0}
        {-parent     String     "" 0}
        {-background TkResource "" 0 frame}

        {-type       Enum       dialog        0 {dialog toolbar}}
        {-font       TkResource ""            0 label}


        {-command    String     ""            0}
        {-sampletext String     "Sample Text" 0}
        {-bg         Synonym    -background}
    }

    proc ::SelectFont { path args } { return [eval SelectFont::create $path $args] }
    proc use {} {}

    variable _families
    variable _styles   {bold italic underline overstrike}


    variable _sizes    {4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24}

    variable _widget
}


# ------------------------------------------------------------------------------
#  Command SelectFont::create
# ------------------------------------------------------------------------------
proc SelectFont::create { path args } {
    variable _families
    variable _sizes
    variable _styles
    variable $path
    upvar 0  $path data

    if { ![info exists _families] } {
        loadfont
    }
    Widget::init SelectFont "$path#SelectFont" $args
    set bg [Widget::getoption "$path#SelectFont" -background]

    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
        Dialog::create $path -modal local -default 0 -cancel 1 -background $bg \
            -title  [Widget::getoption "$path#SelectFont" -title] \
            -parent [Widget::getoption "$path#SelectFont" -parent]

        set frame [Dialog::getframe $path]
        set topf  [frame $frame.topf -relief flat -borderwidth 0 -background $bg]
................................................................................
                       -side top -anchor w -relief flat -background $bg]
        set sw    [ScrolledWindow::create [LabelFrame::getframe $labf1].sw \
                       -background $bg]
        set lbf   [listbox $sw.lb \
                       -height 5 -width 25 -exportselection false -selectmode browse]
        ScrolledWindow::setwidget $sw $lbf
        LabelFrame::configure $labf1 -focus $lbf
        eval $lbf insert end $_families

        set script "set SelectFont::$path\(family\) \[%W curselection\]; SelectFont::_update $path"
        bind $lbf <ButtonRelease-1> $script
        bind $lbf <space>           $script
        pack $sw -fill both -expand yes

        set labf2 [LabelFrame::create $topf.labf2 -text "Size" -name size \
                       -side top -anchor w -relief flat -background $bg]
................................................................................

        _getfont $path

        proc ::$path { cmd args } "return \[eval SelectFont::\$cmd $path \$args\]"

        return [_draw $path]
    } else {

        frame $path -relief flat -borderwidth 0 -background $bg
        bind $path <Destroy> "SelectFont::_destroy $path"
        set lbf [ComboBox::create $path.font \
                     -highlightthickness 0 -takefocus 0 -background $bg \
                     -values   $_families \
                     -textvariable SelectFont::$path\(family\) \
                     -editable 0 \
                     -modifycmd "SelectFont::_update $path"]
        set lbs [ComboBox::create $path.size \
                     -highlightthickness 0 -takefocus 0 -background $bg \
                     -width    4 \
                     -values   $_sizes \
................................................................................
}


# ------------------------------------------------------------------------------
#  Command SelectFont::configure
# ------------------------------------------------------------------------------
proc SelectFont::configure { path args } {
    variable _styles


    set res [Widget::configure "$path#SelectFont" $args]

    if { [Widget::hasChanged "$path#SelectFont" -font font] } {
        _getfont $path
    }
    if { [Widget::hasChanged "$path#SelectFont" -background bg] } {
................................................................................
# ------------------------------------------------------------------------------
#  Command SelectFont::loadfont
# ------------------------------------------------------------------------------
proc SelectFont::loadfont { } {
    variable _families

    # initialize families
    set _families {}


    set lfont     [font families]
    lappend lfont times courier helvetica
    foreach font $lfont {
        set family [font actual [list $font] -family]
        if { [lsearch -exact $_families $family] == -1 } {
            lappend _families $family
        }
    }
    set _families [lsort $_families]








}


# ------------------------------------------------------------------------------
#  Command SelectFont::_draw
# ------------------------------------------------------------------------------
proc SelectFont::_draw { path } {
................................................................................

# ------------------------------------------------------------------------------
#  Command SelectFont::_update
# ------------------------------------------------------------------------------
proc SelectFont::_update { path } {
    variable _families
    variable _sizes
    variable _styles
    variable $path
    upvar 0  $path data

    set type [Widget::getoption "$path#SelectFont" -type]


    if { $type == "dialog" } {
        set curs [$path:cmd cget -cursor]
        $path:cmd configure -cursor watch
    }
    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
        set font [list \
                      [lindex $_families $data(family)] \
                      [lindex $_sizes $data(size)]]
    } else {
        set font [list $data(family) $data(size)]
    }
    foreach st $_styles {
        if { $data($st) } {
            lappend font $st


        }
    }
    Widget::setoption "$path#SelectFont" -font $font
    if { $type == "dialog" } {
        $data(label) configure -font $font
        $path:cmd configure -cursor $curs
    } elseif { [set cmd [Widget::getoption "$path#SelectFont" -command]] != "" } {
        uplevel \#0 $cmd
................................................................................


# ------------------------------------------------------------------------------
#  Command SelectFont::_getfont
# ------------------------------------------------------------------------------
proc SelectFont::_getfont { path } {
    variable _families
    variable _styles
    variable _sizes
    variable $path
    upvar 0  $path data

    array set font [font actual [Widget::getoption "$path#SelectFont" -font]]
    set data(bold)       [expr {[string compare $font(-weight) "normal"] != 0}]
    set data(italic)     [expr {[string compare $font(-slant)  "roman"]  != 0}]
    set data(underline)  $font(-underline)
    set data(overstrike) $font(-overstrike)


    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
        set idxf [lsearch $_families $font(-family)]
        set idxs [lsearch $_sizes    $font(-size)]
        set data(family) [expr {$idxf >= 0 ? $idxf : 0}]
        set data(size)   [expr {$idxs >= 0 ? $idxs : 0}]
    } else {
        set data(family) $font(-family)
        set data(size)   $font(-size)
        foreach st $_styles {
            $path.$st configure -relief [expr {$data($st) ? "sunken":"raised"}]
        }
    }
}







>
>









|
>
>












|








>







 







|
>







 







>




|







 







|
>







 







|
>
>




|
|


|
>
>
>
>
>
>
>
>







 







|




>
>






|







>
>
|







 







|









>
>

|












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
..
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
...
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
...
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
...
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
    Widget::declare SelectFont {
        {-title      String     "Font selection" 0}
        {-parent     String     "" 0}
        {-background TkResource "" 0 frame}

        {-type       Enum       dialog        0 {dialog toolbar}}
        {-font       TkResource ""            0 label}
	{-families   String     "all"         1}
	{-styles     String     "bold italic underline overstrike" 1}
        {-command    String     ""            0}
        {-sampletext String     "Sample Text" 0}
        {-bg         Synonym    -background}
    }

    proc ::SelectFont { path args } { return [eval SelectFont::create $path $args] }
    proc use {} {}

    variable _families
    variable _styleOff
    array set _styleOff \
	    [list bold normal italic roman underline 0 overstrike 0]
    variable _sizes    {4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24}

    variable _widget
}


# ------------------------------------------------------------------------------
#  Command SelectFont::create
# ------------------------------------------------------------------------------
proc SelectFont::create { path args } {
    variable _families
    variable _sizes
#    variable _styles
    variable $path
    upvar 0  $path data

    if { ![info exists _families] } {
        loadfont
    }
    Widget::init SelectFont "$path#SelectFont" $args
    set bg [Widget::getoption "$path#SelectFont" -background]
    set _styles [Widget::getoption "$path#SelectFont" -styles]
    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
        Dialog::create $path -modal local -default 0 -cancel 1 -background $bg \
            -title  [Widget::getoption "$path#SelectFont" -title] \
            -parent [Widget::getoption "$path#SelectFont" -parent]

        set frame [Dialog::getframe $path]
        set topf  [frame $frame.topf -relief flat -borderwidth 0 -background $bg]
................................................................................
                       -side top -anchor w -relief flat -background $bg]
        set sw    [ScrolledWindow::create [LabelFrame::getframe $labf1].sw \
                       -background $bg]
        set lbf   [listbox $sw.lb \
                       -height 5 -width 25 -exportselection false -selectmode browse]
        ScrolledWindow::setwidget $sw $lbf
        LabelFrame::configure $labf1 -focus $lbf
        eval $lbf insert end \
		$_families([Widget::getoption "$path#SelectFont" -families])
        set script "set SelectFont::$path\(family\) \[%W curselection\]; SelectFont::_update $path"
        bind $lbf <ButtonRelease-1> $script
        bind $lbf <space>           $script
        pack $sw -fill both -expand yes

        set labf2 [LabelFrame::create $topf.labf2 -text "Size" -name size \
                       -side top -anchor w -relief flat -background $bg]
................................................................................

        _getfont $path

        proc ::$path { cmd args } "return \[eval SelectFont::\$cmd $path \$args\]"

        return [_draw $path]
    } else {
	set fams [Widget::getoption "$path#SelectFont" -families]
        frame $path -relief flat -borderwidth 0 -background $bg
        bind $path <Destroy> "SelectFont::_destroy $path"
        set lbf [ComboBox::create $path.font \
                     -highlightthickness 0 -takefocus 0 -background $bg \
                     -values   $_families($fams) \
                     -textvariable SelectFont::$path\(family\) \
                     -editable 0 \
                     -modifycmd "SelectFont::_update $path"]
        set lbs [ComboBox::create $path.size \
                     -highlightthickness 0 -takefocus 0 -background $bg \
                     -width    4 \
                     -values   $_sizes \
................................................................................
}


# ------------------------------------------------------------------------------
#  Command SelectFont::configure
# ------------------------------------------------------------------------------
proc SelectFont::configure { path args } {
#    variable _styles
    set _styles [Widget::getoption "$path#SelectFont" -styles]

    set res [Widget::configure "$path#SelectFont" $args]

    if { [Widget::hasChanged "$path#SelectFont" -font font] } {
        _getfont $path
    }
    if { [Widget::hasChanged "$path#SelectFont" -background bg] } {
................................................................................
# ------------------------------------------------------------------------------
#  Command SelectFont::loadfont
# ------------------------------------------------------------------------------
proc SelectFont::loadfont { } {
    variable _families

    # initialize families
    set _families(all) {}
    set _families(fixed) {}
    set _families(variable) {}
    set lfont     [font families]
    lappend lfont times courier helvetica
    foreach font $lfont {
        set family [font actual [list $font] -family]
        if { [lsearch -exact $_families(all) $family] == -1 } {
            lappend _families(all) $family
        }
    }
    set _families(all) [lsort $_families(all)]
    foreach family $_families(all) {
	if { [font metrics [list $family] -fixed] } {
	    lappend _families(fixed) $family
	} else {
	    lappend _families(variable) $family
	}
    }
    return
}


# ------------------------------------------------------------------------------
#  Command SelectFont::_draw
# ------------------------------------------------------------------------------
proc SelectFont::_draw { path } {
................................................................................

# ------------------------------------------------------------------------------
#  Command SelectFont::_update
# ------------------------------------------------------------------------------
proc SelectFont::_update { path } {
    variable _families
    variable _sizes
    variable _styleOff
    variable $path
    upvar 0  $path data

    set type [Widget::getoption "$path#SelectFont" -type]
    set fams [Widget::getoption "$path#SelectFont" -families]
    set _styles [Widget::getoption "$path#SelectFont" -styles]
    if { $type == "dialog" } {
        set curs [$path:cmd cget -cursor]
        $path:cmd configure -cursor watch
    }
    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
        set font [list \
                      [lindex $_families($fams) $data(family)] \
                      [lindex $_sizes $data(size)]]
    } else {
        set font [list $data(family) $data(size)]
    }
    foreach st $_styles {
        if { $data($st) } {
            lappend font $st
        } else {
	    lappend font $_styleOff($st)
	}
    }
    Widget::setoption "$path#SelectFont" -font $font
    if { $type == "dialog" } {
        $data(label) configure -font $font
        $path:cmd configure -cursor $curs
    } elseif { [set cmd [Widget::getoption "$path#SelectFont" -command]] != "" } {
        uplevel \#0 $cmd
................................................................................


# ------------------------------------------------------------------------------
#  Command SelectFont::_getfont
# ------------------------------------------------------------------------------
proc SelectFont::_getfont { path } {
    variable _families
#    variable _styles
    variable _sizes
    variable $path
    upvar 0  $path data

    array set font [font actual [Widget::getoption "$path#SelectFont" -font]]
    set data(bold)       [expr {[string compare $font(-weight) "normal"] != 0}]
    set data(italic)     [expr {[string compare $font(-slant)  "roman"]  != 0}]
    set data(underline)  $font(-underline)
    set data(overstrike) $font(-overstrike)
    set _styles [Widget::getoption "$path#SelectFont" -styles]
    set fams [Widget::getoption "$path#SelectFont" -families]
    if { [Widget::getoption "$path#SelectFont" -type] == "dialog" } {
        set idxf [lsearch $_families($fams) $font(-family)]
        set idxs [lsearch $_sizes    $font(-size)]
        set data(family) [expr {$idxf >= 0 ? $idxf : 0}]
        set data(size)   [expr {$idxs >= 0 ? $idxs : 0}]
    } else {
        set data(family) $font(-family)
        set data(size)   $font(-size)
        foreach st $_styles {
            $path.$st configure -relief [expr {$data($st) ? "sunken":"raised"}]
        }
    }
}