Bwidget Source Code
Check-in [80de6f3fe3]
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:demo code refractured
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 80de6f3fe3d7c1981315515948f0505d6d155eba
User & Date: oberdorfer 2009-09-08 21:21:20
Context
2009-09-09
18:51
cr/lf removed check-in: 63920e06d1 user: oberdorfer tags: trunk
2009-09-08
21:21
demo code refractured check-in: 80de6f3fe3 user: oberdorfer tags: trunk
21:19
what has changed for now... check-in: db58d054eb user: oberdorfer tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to demo/basic.tcl.







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
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
..
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






namespace eval DemoBasic {
    variable var
    variable count 0
    variable id    ""
}


proc DemoBasic::create { nb } {
    set frame [$nb insert end demoBasic -text "Basic"]

    set topf  [frame $frame.topf]
    set titf1 [TitleFrame $topf.titf1 -text "Label"]
    set titf2 [TitleFrame $topf.titf2 -text "Entry"]
    set titf3 [TitleFrame $frame.titf3 -text "Button and ArrowButton"]

    _label  [$titf1 getframe]
    _entry  [$titf2 getframe]
    _button [$titf3 getframe]
................................................................................


proc DemoBasic::_label { parent } {
    variable var

    set lab [Label $parent.label -text "This is a Label widget" \
                 -helptext "Label widget"]
    set chk [checkbutton $parent.chk -text "Disabled" \
                 -variable DemoBasic::var($lab,-state) \
                 -onvalue  disabled -offvalue normal \
                 -command  "$lab configure -state \$DemoBasic::var($lab,-state)"]
    pack $lab -anchor w -pady 4
    pack $chk -anchor w
}


proc DemoBasic::_entry { parent } {
    set ent  [Entry $parent.entry -text "Press enter" \
                  -command  {set DemoBasic::var(entcmd) "-command called" ; after 500 {set DemoBasic::var(entcmd) ""}} \
                   -helptext "Entry widget"]
    set chk1 [checkbutton $parent.chk1 -text "Disabled" \
                  -variable DemoBasic::var($ent,state) \
                  -onvalue  disabled -offvalue normal \
                  -command  "$ent configure -state \$DemoBasic::var($ent,state)"]
    set chk2 [checkbutton $parent.chk2 -text "Non editable" \
                  -variable DemoBasic::var($ent,editable) \
                  -onvalue  false -offvalue true \
                  -command  "$ent configure -editable \$DemoBasic::var($ent,editable)"]
    set lab  [label $parent.cmd -textvariable DemoBasic::var(entcmd) -foreground red]
    pack $ent -pady 4 -anchor w
    pack $chk1 $chk2 -anchor w
    pack $lab -pady 4
}


proc DemoBasic::_button { parent } {
    variable var

    set frame [frame $parent.butfr]
    set but   [Button $frame.but -text "Press me!" \
                   -repeatdelay 300 \
                   -command  "DemoBasic::_butcmd command" \
                   -helptext "This is a Button widget"]
    set sep1  [Separator $frame.sep1 -orient vertical]
    set arr1  [ArrowButton $frame.arr1 -type button \
                   -width 25 -height 25 \
................................................................................

    set sep3  [Separator $parent.sep3 -orient horizontal]
    pack $sep3 -fill x -pady 10

    set labf1 [LabelFrame $parent.labf1 -text "Command" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf1 getframe]
    set chk1  [checkbutton $subf.chk1 -text "Disabled" \
                   -variable DemoBasic::var(bstate) -onvalue disabled -offvalue normal \
                   -command  "DemoBasic::_bstate \$DemoBasic::var(bstate) $but $arr1 $arr2"]
    set chk2  [checkbutton $subf.chk2 -text "Use -armcommand/\n-disarmcommand" \
                   -justify left \
                   -variable DemoBasic::var(barmcmd) \
                   -command  "DemoBasic::_barmcmd \$DemoBasic::var(barmcmd) $but $arr1 $arr2"]
    pack $chk1 $chk2 -anchor w

    set label [label $parent.label -textvariable DemoBasic::var(butcmd) -foreground red]
    pack $label -side bottom -pady 4

    set labf2 [LabelFrame $parent.labf2 -text "Direction" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf2 getframe]
    set var(bside) top
    foreach dir {top left bottom right} {
        set rad [radiobutton $subf.$dir -text "$dir arrow" \
                     -variable DemoBasic::var(bside) -value $dir \
                     -command  "DemoBasic::_bside \$DemoBasic::var(bside) $arr1 $arr2"]
        pack $rad -anchor w
    }

    set labf3 [LabelFrame $parent.labf3 -text "Relief" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf3 getframe]
    set var(brelief) raised
    foreach {f lrelief} {f1 {raised sunken ridge groove} f2 {flat solid link}} {
        set f [frame $subf.$f]
        foreach relief $lrelief {
            set rad [radiobutton $f.$relief -text $relief \
                         -variable DemoBasic::var(brelief) -value $relief \
                         -command  "DemoBasic::_brelief \$DemoBasic::var(brelief) $but $arr1 $arr2"]
            pack $rad -anchor w
        }
        pack $f -side left -padx 2 -anchor n
    }
    pack $labf1 $labf2 $labf3 -side left -fill y -padx 4
}


>
>
>
>
>
>











|







 







|



|
|







|



|



|
|
|
|






|







 







|


|
<


|

|







|


|







|

|


|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
..
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
..
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
# ----------------------------------------------------------------------------
#  basic.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: basic.tcl,v 1.3 2009/09/08 21:22:29 oberdorfer Exp $
# ----------------------------------------------------------------------------
#

namespace eval DemoBasic {
    variable var
    variable count 0
    variable id    ""
}


proc DemoBasic::create { nb } {
    set frame [$nb insert end demoBasic -text "Basic"]

    set topf  [BWidget::wrap frame $frame.topf]
    set titf1 [TitleFrame $topf.titf1 -text "Label"]
    set titf2 [TitleFrame $topf.titf2 -text "Entry"]
    set titf3 [TitleFrame $frame.titf3 -text "Button and ArrowButton"]

    _label  [$titf1 getframe]
    _entry  [$titf2 getframe]
    _button [$titf3 getframe]
................................................................................


proc DemoBasic::_label { parent } {
    variable var

    set lab [Label $parent.label -text "This is a Label widget" \
                 -helptext "Label widget"]
    set chk [BWidget::wrap checkbutton $parent.chk -text "Disabled" \
                 -variable DemoBasic::var($lab,-state) \
                 -onvalue  disabled -offvalue normal \
                 -command  "$lab configure -state \$DemoBasic::var($lab,-state)"]
    pack $lab -anchor w -padx 5 -pady 5
    pack $chk -anchor w -padx 5
}


proc DemoBasic::_entry { parent } {
    set ent  [Entry $parent.entry -text "Press enter" \
                  -command  {set DemoBasic::var(entcmd) "-command called" ; after 500 {set DemoBasic::var(entcmd) ""}} \
                   -helptext "Entry widget"]
    set chk1 [BWidget::wrap checkbutton $parent.chk1 -text "Disabled" \
                  -variable DemoBasic::var($ent,state) \
                  -onvalue  disabled -offvalue normal \
                  -command  "$ent configure -state \$DemoBasic::var($ent,state)"]
    set chk2 [BWidget::wrap checkbutton $parent.chk2 -text "Non editable" \
                  -variable DemoBasic::var($ent,editable) \
                  -onvalue  false -offvalue true \
                  -command  "$ent configure -editable \$DemoBasic::var($ent,editable)"]
    set lab  [BWidget::wrap label $parent.cmd -textvariable DemoBasic::var(entcmd) -foreground red]
    pack $ent -pady 4 -anchor w -padx 5
    pack $chk1 $chk2 -anchor w -padx 5
    pack $lab -padx 5 -pady 5
}


proc DemoBasic::_button { parent } {
    variable var

    set frame [BWidget::wrap frame $parent.butfr]
    set but   [Button $frame.but -text "Press me!" \
                   -repeatdelay 300 \
                   -command  "DemoBasic::_butcmd command" \
                   -helptext "This is a Button widget"]
    set sep1  [Separator $frame.sep1 -orient vertical]
    set arr1  [ArrowButton $frame.arr1 -type button \
                   -width 25 -height 25 \
................................................................................

    set sep3  [Separator $parent.sep3 -orient horizontal]
    pack $sep3 -fill x -pady 10

    set labf1 [LabelFrame $parent.labf1 -text "Command" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf1 getframe]
    set chk1  [BWidget::wrap checkbutton $subf.chk1 -text "Disabled" \
                   -variable DemoBasic::var(bstate) -onvalue disabled -offvalue normal \
                   -command  "DemoBasic::_bstate \$DemoBasic::var(bstate) $but $arr1 $arr2"]
    set chk2  [BWidget::wrap checkbutton $subf.chk2 -text "Use -armcommand/\n-disarmcommand" \

                   -variable DemoBasic::var(barmcmd) \
                   -command  "DemoBasic::_barmcmd \$DemoBasic::var(barmcmd) $but $arr1 $arr2"]
    pack $chk1 $chk2 -anchor w -padx 5

    set label [Label $parent.label -textvariable DemoBasic::var(butcmd) -foreground red]
    pack $label -side bottom -pady 4

    set labf2 [LabelFrame $parent.labf2 -text "Direction" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf2 getframe]
    set var(bside) top
    foreach dir {top left bottom right} {
        set rad [BWidget::wrap radiobutton $subf.$dir -text "$dir arrow" \
                     -variable DemoBasic::var(bside) -value $dir \
                     -command  "DemoBasic::_bside \$DemoBasic::var(bside) $arr1 $arr2"]
        pack $rad -anchor w -padx 5
    }

    set labf3 [LabelFrame $parent.labf3 -text "Relief" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf3 getframe]
    set var(brelief) raised
    foreach {f lrelief} {f1 {raised sunken ridge groove} f2 {flat solid link}} {
        set f [BWidget::wrap frame $subf.$f]
        foreach relief $lrelief {
            set rad [BWidget::wrap radiobutton $f.$relief -text $relief \
                         -variable DemoBasic::var(brelief) -value $relief \
                         -command  "DemoBasic::_brelief \$DemoBasic::var(brelief) $but $arr1 $arr2"]
            pack $rad -anchor w -padx 5
        }
        pack $f -side left -padx 2 -anchor n
    }
    pack $labf1 $labf2 $labf3 -side left -fill y -padx 4
}


Changes to demo/demo.tcl.

1
2
3
4
5
6



7
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
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
#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec wish "$0" ${1+"[email protected]"}

namespace eval Demo {
    variable _wfont




    variable notebook
    variable mainframe
    variable status
    variable prgtext
    variable prgindic
    variable font
    variable font_name
    variable toolbar1  1
    variable toolbar2  1

    set pwd [pwd]
    cd [file dirname [info script]]
    variable DEMODIR [pwd]
    cd $pwd


    foreach script {
	manager.tcl basic.tcl select.tcl dnd.tcl tree.tcl tmpldlg.tcl
    } {
	namespace inscope :: source $DEMODIR/$script
    }
}


proc Demo::create { } {
    global   tk_patchLevel
    variable _wfont
    variable notebook
    variable mainframe
    variable font
    variable prgtext
    variable prgindic

    set prgtext "Please wait while loading font..."
    set prgindic -1
    _create_intro
    update
    SelectFont::loadfont

    bind all <F12> { catch {console show} }

    # Menu description
    set descmenu {
        "&File" all file 0 {
            {command "E&xit" {} "Exit BWidget demo" {} -command exit}
        }
        "&Options" all options 0 {
            {checkbutton "Toolbar &1" {all option} "Show/hide toolbar 1" {}
                -variable Demo::toolbar1
                -command  {$Demo::mainframe showtoolbar 0 $Demo::toolbar1}
            }
            {checkbutton "Toolbar &2" {all option} "Show/hide toolbar 2" {}
                -variable Demo::toolbar2
                -command  {$Demo::mainframe showtoolbar 1 $Demo::toolbar2}
            }
        }
    }

    set prgtext   "Creating MainFrame..."
    set prgindic  0
    set mainframe [MainFrame .mainframe \
                       -menu         $descmenu \
                       -textvariable Demo::status \
                       -progressvar  Demo::prgindic]

    # toolbar 1 creation
    incr prgindic
    set tb1  [$mainframe addtoolbar]
    set bbox [ButtonBox $tb1.bbox1 -spacing 0 -padx 1 -pady 1]
    $bbox add -image [Bitmap::get new] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Create a new file"
    $bbox add -image [Bitmap::get open] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Open an existing file"
    $bbox add -image [Bitmap::get save] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Save file"
    pack $bbox -side left -anchor w

    set sep [Separator $tb1.sep -orient vertical]
    pack $sep -side left -fill y -padx 4 -anchor w

    incr prgindic
    set bbox [ButtonBox $tb1.bbox2 -spacing 0 -padx 1 -pady 1]
    $bbox add -image [Bitmap::get cut] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Cut selection"
    $bbox add -image [Bitmap::get copy] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Copy selection"
    $bbox add -image [Bitmap::get paste] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Paste selection"
    pack $bbox -side left -anchor w

   # toolbar 2 creation
    incr prgindic
    set tb2    [$mainframe addtoolbar]
    set _wfont [SelectFont $tb2.font -type toolbar \
                    -command "Demo::update_font \[$tb2.font cget -font\]"]
    set font   [$_wfont cget -font]
    pack $_wfont -side left -anchor w

    $mainframe addindicator -text "BWidget [package version BWidget]"
    $mainframe addindicator -textvariable tk_patchLevel

    # NoteBook creation
    set frame    [$mainframe getframe]
    set notebook [NoteBook $frame.nb]

    set prgtext   "Creating Manager..."
    incr prgindic
    set f0  [DemoManager::create $notebook]
    set prgtext   "Creating Basic..."
    incr prgindic
    set f1  [DemoBasic::create $notebook]
    set prgtext   "Creating Select..."
    incr prgindic
    set f2 [DemoSelect::create $notebook]
    set prgtext   "Creating Dialog..."
    incr prgindic
    set f3b [DemoDlg::create $notebook]
    set prgtext   "Creating Drag and Drop..."
    incr prgindic
    set f4 [DemoDnd::create $notebook]
    set prgtext   "Creating Tree..."
    incr prgindic
    set f5 [DemoTree::create $notebook]

    set prgtext   "Done"
    incr prgindic
    $notebook compute_size
    pack $notebook -fill both -expand yes -padx 4 -pady 4
    $notebook raise [$notebook page 0]

    pack $mainframe -fill both -expand yes
    update idletasks
    destroy .intro
}


proc Demo::update_font { newfont } {
    variable _wfont
    variable notebook
    variable font
    variable font_name

    . configure -cursor watch
    if { $font != $newfont } {
        $_wfont configure -font $newfont
        $notebook configure -font $newfont
        set font $newfont
    }
    . configure -cursor ""
}


proc Demo::_create_intro { } {
    variable DEMODIR

    set top [toplevel .intro -relief raised -borderwidth 2]

    wm withdraw $top
    wm overrideredirect $top 1

    set ximg  [label $top.x -bitmap @$DEMODIR/x1.xbm \
	    -foreground grey90 -background white]
    set bwimg [label $ximg.bw -bitmap @$DEMODIR/bwidget.xbm \
	    -foreground grey90 -background white]
    set frame [frame $ximg.f -background white]
    set lab1  [label $frame.lab1 -text "Loading demo" \
	    -background white -font {times 8}]
    set lab2  [label $frame.lab2 -textvariable Demo::prgtext \
	    -background white -font {times 8} -width 35]
    set prg   [ProgressBar $frame.prg -width 50 -height 10 -background white \
	    -variable Demo::prgindic -maximum 10]
    pack $lab1 $lab2 $prg
    place $frame -x 0 -y 0 -anchor nw
    place $bwimg -relx 1 -rely 1 -anchor se
    pack $ximg
    BWidget::place $top 0 0 center
    wm deiconify $top
}


proc Demo::main {} {
    variable DEMODIR

    lappend ::auto_path [file dirname $DEMODIR]
    package require BWidget

    option add *TitleFrame.l.font {helvetica 11 bold italic}


    wm withdraw .
    wm title . "BWidget demo"

    Demo::create
    BWidget::place . 0 0 center
    wm deiconify .
    raise .
    focus -force .

}

Demo::main
wm geom . [wm geom .]



|
|
>
>
>
|
<
<
<
<
<
<
<
<
<

<
|
<
<
>

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|

<
>

<
<
<
|
<
<
<
<
>
|
<
<

1
2
3
4
5
6
7
8
9
10









11

12


13
14














































































































































































15
16

17
18



19




20
21


22
#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec wish "$0" ${1+"[email protected]"}

# ----------------------------------------------------------------------------
#  demo.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: demo.tcl,v 1.6 2009/09/08 21:22:09 oberdorfer Exp $
# ----------------------------------------------------------------------------
#











set appDir [file dirname [info script]]


lappend auto_path [file join $appDir ".."]















































































































































































package require BWidget 1.9.1


source [file join $appDir "demo_main.tcl"]




Demo::main




Demo::setTheme



wm geom . [wm geom .]

Added demo/demo_main.tcl.












































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
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
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
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
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
276
277
278
# ----------------------------------------------------------------------------
#  manager.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: demo_main.tcl,v 1.1 2009/09/08 21:22:09 oberdorfer Exp $
# ----------------------------------------------------------------------------
#

namespace eval Demo {
    variable _wfont

    variable notebook
    variable mainframe
    variable status
    variable prgtext
    variable prgindic
    variable font
    variable font_name
    variable toolbar1  1
    variable toolbar2  1

    set appDir [file dirname [info script]]

    set pwd [pwd]
    cd $appDir
    variable DEMODIR [pwd]
    cd $pwd

    foreach script {
	manager.tcl basic.tcl select.tcl dnd.tcl tree.tcl tmpldlg.tcl
    } {
	namespace inscope :: source $DEMODIR/$script
    }

    variable THEME_DIR [file join $appDir "themes"]
    variable CTHEME "default"
}


proc Demo::_get_available_themes { } {
  variable THEME_DIR
  set themes [list default]
  
  if { [BWidget::using ttk] } {
      foreach dir [glob -nocomplain [file join $THEME_DIR "*"]] {
        if { [file isdirectory $dir] } {
           lappend themes [file tail $dir]
      }}
  } else {
      foreach dcls [BWidget::get_colordcls] {
          if { [lsearch $themes $dcls] == -1 } {
              lappend themes $dcls
      }}
  }

  return $themes
}


proc Demo::setTheme { {newtheme ""} } {
  variable CTHEME

  if { ![llength [set themes [_get_available_themes]]] } {
      return
  }

  if { ![string length $newtheme] } {
      set newtheme $CTHEME
  }

  if { [lsearch $themes $newtheme] == -1} {
      set newtheme [lindex $themes 0]
  }

  if { [BWidget::using ttk] } {

      namespace inscope :: package require ttk::theme::${newtheme}
      ttk::setTheme $newtheme

  } else {

      set BWidget::colors(style) $newtheme
      event generate . <<ThemeChanged>>
  }  
}


proc Demo::create { } {
    global   tk_patchLevel
    variable _wfont
    variable notebook
    variable mainframe
    variable font
    variable prgtext
    variable prgindic
    variable CTHEME

    set prgtext "Please wait while loading font..."
    set prgindic -1
    _create_intro
    update
    SelectFont::loadfont

    bind all <F12>    { catch {console show} }
    bind all <Escape> { exit 0 }


    # Menu description
    set descmenu {
        "&File" all file 0 {
            {command "E&xit" {} "Exit BWidget demo" {} -command exit}
        }
        "&Options" all options 0 {
            {checkbutton "Toolbar &1" {all option} "Show/hide toolbar 1" {}
                -variable Demo::toolbar1
                -command  {$Demo::mainframe showtoolbar 0 $Demo::toolbar1}
            }
            {checkbutton "Toolbar &2" {all option} "Show/hide toolbar 2" {}
                -variable Demo::toolbar2
                -command  {$Demo::mainframe showtoolbar 1 $Demo::toolbar2}
            }
        }
    }

    set prgtext   "Creating MainFrame..."
    set prgindic  0
    set mainframe [MainFrame .mainframe \
                       -menu         $descmenu \
                       -textvariable Demo::status \
                       -progressvar  Demo::prgindic]

    # toolbar 1 creation
    incr prgindic
    set tb1  [$mainframe addtoolbar]
    set bbox [ButtonBox $tb1.bbox1 -spacing 0 -padx 1 -pady 1]
    $bbox add -image [Bitmap::get new] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Create a new file"
    $bbox add -image [Bitmap::get open] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Open an existing file"
    $bbox add -image [Bitmap::get save] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Save file"
    pack $bbox -side left -anchor w

    set sep [Separator $tb1.sep -orient vertical]
    pack $sep -side left -fill y -padx 4 -anchor w

    incr prgindic
    set bbox [ButtonBox $tb1.bbox2 -spacing 0 -padx 1 -pady 1]
    $bbox add -image [Bitmap::get cut] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Cut selection"
    $bbox add -image [Bitmap::get copy] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Copy selection"
    $bbox add -image [Bitmap::get paste] \
        -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
        -helptext "Paste selection"
    pack $bbox -side left -anchor w

    # toolbar 2 creation
    incr prgindic
    set tb2    [$mainframe addtoolbar]
    set _wfont [SelectFont $tb2.font -type toolbar \
                    -command "Demo::update_font \[$tb2.font cget -font\]"]
    set font   [$_wfont cget -font]
    pack $_wfont -side left -anchor w

    BWidget::wrap label $tb2.l -text "Theme: "
    ComboBox $tb2.cb \
           -values "[[namespace current]::_get_available_themes]" \
	   -text $CTHEME \
	   -modifycmd "[namespace current]::setTheme \[$tb2.cb cget -text\]" \
           -editable 0 \
	   -hottrack 1

        pack $tb2.cb $tb2.l -side right

    $mainframe addindicator -text "BWidget [package version BWidget]"
    $mainframe addindicator -textvariable tk_patchLevel

    # NoteBook creation
    set frame    [$mainframe getframe]
    set notebook [NoteBook $frame.nb]

    set prgtext   "Creating Manager..."
    incr prgindic
    set f0  [DemoManager::create $notebook]
    set prgtext   "Creating Basic..."
    incr prgindic
    set f1  [DemoBasic::create $notebook]
    set prgtext   "Creating Select..."
    incr prgindic
    set f2 [DemoSelect::create $notebook]
    set prgtext   "Creating Dialog..."
    incr prgindic
    set f3b [DemoDlg::create $notebook]
    set prgtext   "Creating Drag and Drop..."
    incr prgindic
    set f4 [DemoDnd::create $notebook]
    set prgtext   "Creating Tree..."
    incr prgindic
    set f5 [DemoTree::create $notebook]

    set prgtext   "Done"
    incr prgindic
    $notebook compute_size
    pack $notebook -fill both -expand yes -padx 4 -pady 4
    $notebook raise [$notebook page 0]

    pack $mainframe -fill both -expand yes
    update idletasks
    destroy .intro
}


proc Demo::update_font { newfont } {
    variable _wfont
    variable notebook
    variable font
    variable font_name

    . configure -cursor watch
    if { $font != $newfont } {
        $_wfont configure -font $newfont
        $notebook configure -font $newfont
        set font $newfont
    }
    . configure -cursor ""
}


proc Demo::_create_intro { } {
    variable DEMODIR

    set top [toplevel .intro -relief raised -borderwidth 2]

    wm withdraw $top
    wm overrideredirect $top 1

    set ximg  [label $top.x -bitmap @$DEMODIR/x1.xbm \
	    -foreground grey90 -background white]
    set bwimg [label $ximg.bw -bitmap @$DEMODIR/bwidget.xbm \
	    -foreground grey90 -background white]
    set frame [frame $ximg.f -background white]
    set lab1  [label $frame.lab1 -text "Loading demo" \
	    -background white -font {times 8}]
    set lab2  [label $frame.lab2 -textvariable Demo::prgtext \
	    -background white -font {times 8} -width 35]
    set prg   [ProgressBar $frame.prg -width 50 -height 10 -background white \
	    -variable Demo::prgindic -maximum 10]
    pack $lab1 $lab2 $prg
    place $frame -x 0 -y 0 -anchor nw
    place $bwimg -relx 1 -rely 1 -anchor se
    pack $ximg
    BWidget::place $top 0 0 center
    wm deiconify $top
}


proc Demo::main {} {
    variable DEMODIR

    lappend ::auto_path [file dirname $DEMODIR]
    package require BWidget

    option add *TitleFrame.l.font {helvetica 11 bold italic}

    wm withdraw .
    wm title . "BWidget demo"

    Demo::create
    BWidget::place . 0 0 center
    wm deiconify .
    raise .
    focus -force .
}

Added demo/demo_tile.tcl.














































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec wish "$0" ${1+"[email protected]"}

set appDir [file dirname [info script]]
lappend auto_path [file join $appDir ".."]

set dir [file join $appDir "themes"]
if {[lsearch -exact auto_path $dir] == -1} {
    lappend auto_path $dir
}

package require tile 0.8

package require BWidget 1.9.1
::BWidget::usepackage ttk

source [file join $appDir "demo_main.tcl"]

Demo::main
after idle Demo::setTheme

wm geom . [wm geom .]

Changes to demo/dnd.tcl.







1
2
3
4
5
6
7






namespace eval DemoDnd {
}


proc DemoDnd::create { nb } {

>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
# ----------------------------------------------------------------------------
#  dnd.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dnd.tcl,v 1.2 2009/09/08 21:22:09 oberdorfer Exp $
# ----------------------------------------------------------------------------
#

namespace eval DemoDnd {
}


proc DemoDnd::create { nb } {

Changes to demo/manager.tcl.






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
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






namespace eval DemoManager {
    variable _progress 0
    variable _afterid  ""
    variable _status "Compute in progress..."
    variable _homogeneous 0
}


proc DemoManager::create { nb } {
    set frame [$nb insert end demoManager -text "Manager"]

    set topf  [frame $frame.topf]
    set titf1 [TitleFrame $topf.titf1 -text "MainFrame"]
    set titf2 [TitleFrame $topf.titf2 -text "NoteBook"]
    set titf3 [TitleFrame $frame.titf3 -text "Paned & ScrolledWindow"]

    _mainframe [$titf1 getframe]
    _notebook  [$titf2 getframe]
    _paned     [$titf3 getframe]
................................................................................
}


proc DemoManager::_mainframe { parent } {
    set labf1 [LabelFrame $parent.labf1 -text "Toolbar" -side top -anchor w \
                   -relief sunken -borderwidth 2]
    set subf  [$labf1 getframe]
    checkbutton $subf.chk1 -text "View toolbar 1" -variable Demo::toolbar1 \
        -command {$Demo::mainframe showtoolbar 0 $Demo::toolbar1}
    checkbutton $subf.chk2 -text "View toolbar 2" -variable Demo::toolbar2 \
        -command {$Demo::mainframe showtoolbar 1 $Demo::toolbar2}
    pack $subf.chk1 $subf.chk2 -anchor w -fill x
    pack $labf1 -fill both

    set labf2 [LabelFrame $parent.labf2 -text "Status bar" -side top -anchor w \
                   -relief sunken -borderwidth 2]
    set subf  [$labf2 getframe]
    checkbutton $subf.chk1 -text "Show Progress\nindicator" -justify left \
        -variable DemoManager::_progress \
        -command  {DemoManager::_show_progress}
    pack $subf.chk1 -anchor w -fill x

    pack $labf1 $labf2 -side left -padx 4 -fill both
}


proc DemoManager::_notebook { parent } {
    checkbutton $parent.chk1 -text "Homogeneous label" \
        -variable DemoManager::_homogeneous \
        -command  {$Demo::notebook configure -homogeneous $DemoManager::_homogeneous}
    pack $parent.chk1 -side left -anchor n -fill x
}



proc DemoManager::_paned { parent } {
    set pw1   [PanedWindow $parent.pw -side top]
    set pane  [$pw1 add -minsize 100]

    set pw2    [PanedWindow $pane.pw -side left]
    set pane1  [$pw2 add -minsize 100]
    set pane2  [$pw2 add -minsize 100]
    set pane3  [$pw1 add -minsize 100]

    foreach pane [list $pane1 $pane2] {
        set sw    [ScrolledWindow $pane.sw]

        set lb    [listbox $sw.lb -height 8 -width 20 -highlightthickness 0]


        for {set i 1} {$i <= 8} {incr i} {
            $lb insert end "Value $i"

        }
        $sw setwidget $lb
        pack $sw -fill both -expand yes
    }

    set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2]
    set sf [ScrollableFrame $sw.f]
    $sw setwidget $sf
    set subf [$sf getframe]
    set lab [label $subf.lab -text "This is a ScrollableFrame"]
    set chk [checkbutton $subf.chk -text "Constrained width" \
                 -variable DemoManager::_constw \
                 -command  "$sf configure -constrainedwidth \$DemoManager::_constw"]
    pack $lab
    pack $chk -anchor w
    bind $chk <FocusIn> "$sf see $chk"
    for {set i 0} {$i <= 20} {incr i} {
        pack [entry $subf.ent$i -width 50]  -fill x -pady 4
	bind $subf.ent$i <FocusIn> "$sf see $subf.ent$i"
        $subf.ent$i insert end "Text field $i"
    }

    pack $sw $pw2 $pw1 -fill both -expand yes
}

>
>
>
>
>
|












|







 







|

|

|





|


|






|


|

<
<












>
|
>
>

|
>









|
|



|


|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
..
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
102
103
104
105
106
107
108
# ----------------------------------------------------------------------------
#  manager.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: manager.tcl,v 1.3 2009/09/08 21:22:09 oberdorfer Exp $
# ----------------------------------------------------------------------------
#

namespace eval DemoManager {
    variable _progress 0
    variable _afterid  ""
    variable _status "Compute in progress..."
    variable _homogeneous 0
}


proc DemoManager::create { nb } {
    set frame [$nb insert end demoManager -text "Manager"]

    set topf  [BWidget::wrap frame $frame.topf]
    set titf1 [TitleFrame $topf.titf1 -text "MainFrame"]
    set titf2 [TitleFrame $topf.titf2 -text "NoteBook"]
    set titf3 [TitleFrame $frame.titf3 -text "Paned & ScrolledWindow"]

    _mainframe [$titf1 getframe]
    _notebook  [$titf2 getframe]
    _paned     [$titf3 getframe]
................................................................................
}


proc DemoManager::_mainframe { parent } {
    set labf1 [LabelFrame $parent.labf1 -text "Toolbar" -side top -anchor w \
                   -relief sunken -borderwidth 2]
    set subf  [$labf1 getframe]
    BWidget::wrap checkbutton $subf.chk1 -text "View toolbar 1" -variable Demo::toolbar1 \
        -command {$Demo::mainframe showtoolbar 0 $Demo::toolbar1}
    BWidget::wrap checkbutton $subf.chk2 -text "View toolbar 2" -variable Demo::toolbar2 \
        -command {$Demo::mainframe showtoolbar 1 $Demo::toolbar2}
    pack $subf.chk1 $subf.chk2 -anchor w -fill x -padx 5
    pack $labf1 -fill both

    set labf2 [LabelFrame $parent.labf2 -text "Status bar" -side top -anchor w \
                   -relief sunken -borderwidth 2]
    set subf  [$labf2 getframe]
    BWidget::wrap checkbutton $subf.chk1 -text "Show Progress\nindicator" \
        -variable DemoManager::_progress \
        -command  {DemoManager::_show_progress}
    pack $subf.chk1 -anchor w -fill x -padx 5

    pack $labf1 $labf2 -side left -padx 4 -fill both
}


proc DemoManager::_notebook { parent } {
    BWidget::wrap checkbutton $parent.chk1 -text "Homogeneous label" \
        -variable DemoManager::_homogeneous \
        -command  {$Demo::notebook configure -homogeneous $DemoManager::_homogeneous}
    pack $parent.chk1 -side left -anchor n -fill x -padx 5
}



proc DemoManager::_paned { parent } {
    set pw1   [PanedWindow $parent.pw -side top]
    set pane  [$pw1 add -minsize 100]

    set pw2    [PanedWindow $pane.pw -side left]
    set pane1  [$pw2 add -minsize 100]
    set pane2  [$pw2 add -minsize 100]
    set pane3  [$pw1 add -minsize 100]

    foreach pane [list $pane1 $pane2] {
        set sw    [ScrolledWindow $pane.sw]
        set lb    [ListBox $sw.lb \
	               -height 8 -width 20 -highlightthickness 0 \
		       -selectmode multiple -selectfill 1]

        for {set i 1} {$i <= 8} {incr i} {
            $lb insert end item:$i \
	        -text "Value $i" -image [Bitmap::get file]
        }
        $sw setwidget $lb
        pack $sw -fill both -expand yes
    }

    set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2]
    set sf [ScrollableFrame $sw.f]
    $sw setwidget $sf
    set subf [$sf getframe]
    set lab [Label $subf.lab -text "This is a ScrollableFrame"]
    set chk [BWidget::wrap checkbutton $subf.chk -text "Constrained width" \
                 -variable DemoManager::_constw \
                 -command  "$sf configure -constrainedwidth \$DemoManager::_constw"]
    pack $lab
    pack $chk -anchor w -padx 5
    bind $chk <FocusIn> "$sf see $chk"
    for {set i 0} {$i <= 20} {incr i} {
        pack [Entry $subf.ent$i -width 50]  -fill x -pady 4
	bind $subf.ent$i <FocusIn> "$sf see $subf.ent$i"
        $subf.ent$i insert end "Text field $i"
    }

    pack $sw $pw2 $pw1 -fill both -expand yes
}

Changes to demo/select.tcl.








1
2
3
4
5
6
7
..
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
..
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59






namespace eval DemoSelect {
    variable var
}


proc DemoSelect::create { nb } {
    set frame [$nb insert end demoSelect -text "Spin & Combo"]
................................................................................
    set ent   [LabelEntry $subf.ent -label "Linked var" -labelwidth 10 -labelanchor w \
                   -textvariable DemoSelect::var(spin,var) -editable 0 \
                   -helptext "This is an Entry reflecting\nthe linked var of SpinBox"]
    set labf  [LabelFrame $subf.options -text "Options" -side top -anchor w \
                   -relief sunken -borderwidth 1 \
                   -helptext "Modify some options of SpinBox"]
    set subf  [$labf getframe]
    set chk1  [checkbutton $subf.chk1 -text "Non editable" \
                   -variable DemoSelect::var(spin,editable) -onvalue false -offvalue true \
                   -command "$spin configure -editable \$DemoSelect::var(spin,editable)"]
    set chk2  [checkbutton $subf.chk2 -text "Disabled" \
                   -variable DemoSelect::var(spin,state) -onvalue disabled -offvalue normal \
                   -command "$spin configure -state \$DemoSelect::var(spin,state)"]

    pack $chk1 $chk2 -side left -anchor w
    pack $spin $ent $labf -pady 4 -fill x
    pack $titf1

    set titf2 [TitleFrame $frame.titf2 -text ComboBox]
    set subf  [$titf2 getframe]
    set combo [ComboBox $subf.combo \
                   -textvariable DemoSelect::var(combo,var) \
                   -values {"first value" "second value" "third value" "fourth value" "fifth value"} \
................................................................................
    set ent   [LabelEntry $subf.ent -label "Linked var" -labelwidth 10 -labelanchor w \
                   -textvariable DemoSelect::var(combo,var) -editable 0 \
                   -helptext "This is an Entry reflecting\nthe linked var of ComboBox"]
    set labf  [LabelFrame $subf.options -text "Options" -side top -anchor w \
                   -relief sunken -borderwidth 1 \
                   -helptext "Modify some options of SpinBox"]
    set subf  [$labf getframe]
    set chk1  [checkbutton $subf.chk1 -text "Non editable" \
                   -variable DemoSelect::var(combo,editable) -onvalue false -offvalue true \
                   -command  "$combo configure -editable \$DemoSelect::var(combo,editable)"]
    set chk2  [checkbutton $subf.chk2 -text "Disabled" \
                   -variable DemoSelect::var(combo,state) -onvalue disabled -offvalue normal \
                   -command  "$combo configure -state \$DemoSelect::var(combo,state)"]

    pack $chk1 $chk2 -side left -anchor w
    pack $combo $ent $labf -pady 4 -fill x

    pack $titf1 $titf2 -pady 4

    return $frame
}

>
>
>
>
>
>
>







 







|


|



|
|







 







|


|



|
|

|




1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
..
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
# ----------------------------------------------------------------------------
#  select.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: select.tcl,v 1.3 2009/09/08 21:22:09 oberdorfer Exp $
# ----------------------------------------------------------------------------
#

namespace eval DemoSelect {
    variable var
}


proc DemoSelect::create { nb } {
    set frame [$nb insert end demoSelect -text "Spin & Combo"]
................................................................................
    set ent   [LabelEntry $subf.ent -label "Linked var" -labelwidth 10 -labelanchor w \
                   -textvariable DemoSelect::var(spin,var) -editable 0 \
                   -helptext "This is an Entry reflecting\nthe linked var of SpinBox"]
    set labf  [LabelFrame $subf.options -text "Options" -side top -anchor w \
                   -relief sunken -borderwidth 1 \
                   -helptext "Modify some options of SpinBox"]
    set subf  [$labf getframe]
    set chk1  [BWidget::wrap checkbutton $subf.chk1 -text "Non editable" \
                   -variable DemoSelect::var(spin,editable) -onvalue false -offvalue true \
                   -command "$spin configure -editable \$DemoSelect::var(spin,editable)"]
    set chk2  [BWidget::wrap checkbutton $subf.chk2 -text "Disabled" \
                   -variable DemoSelect::var(spin,state) -onvalue disabled -offvalue normal \
                   -command "$spin configure -state \$DemoSelect::var(spin,state)"]

    pack $chk1 $chk2 -side left -anchor w -padx 5
    pack $spin $ent $labf -padx 5 -pady 5 -fill x
    pack $titf1

    set titf2 [TitleFrame $frame.titf2 -text ComboBox]
    set subf  [$titf2 getframe]
    set combo [ComboBox $subf.combo \
                   -textvariable DemoSelect::var(combo,var) \
                   -values {"first value" "second value" "third value" "fourth value" "fifth value"} \
................................................................................
    set ent   [LabelEntry $subf.ent -label "Linked var" -labelwidth 10 -labelanchor w \
                   -textvariable DemoSelect::var(combo,var) -editable 0 \
                   -helptext "This is an Entry reflecting\nthe linked var of ComboBox"]
    set labf  [LabelFrame $subf.options -text "Options" -side top -anchor w \
                   -relief sunken -borderwidth 1 \
                   -helptext "Modify some options of SpinBox"]
    set subf  [$labf getframe]
    set chk1  [BWidget::wrap checkbutton $subf.chk1 -text "Non editable" \
                   -variable DemoSelect::var(combo,editable) -onvalue false -offvalue true \
                   -command  "$combo configure -editable \$DemoSelect::var(combo,editable)"]
    set chk2  [BWidget::wrap checkbutton $subf.chk2 -text "Disabled" \
                   -variable DemoSelect::var(combo,state) -onvalue disabled -offvalue normal \
                   -command  "$combo configure -state \$DemoSelect::var(combo,state)"]

    pack $chk1 $chk2 -side left -anchor w -padx 5
    pack $combo $ent $labf -padx 5 -pady 5 -fill x

    pack $titf1 $titf2 -padx 5 -pady 5

    return $frame
}

Changes to demo/tmpldlg.tcl.







1
2
3
4
5
6
7
..
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
..
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
..
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
...
175
176
177
178
179
180
181

182

183
184
185
186
187
188
189






namespace eval DemoDlg {
    variable tmpl
    variable msg
    variable progmsg
    variable progval
    variable resources "en"
................................................................................
    set titf1 [TitleFrame $frame.titf1 -text "Resources"]
    set titf2 [TitleFrame $frame.titf2 -text "Template Dialog"]
    set titf3 [TitleFrame $frame.titf3 -text "Message Dialog"]
    set titf4 [TitleFrame $frame.titf4 -text "Other dialog"]

    set subf [$titf1 getframe]
    set cmd  {option read [file join $::BWIDGET::LIBRARY "lang" $DemoDlg::resources.rc]}
    set rad1 [radiobutton $subf.rad1 -text "English" \
                  -variable DemoDlg::resources -value en \
                  -command  $cmd]
    set rad2 [radiobutton $subf.rad2 -text "French" \
                  -variable DemoDlg::resources -value fr \
                  -command  $cmd]
    set rad3 [radiobutton $subf.rad3 -text "German" \
                  -variable DemoDlg::resources -value de \
                  -command  $cmd]
    pack $rad1 $rad2 $rad3 -side left

    _tmpldlg [$titf2 getframe]
    _msgdlg  [$titf3 getframe]
    _stddlg  [$titf4 getframe]

    pack $titf1 -fill x -pady 2 -padx 2
    pack $titf4 -side bottom -fill x -pady 2 -padx 2
................................................................................

    set tmpl(side)   bottom
    set tmpl(anchor) c

    set labf1 [LabelFrame $parent.labf1 -text "Button side" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf1 getframe]
    radiobutton $subf.rad1 -text "Bottom" \
        -variable DemoDlg::tmpl(side) -value bottom -anchor w
    radiobutton $subf.rad2 -text "Left" \
        -variable DemoDlg::tmpl(side) -value left   -anchor w
    radiobutton $subf.rad3 -text "Right" \
        -variable DemoDlg::tmpl(side) -value right  -anchor w
    radiobutton $subf.rad4 -text "Top" \
        -variable DemoDlg::tmpl(side) -value top    -anchor w

    pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 -fill x -anchor w

    set labf2 [LabelFrame $parent.labf2 -text "Button anchor" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf2 getframe]
    radiobutton $subf.rad1 -text "North" \
        -variable DemoDlg::tmpl(anchor) -value n -anchor w
    radiobutton $subf.rad2 -text "West" \
        -variable DemoDlg::tmpl(anchor) -value w -anchor w
    radiobutton $subf.rad3 -text "East" \
        -variable DemoDlg::tmpl(anchor) -value e -anchor w
    radiobutton $subf.rad4 -text "South" \
        -variable DemoDlg::tmpl(anchor) -value s -anchor w
    radiobutton $subf.rad5 -text "Center" \
        -variable DemoDlg::tmpl(anchor) -value c -anchor w

    pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 $subf.rad5 -fill x -anchor w

    set sep    [Separator  $parent.sep -orient horizontal]

    set button [button $parent.but -text "Show" -command DemoDlg::_show_tmpldlg]

    pack $button -side bottom
    pack $sep -side bottom -fill x -pady 10
    pack $labf1 $labf2 -side left -padx 4 -anchor n
}


................................................................................

    set msg(type) ok
    set msg(icon) info

    set labf1 [LabelFrame $parent.labf1 -text "Type" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf1 getframe]
    radiobutton $subf.rad1 -text "Ok" -variable DemoDlg::msg(type) -value ok -anchor w
    radiobutton $subf.rad2 -text "Ok, Cancel" -variable DemoDlg::msg(type) -value okcancel -anchor w
    radiobutton $subf.rad3 -text "Retry, Cancel" -variable DemoDlg::msg(type) -value retrycancel -anchor w
    radiobutton $subf.rad4 -text "Yes, No" -variable DemoDlg::msg(type) -value yesno -anchor w
    radiobutton $subf.rad5 -text "Yes, No, Cancel" -variable DemoDlg::msg(type) -value yesnocancel -anchor w
    radiobutton $subf.rad6 -text "Abort, Retry, Ignore" -variable DemoDlg::msg(type) -value abortretryignore -anchor w
    radiobutton $subf.rad7 -text "User" -variable DemoDlg::msg(type) -value user -anchor w
    Entry $subf.user -textvariable DemoDlg::msg(buttons)

    pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 $subf.rad5 $subf.rad6 -fill x -anchor w
    pack $subf.rad7 $subf.user -side left

    set labf2 [LabelFrame $parent.labf2 -text "Icon" -side top -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf2 getframe]
    radiobutton $subf.rad1 -text "Information" -variable DemoDlg::msg(icon) -value info     -anchor w
    radiobutton $subf.rad2 -text "Question"    -variable DemoDlg::msg(icon) -value question -anchor w
    radiobutton $subf.rad3 -text "Warning"     -variable DemoDlg::msg(icon) -value warning  -anchor w
    radiobutton $subf.rad4 -text "Error"       -variable DemoDlg::msg(icon) -value error    -anchor w
    pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 -fill x -anchor w


    set sep    [Separator  $parent.sep -orient horizontal]
    set button [button $parent.but -text "Show" -command DemoDlg::_show_msgdlg]

    pack $button -side bottom
    pack $sep -side bottom -fill x -pady 10
    pack $labf1 $labf2 -side left -padx 4 -anchor n
}


proc DemoDlg::_stddlg { parent } {





    set but0  [button $parent.but0 \
                   -text "Select a color " \
                   -command "DemoDlg::_show_color $parent.but0"]

    set but1  [button $parent.but1 \




                   -text    "Font selector dialog" \
                   -command DemoDlg::_show_fontdlg]
    set but2  [button $parent.but2 \


                   -text    "Progression dialog" \
                   -command DemoDlg::_show_progdlg]
    set but3  [button $parent.but3 \


                   -text    "Password dialog" \
                   -command DemoDlg::_show_passdlg]

    pack $but0 $but1 $but2 $but3 -side left -padx 5 -anchor w
}


proc DemoDlg::_show_color {w} {







    set color [SelectColor::menu $w.color [list below $w] \
                       -color [$w cget -background]]






    if {[string length $color]} {






        $w configure -background $color

    }
}

proc DemoDlg::_show_tmpldlg { } {
    variable tmpl

    set dlg [Dialog .tmpldlg -parent . -modal local \
................................................................................
        -type    $msg(type) \
        -icon    $msg(icon) \
        -buttons $msg(buttons)
}


proc DemoDlg::_show_fontdlg { } {

    set font [SelectFont .fontdlg -parent . -font $Demo::font]

    if { $font != "" } {
        Demo::update_font $font
    }
}


proc DemoDlg::_show_progdlg { } {
>
>
>
>
>
>







 







|


|


|


|







 







|
|
|
|
|
|
|
|

|




|
|
|
|
|
|
|
|
|
|

|


>
|







 







|
|
|
|
|
|
|


|
|



|
|
|
|
|



|








>
>
>
>
>
|
|
|
>
|
>
>
>
>


<
>
>


<
>
>



|


>
|
>
>
>
>
>
>
>
|
<
>
>
>
>
>
>
|
>
>
>
>
>
>
|
>







 







>

>







1
2
3
4
5
6
7
8
9
10
11
12
13
..
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
..
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
..
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
...
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
# ----------------------------------------------------------------------------
#  tmpldlg.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tmpldlg.tcl,v 1.5 2009/09/08 21:21:43 oberdorfer Exp $
# ----------------------------------------------------------------------------
#

namespace eval DemoDlg {
    variable tmpl
    variable msg
    variable progmsg
    variable progval
    variable resources "en"
................................................................................
    set titf1 [TitleFrame $frame.titf1 -text "Resources"]
    set titf2 [TitleFrame $frame.titf2 -text "Template Dialog"]
    set titf3 [TitleFrame $frame.titf3 -text "Message Dialog"]
    set titf4 [TitleFrame $frame.titf4 -text "Other dialog"]

    set subf [$titf1 getframe]
    set cmd  {option read [file join $::BWIDGET::LIBRARY "lang" $DemoDlg::resources.rc]}
    set rad1 [BWidget::wrap radiobutton $subf.rad1 -text "English" \
                  -variable DemoDlg::resources -value en \
                  -command  $cmd]
    set rad2 [BWidget::wrap radiobutton $subf.rad2 -text "French" \
                  -variable DemoDlg::resources -value fr \
                  -command  $cmd]
    set rad3 [BWidget::wrap radiobutton $subf.rad3 -text "German" \
                  -variable DemoDlg::resources -value de \
                  -command  $cmd]
    pack $rad1 $rad2 $rad3 -side left -padx 5

    _tmpldlg [$titf2 getframe]
    _msgdlg  [$titf3 getframe]
    _stddlg  [$titf4 getframe]

    pack $titf1 -fill x -pady 2 -padx 2
    pack $titf4 -side bottom -fill x -pady 2 -padx 2
................................................................................

    set tmpl(side)   bottom
    set tmpl(anchor) c

    set labf1 [LabelFrame $parent.labf1 -text "Button side" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf1 getframe]
    BWidget::wrap radiobutton $subf.rad1 -text "Bottom" \
        -variable DemoDlg::tmpl(side) -value bottom
    BWidget::wrap radiobutton $subf.rad2 -text "Left" \
        -variable DemoDlg::tmpl(side) -value left
    BWidget::wrap radiobutton $subf.rad3 -text "Right" \
        -variable DemoDlg::tmpl(side) -value right
    BWidget::wrap radiobutton $subf.rad4 -text "Top" \
        -variable DemoDlg::tmpl(side) -value top

    pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 -anchor w -padx 5

    set labf2 [LabelFrame $parent.labf2 -text "Button anchor" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf2 getframe]
    BWidget::wrap radiobutton $subf.rad1 -text "North" \
        -variable DemoDlg::tmpl(anchor) -value n
    BWidget::wrap radiobutton $subf.rad2 -text "West" \
        -variable DemoDlg::tmpl(anchor) -value w
    BWidget::wrap radiobutton $subf.rad3 -text "East" \
        -variable DemoDlg::tmpl(anchor) -value e
    BWidget::wrap radiobutton $subf.rad4 -text "South" \
        -variable DemoDlg::tmpl(anchor) -value s
    BWidget::wrap radiobutton $subf.rad5 -text "Center" \
        -variable DemoDlg::tmpl(anchor) -value c

    pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 $subf.rad5 -anchor w -padx 5

    set sep    [Separator  $parent.sep -orient horizontal]
    set button [Button $parent.but -text "Show" \
                                 -command DemoDlg::_show_tmpldlg]

    pack $button -side bottom
    pack $sep -side bottom -fill x -pady 10
    pack $labf1 $labf2 -side left -padx 4 -anchor n
}


................................................................................

    set msg(type) ok
    set msg(icon) info

    set labf1 [LabelFrame $parent.labf1 -text "Type" -side top \
                   -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf1 getframe]
    BWidget::wrap radiobutton $subf.rad1 -text "Ok" -variable DemoDlg::msg(type) -value ok
    BWidget::wrap radiobutton $subf.rad2 -text "Ok, Cancel" -variable DemoDlg::msg(type) -value okcancel
    BWidget::wrap radiobutton $subf.rad3 -text "Retry, Cancel" -variable DemoDlg::msg(type) -value retrycancel
    BWidget::wrap radiobutton $subf.rad4 -text "Yes, No" -variable DemoDlg::msg(type) -value yesno
    BWidget::wrap radiobutton $subf.rad5 -text "Yes, No, Cancel" -variable DemoDlg::msg(type) -value yesnocancel
    BWidget::wrap radiobutton $subf.rad6 -text "Abort, Retry, Ignore" -variable DemoDlg::msg(type) -value abortretryignore
    BWidget::wrap radiobutton $subf.rad7 -text "User" -variable DemoDlg::msg(type) -value user
    Entry $subf.user -textvariable DemoDlg::msg(buttons)

    pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 $subf.rad5 $subf.rad6 -anchor w -padx 5
    pack $subf.rad7 $subf.user -side left -padx 5

    set labf2 [LabelFrame $parent.labf2 -text "Icon" -side top -anchor w -relief sunken -borderwidth 1]
    set subf  [$labf2 getframe]
    BWidget::wrap radiobutton $subf.rad1 -text "Information" -variable DemoDlg::msg(icon) -value info
    BWidget::wrap radiobutton $subf.rad2 -text "Question"    -variable DemoDlg::msg(icon) -value question
    BWidget::wrap radiobutton $subf.rad3 -text "Warning"     -variable DemoDlg::msg(icon) -value warning
    BWidget::wrap radiobutton $subf.rad4 -text "Error"       -variable DemoDlg::msg(icon) -value error
    pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 -anchor w -padx 5


    set sep    [Separator  $parent.sep -orient horizontal]
    set button [BWidget::wrap button $parent.but -text "Show" -command DemoDlg::_show_msgdlg]

    pack $button -side bottom
    pack $sep -side bottom -fill x -pady 10
    pack $labf1 $labf2 -side left -padx 4 -anchor n
}


proc DemoDlg::_stddlg { parent } {
  
  
  set frm [BWidget::wrap frame $parent.f0]
    pack $frm -side top -fill x
  
    set but0  [Button $frm.but0 \
                   -text "Select a color - popup" \
                   -command "DemoDlg::_show_color $parent popup"]

    set but1  [Button $frm.but1 \
                   -text "Select a color - Dialog" \
                   -command "DemoDlg::_show_color $parent dialog"]

    set but2  [Button $frm.but2 \
                   -text    "Font selector dialog" \
                   -command DemoDlg::_show_fontdlg]


    set but3  [Button $frm.but3 \
                   -text    "Progression dialog" \
                   -command DemoDlg::_show_progdlg]


    set but4  [Button $frm.but4 \
                   -text    "Password dialog" \
                   -command DemoDlg::_show_passdlg]

    pack $but0 $but1 $but2 $but3 $but4 -side left -padx 5 -anchor w -padx 5
}


proc DemoDlg::_show_color {w {mode "popup"}} {

    if { [BWidget::using ttk] } {
             set ccolor $::BWidget::colors(SystemButtonFace)
    } else { set ccolor [$w cget -background] }


    if { $mode == "popup" } {
        set color [SelectColor::menu $w.color \

	             [list below $w] -color $ccolor]
    } else {
        set color [SelectColor::dialog $w.color \
	             -parent [list below $w] -title "Select Color Dialog"]
    }

    if { [string length $color] > 0 } {

        if { [BWidget::using ttk] } {
	
	    ::ttk::style configure . -background $color

	} else {
            [winfo parent $w] configure -background $color
      }
    }
}

proc DemoDlg::_show_tmpldlg { } {
    variable tmpl

    set dlg [Dialog .tmpldlg -parent . -modal local \
................................................................................
        -type    $msg(type) \
        -icon    $msg(icon) \
        -buttons $msg(buttons)
}


proc DemoDlg::_show_fontdlg { } {
    # -initialcolor Black
    set font [SelectFont .fontdlg -parent . -font $Demo::font]

    if { $font != "" } {
        Demo::update_font $font
    }
}


proc DemoDlg::_show_progdlg { } {

Changes to demo/tree.tcl.







1
2
3
4
5
6
7






namespace eval DemoTree {
    variable count
    variable dblclick
}


>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
# ----------------------------------------------------------------------------
#  tree.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: tree.tcl,v 1.4 2009/09/08 21:21:20 oberdorfer Exp $
# ----------------------------------------------------------------------------
#

namespace eval DemoTree {
    variable count
    variable dblclick
}