Bwidget Source Code
Check-in [2303975b87]
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:theme related mod's done
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2303975b875f0d8c67db50f9058d68f11908b91a
User & Date: oberdorfer 2009-09-06 21:03:04
Context
2009-09-06
21:13
theme related mod's done check-in: 307eeef2b7 user: oberdorfer tags: trunk
21:03
theme related mod's done check-in: 2303975b87 user: oberdorfer tags: trunk
21:00
updated to 1.9.1, themeutils.tcl added, requ. initialization sequence check-in: 2917f5e0c1 user: oberdorfer tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to arrow.tcl.

1
2
3

4
5
6
7
8
9
10
..
16
17
18
19
20
21
22

23
24
25
26
27
28
29
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48


49
50
51
52
53
54
55
..
60
61
62
63
64
65
66
67
68




69
70
71
72
73
74
75
76
77
78
79
80
..
97
98
99
100
101
102
103



104
105
106
107
108
109
110
...
545
546
547
548
549
550
551

















# ------------------------------------------------------------------------------
#  arrow.tcl
#  This file is part of Unifix BWidget Toolkit

# ------------------------------------------------------------------------------
#  Index of commands:
#   Public commands
#     - ArrowButton::create
#     - ArrowButton::configure
#     - ArrowButton::cget
#     - ArrowButton::invoke
................................................................................
#   Private commands (event bindings)
#     - ArrowButton::_destroy
#     - ArrowButton::_enter
#     - ArrowButton::_leave
#     - ArrowButton::_press
#     - ArrowButton::_release
#     - ArrowButton::_repeat

# ------------------------------------------------------------------------------

namespace eval ArrowButton {
    Widget::define ArrowButton arrow DynamicHelp

    Widget::tkinclude ArrowButton button .c \
	    include [list \
................................................................................
	    [list -type		Enum button 0 [list arrow button]] \
	    [list -dir		Enum top    0 [list top bottom left right]] \
	    [list -width	Int	15	0	"%d >= 0"] \
	    [list -height	Int	15	0	"%d >= 0"] \
	    [list -ipadx	Int	0	0	"%d >= 0"] \
	    [list -ipady	Int	0	0	"%d >= 0"] \
	    [list -clean	Int	2	0	"%d >= 0 && %d <= 2"] \
	    [list -activeforeground	TkResource	""	0 button] \
	    [list -activebackground	TkResource	""	0 button] \
	    [list -disabledforeground 	TkResource	""	0 button] \
	    [list -foreground		TkResource	""	0 button] \
	    [list -background		TkResource	""	0 button] \
	    [list -state		TkResource	""	0 button] \
	    [list -troughcolor		TkResource	""	0 scrollbar] \


	    [list -arrowbd	Int	1	0	"%d >= 0 && %d <= 2"] \
	    [list -arrowrelief	Enum	raised	0	[list raised sunken]] \
	    [list -command		String	""	0] \
	    [list -armcommand		String	""	0] \
	    [list -disarmcommand	String	""	0] \
	    [list -repeatdelay		Int	0	0	"%d >= 0"] \
	    [list -repeatinterval	Int	0	0	"%d >= 0"] \
................................................................................

    bind BwArrowButtonC <Enter>           {ArrowButton::_enter %W}
    bind BwArrowButtonC <Leave>           {ArrowButton::_leave %W}
    bind BwArrowButtonC <ButtonPress-1>   {ArrowButton::_press %W}
    bind BwArrowButtonC <ButtonRelease-1> {ArrowButton::_release %W}
    bind BwArrowButtonC <Key-space>       {ArrowButton::invoke %W; break}
    bind BwArrowButtonC <Return>          {ArrowButton::invoke %W; break}
    bind BwArrowButton <Configure>       {ArrowButton::_redraw_whole %W %w %h}
    bind BwArrowButton <Destroy>         {ArrowButton::_destroy %W}





    variable _grab
    variable _moved

    array set _grab {current "" pressed "" oldstate "normal" oldrelief ""}
}


# -----------------------------------------------------------------------------
#  Command ArrowButton::create
# -----------------------------------------------------------------------------
proc ArrowButton::create { path args } {
................................................................................
    set ht  [Widget::cget $path -highlightthickness]
    set pad [expr {2*($bd+$ht)}]

    $path.c configure -width [expr {$w-$pad}] -height [expr {$h-$pad}]
    bindtags $path [list $path BwArrowButton [winfo toplevel $path] all]
    bindtags $path.c [list $path.c BwArrowButtonC [winfo toplevel $path.c] all]
    pack $path.c -expand yes -fill both




    DynamicHelp::sethelp $path $path.c 1

    set ::ArrowButton::_moved($path) 0

    return [Widget::create ArrowButton $path]
}
................................................................................
#  Command ArrowButton::_destroy
# ------------------------------------------------------------------------------
proc ArrowButton::_destroy { path } {
    variable _moved
    Widget::destroy $path
    unset _moved($path)
}



















>







 







>







 







|
|
|
|
|
|
|
>
>







 







|
|
>
>
>
>




|







 







>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
..
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
..
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
..
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
...
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
# ------------------------------------------------------------------------------
#  arrow.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: arrow.tcl,v 1.11 2009/09/06 21:03:04 oberdorfer Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#   Public commands
#     - ArrowButton::create
#     - ArrowButton::configure
#     - ArrowButton::cget
#     - ArrowButton::invoke
................................................................................
#   Private commands (event bindings)
#     - ArrowButton::_destroy
#     - ArrowButton::_enter
#     - ArrowButton::_leave
#     - ArrowButton::_press
#     - ArrowButton::_release
#     - ArrowButton::_repeat
#     - ArrowButton::_themechanged
# ------------------------------------------------------------------------------

namespace eval ArrowButton {
    Widget::define ArrowButton arrow DynamicHelp

    Widget::tkinclude ArrowButton button .c \
	    include [list \
................................................................................
	    [list -type		Enum button 0 [list arrow button]] \
	    [list -dir		Enum top    0 [list top bottom left right]] \
	    [list -width	Int	15	0	"%d >= 0"] \
	    [list -height	Int	15	0	"%d >= 0"] \
	    [list -ipadx	Int	0	0	"%d >= 0"] \
	    [list -ipady	Int	0	0	"%d >= 0"] \
	    [list -clean	Int	2	0	"%d >= 0 && %d <= 2"] \
            \
            [list -foreground         Color      "SystemWindowText"	0] \
            [list -background         Color      "SystemWindowFrame"	0] \
            [list -activeforeground   Color      "SystemButtonText"	0] \
            [list -activebackground   Color      "SystemButtonFace"	0] \
            [list -disabledforeground Color      "SystemDisabledText"	0] \
            [list -troughcolor        Color      "SystemScrollbar"	0] \
            \
	    [list -state		TkResource	""	0 button] \
	    [list -arrowbd	Int	1	0	"%d >= 0 && %d <= 2"] \
	    [list -arrowrelief	Enum	raised	0	[list raised sunken]] \
	    [list -command		String	""	0] \
	    [list -armcommand		String	""	0] \
	    [list -disarmcommand	String	""	0] \
	    [list -repeatdelay		Int	0	0	"%d >= 0"] \
	    [list -repeatinterval	Int	0	0	"%d >= 0"] \
................................................................................

    bind BwArrowButtonC <Enter>           {ArrowButton::_enter %W}
    bind BwArrowButtonC <Leave>           {ArrowButton::_leave %W}
    bind BwArrowButtonC <ButtonPress-1>   {ArrowButton::_press %W}
    bind BwArrowButtonC <ButtonRelease-1> {ArrowButton::_release %W}
    bind BwArrowButtonC <Key-space>       {ArrowButton::invoke %W; break}
    bind BwArrowButtonC <Return>          {ArrowButton::invoke %W; break}
    bind BwArrowButton <Configure>        {ArrowButton::_redraw_whole %W %w %h}
    bind BwArrowButton <Destroy>          {ArrowButton::_destroy %W}

    if {[lsearch [bindtags .] ArrowButtonThemeChanged] < 0} {
        bindtags . [linsert [bindtags .] 1 ArrowButtonThemeChanged]
    }

    variable _grab
    variable _moved

    array set _grab {current "" pressed "" oldstate "" oldrelief ""}
}


# -----------------------------------------------------------------------------
#  Command ArrowButton::create
# -----------------------------------------------------------------------------
proc ArrowButton::create { path args } {
................................................................................
    set ht  [Widget::cget $path -highlightthickness]
    set pad [expr {2*($bd+$ht)}]

    $path.c configure -width [expr {$w-$pad}] -height [expr {$h-$pad}]
    bindtags $path [list $path BwArrowButton [winfo toplevel $path] all]
    bindtags $path.c [list $path.c BwArrowButtonC [winfo toplevel $path.c] all]
    pack $path.c -expand yes -fill both

    bind ArrowButtonThemeChanged <<ThemeChanged>> \
	   "+ [namespace current]::_themechanged $path"

    DynamicHelp::sethelp $path $path.c 1

    set ::ArrowButton::_moved($path) 0

    return [Widget::create ArrowButton $path]
}
................................................................................
#  Command ArrowButton::_destroy
# ------------------------------------------------------------------------------
proc ArrowButton::_destroy { path } {
    variable _moved
    Widget::destroy $path
    unset _moved($path)
}

# ----------------------------------------------------------------------------
#  Command Tree::_themechanged
# ----------------------------------------------------------------------------
proc ArrowButton::_themechanged { path } {

    if { ![winfo exists $path] } { return }
    BWidget::set_themedefaults
    
    $path configure \
           -foreground         $BWidget::colors(SystemWindowText) \
           -background         $BWidget::colors(SystemWindowFrame) \
           -activeforeground   $BWidget::colors(SystemButtonText) \
           -activebackground   $BWidget::colors(SystemButtonFace) \
           -disabledforeground $BWidget::colors(SystemDisabledText) \
           -troughcolor        $BWidget::colors(SystemScrollbar) 
}

Changes to button.tcl.

1
2
3

4
5
6
7
8
9
10
..
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
..
86
87
88
89
90
91
92






93
94


95
96
97
98
99
100
101
...
115
116
117
118
119
120
121

122
123
124
125
126
127
128
...
130
131
132
133
134
135
136




137

138
139
140
141
142
143
144
...
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
...
216
217
218
219
220
221
222
223



224
225


226
227
228
229













230
231
232
233
234
235
236
...
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
...
285
286
287
288
289
290
291
292


293
294
295
296
297
298
299
# ----------------------------------------------------------------------------
#  button.tcl
#  This file is part of Unifix BWidget Toolkit

# ----------------------------------------------------------------------------
#  Index of commands:
#   Public commands
#     - Button::create
#     - Button::configure
#     - Button::cget
#     - Button::invoke
................................................................................
#     - Button::_leave
#     - Button::_press
#     - Button::_release
#     - Button::_repeat
# ----------------------------------------------------------------------------

namespace eval Button {

    Widget::define Button button DynamicHelp

    set remove [list -command -relief -text -textvariable -underline -state]
    if {[info tclversion] > 8.3} {
	lappend remove -repeatdelay -repeatinterval
    }





    Widget::tkinclude Button button :cmd remove $remove

    Widget::declare Button {
        {-name            String "" 0}
        {-text            String "" 0}
        {-textvariable    String "" 0}
        {-underline       Int    -1 0 "%d >= -1"}
................................................................................
        {-armcommand      String "" 0}
        {-disarmcommand   String "" 0}
        {-command         String "" 0}
        {-state           TkResource "" 0 button}
        {-repeatdelay     Int    0  0 "%d >= 0"}
        {-repeatinterval  Int    0  0 "%d >= 0"}
        {-relief          Enum   raised  0 {raised sunken flat ridge solid groove link}}

    }

    DynamicHelp::include Button balloon

    Widget::syncoptions Button "" :cmd {-text {} -underline {}}





    variable _current ""
    variable _pressed ""

    bind BwButton <Enter>           {Button::_enter %W}
    bind BwButton <Leave>           {Button::_leave %W}
    bind BwButton <ButtonPress-1>   {Button::_press %W}
    bind BwButton <ButtonRelease-1> {Button::_release %W}
    bind BwButton <Key-space>       {Button::invoke %W; break}
    bind BwButton <Return>          {Button::invoke %W; break}
    bind BwButton <Destroy>         {Widget::destroy %W}
}
























# ----------------------------------------------------------------------------
#  Command Button::create
# ----------------------------------------------------------------------------
proc Button::create { path args } {

















    array set maps [list Button {} :cmd {}]
    array set maps [Widget::parseArgs Button $args]




    eval [concat [list button $path] $maps(:cmd)]


    Widget::initFromODB Button $path $maps(Button)

    # Do some extra configuration on the button
    set relief [Widget::getMegawidgetOption $path -relief]

    if { [string equal $relief "link"] } {
        set relief "flat"
    }
    set var [Widget::getMegawidgetOption $path -textvariable]
    set st [Widget::getMegawidgetOption $path -state]
    if {  ![string length $var] } {
        set desc [BWidget::getname [Widget::getMegawidgetOption $path -name]]
................................................................................
        }
    } else {
        set under -1
        set text  ""
        Widget::configure $path [list -underline $under]
    }







    $path configure -relief $relief -text $text -underline $under \
	    -textvariable $var -state $st


    bindtags $path [list $path BwButton [winfo toplevel $path] all]

    set accel1 [string tolower [string index $text $under]]
    set accel2 [string toupper $accel1]
    if { $accel1 != "" } {
        bind [winfo toplevel $path] <Alt-$accel1> [list Button::invoke $path]
        bind [winfo toplevel $path] <Alt-$accel2> [list Button::invoke $path]
................................................................................
    if { $oldunder != -1 } {
        set oldaccel1 [string tolower [string index [$path:cmd cget -text] $oldunder]]
        set oldaccel2 [string toupper $oldaccel1]
    } else {
        set oldaccel1 ""
        set oldaccel2 ""
    }

    set res [Widget::configure $path $args]

    # Extract all the modified bits we're interested in
    foreach {cr cs cv cn ct cu} [Widget::hasChangedX $path \
	    -relief -state -textvariable -name -text -underline] break
    if { $cr || $cs } {
	set relief [Widget::cget $path -relief]
................................................................................
        if { [string equal $relief "link"] } {
            if { [string equal $state "active"] } {
                set relief "raised"
            } else {
                set relief "flat"
            }
        }




        $path:cmd configure -relief $relief -state $state

    }

    if { $cv || $cn || $ct || $cu } {
	set var		[Widget::cget $path -textvariable]
	set text	[Widget::cget $path -text]
	set under	[Widget::cget $path -underline]
        if {  ![string length $var] } {
................................................................................


# ----------------------------------------------------------------------------
#  Command Button::invoke
# ----------------------------------------------------------------------------
proc Button::invoke { path } {
    if { ![string equal [$path:cmd cget -state] "disabled"] } {
	$path:cmd configure -state active -relief sunken


	update idletasks
	set cmd [Widget::getMegawidgetOption $path -armcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
	after 100
        set relief [Widget::getMegawidgetOption $path -relief]
        if { [string equal $relief "link"] } {
            set relief flat
        }
	$path:cmd configure \
            -state  [Widget::getMegawidgetOption $path -state] \
            -relief $relief


	set cmd [Widget::getMegawidgetOption $path -disarmcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
	set cmd [Widget::getMegawidgetOption $path -command]
        if { $cmd != "" } {
            uplevel \#0 $cmd
................................................................................
    variable _current
    variable _pressed

    set _current $path
    if { ![string equal [$path:cmd cget -state] "disabled"] } {
        $path:cmd configure -state active
        if { $_pressed == $path } {
            $path:cmd configure -relief sunken



        } elseif { [string equal [Widget::cget $path -relief] "link"] } {
            $path:cmd configure -relief raised


        }
    }
}















# ----------------------------------------------------------------------------
#  Command Button::_leave
# ----------------------------------------------------------------------------
proc Button::_leave { path } {
    variable _current
    variable _pressed
................................................................................
    if { ![string equal [$path:cmd cget -state] "disabled"] } {
        $path:cmd configure -state [Widget::cget $path -state]
        set relief [Widget::cget $path -relief]
        if { $_pressed == $path } {
            if { [string equal $relief "link"] } {
                set relief raised
            }
            $path:cmd configure -relief $relief
        } elseif { [string equal $relief "link"] } {
            $path:cmd configure -relief flat
        }
    }
}


# ----------------------------------------------------------------------------
#  Command Button::_press
# ----------------------------------------------------------------------------
proc Button::_press { path } {
    variable _pressed

    if { ![string equal [$path:cmd cget -state] "disabled"] } {
        set _pressed $path
	$path:cmd configure -relief sunken


	set cmd [Widget::getMegawidgetOption $path -armcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
	    set repeatdelay [Widget::getMegawidgetOption $path -repeatdelay]
	    set repeatint [Widget::getMegawidgetOption $path -repeatinterval]
            if { $repeatdelay > 0 } {
                after $repeatdelay "Button::_repeat $path"
................................................................................
    if { $_pressed == $path } {
        set _pressed ""
        set relief [Widget::getMegawidgetOption $path -relief]
	after cancel "Button::_repeat $path"
        if { [string equal $relief "link"] } {
            set relief raised
        }
        $path:cmd configure -relief $relief


	set cmd [Widget::getMegawidgetOption $path -disarmcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
        if { $_current == $path &&
             ![string equal [$path:cmd cget -state] "disabled"] && \
	     [set cmd [Widget::getMegawidgetOption $path -command]] != "" } {


>







 







>






>
>
>
>
>







 







>





>
>
>
>













>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>
>
>
|
>
>




>







 







>
>
>
>
>
>
|
|
>
>







 







>







 







>
>
>
>
|
>







 







|
>
>










|
|
|
>
>







 







<
>
>
>

<
>
>




>
>
>
>
>
>
>
>
>
>
>
>
>







 







|

|













|
>
>







 







|
>
>







1
2
3
4
5
6
7
8
9
10
11
..
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
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
...
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
...
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
...
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
279
280
281
282
...
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
...
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
...
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
# ----------------------------------------------------------------------------
#  button.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: button.tcl,v 1.11 2009/09/06 21:03:27 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#   Public commands
#     - Button::create
#     - Button::configure
#     - Button::cget
#     - Button::invoke
................................................................................
#     - Button::_leave
#     - Button::_press
#     - Button::_release
#     - Button::_repeat
# ----------------------------------------------------------------------------

namespace eval Button {

    Widget::define Button button DynamicHelp

    set remove [list -command -relief -text -textvariable -underline -state]
    if {[info tclversion] > 8.3} {
	lappend remove -repeatdelay -repeatinterval
    }

    if { [BWidget::using ttk] } {
        lappend remove -anchor
    }

    Widget::tkinclude Button button :cmd remove $remove

    Widget::declare Button {
        {-name            String "" 0}
        {-text            String "" 0}
        {-textvariable    String "" 0}
        {-underline       Int    -1 0 "%d >= -1"}
................................................................................
        {-armcommand      String "" 0}
        {-disarmcommand   String "" 0}
        {-command         String "" 0}
        {-state           TkResource "" 0 button}
        {-repeatdelay     Int    0  0 "%d >= 0"}
        {-repeatinterval  Int    0  0 "%d >= 0"}
        {-relief          Enum   raised  0 {raised sunken flat ridge solid groove link}}
        {-style           String "" 0}
    }

    DynamicHelp::include Button balloon

    Widget::syncoptions Button "" :cmd {-text {} -underline {}}

    if { [BWidget::using ttk] } {
        Widget::addmap Button "" :cmd {-style {}}
    }

    variable _current ""
    variable _pressed ""

    bind BwButton <Enter>           {Button::_enter %W}
    bind BwButton <Leave>           {Button::_leave %W}
    bind BwButton <ButtonPress-1>   {Button::_press %W}
    bind BwButton <ButtonRelease-1> {Button::_release %W}
    bind BwButton <Key-space>       {Button::invoke %W; break}
    bind BwButton <Return>          {Button::invoke %W; break}
    bind BwButton <Destroy>         {Widget::destroy %W}
}


proc Button::createButtonStyles {} {
    variable _styles_created
 
    if { [info exists _styles_created] && $_styles_created != 0 } {
        return
    } 
    if { ![BWidget::using ttk] } { return }

    # emulate tk behavior, referenced later on such like:
    #    -style "${relief}BW.TButton"
    ::ttk::style configure raisedBW.TButton -relief raised
    ::ttk::style configure sunkenBW.TButton -relief sunken
    ::ttk::style configure flatBW.TButton   -relief flat
    ::ttk::style configure solidBW.TButton  -relief solid
    ::ttk::style configure grooveBW.TButton -relief groove
    ::ttk::style configure linkBW.TButton   -relief flat -bd 2

    set _styles_created 1
}



# ----------------------------------------------------------------------------
#  Command Button::create
# ----------------------------------------------------------------------------
proc Button::create { path args } {

    if { [BWidget::using ttk] } {
        createButtonStyles

        # remove unsupported tk options
	# (hope that's all we need to take care about)
	foreach opt {-font -fg -foreground -background
	             -highlightthickness -bd -borderwidth
		     -padx -pady -anchor} {
            set args [Widget::getArgument $args $opt tmp]
	}
        set args [Widget::getArgument $args "-relief" relief]

    } else {
        set args [Widget::getArgument $args "-style" tmp]
    }

    array set maps [list Button {} :cmd {}]
    array set maps [Widget::parseArgs Button $args]

    if {[BWidget::using ttk]} {
         eval [concat [list ttk::button $path] $maps(:cmd)]
    } else {
         eval [concat [list button $path] $maps(:cmd)]
    }  

    Widget::initFromODB Button $path $maps(Button)

    # Do some extra configuration on the button
    set relief [Widget::getMegawidgetOption $path -relief]

    if { [string equal $relief "link"] } {
        set relief "flat"
    }
    set var [Widget::getMegawidgetOption $path -textvariable]
    set st [Widget::getMegawidgetOption $path -state]
    if {  ![string length $var] } {
        set desc [BWidget::getname [Widget::getMegawidgetOption $path -name]]
................................................................................
        }
    } else {
        set under -1
        set text  ""
        Widget::configure $path [list -underline $under]
    }


    if { [BWidget::using ttk] } {
         $path configure -text $text -underline $under \
	       -textvariable $var -state $st \
	       -style "${relief}BW.TButton"
    } else {
         $path configure -relief $relief -text $text -underline $under \
	       -textvariable $var -state $st
    }

    bindtags $path [list $path BwButton [winfo toplevel $path] all]

    set accel1 [string tolower [string index $text $under]]
    set accel2 [string toupper $accel1]
    if { $accel1 != "" } {
        bind [winfo toplevel $path] <Alt-$accel1> [list Button::invoke $path]
        bind [winfo toplevel $path] <Alt-$accel2> [list Button::invoke $path]
................................................................................
    if { $oldunder != -1 } {
        set oldaccel1 [string tolower [string index [$path:cmd cget -text] $oldunder]]
        set oldaccel2 [string toupper $oldaccel1]
    } else {
        set oldaccel1 ""
        set oldaccel2 ""
    }
    
    set res [Widget::configure $path $args]

    # Extract all the modified bits we're interested in
    foreach {cr cs cv cn ct cu} [Widget::hasChangedX $path \
	    -relief -state -textvariable -name -text -underline] break
    if { $cr || $cs } {
	set relief [Widget::cget $path -relief]
................................................................................
        if { [string equal $relief "link"] } {
            if { [string equal $state "active"] } {
                set relief "raised"
            } else {
                set relief "flat"
            }
        }

        if { [BWidget::using ttk] } {
            $path:cmd configure -style "${relief}BW.TButton" -state $state
        } else {
            $path:cmd configure -relief $relief -state $state
        }
    }

    if { $cv || $cn || $ct || $cu } {
	set var		[Widget::cget $path -textvariable]
	set text	[Widget::cget $path -text]
	set under	[Widget::cget $path -underline]
        if {  ![string length $var] } {
................................................................................


# ----------------------------------------------------------------------------
#  Command Button::invoke
# ----------------------------------------------------------------------------
proc Button::invoke { path } {
    if { ![string equal [$path:cmd cget -state] "disabled"] } {

        _styleconfigure $path sunken

	update idletasks
	set cmd [Widget::getMegawidgetOption $path -armcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
	after 100
        set relief [Widget::getMegawidgetOption $path -relief]
        if { [string equal $relief "link"] } {
            set relief flat
        }

        set state [Widget::getMegawidgetOption $path -state]

        _styleconfigure $path $relief

	set cmd [Widget::getMegawidgetOption $path -disarmcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
	set cmd [Widget::getMegawidgetOption $path -command]
        if { $cmd != "" } {
            uplevel \#0 $cmd
................................................................................
    variable _current
    variable _pressed

    set _current $path
    if { ![string equal [$path:cmd cget -state] "disabled"] } {
        $path:cmd configure -state active
        if { $_pressed == $path } {


            _styleconfigure $path sunken

        } elseif { [string equal [Widget::cget $path -relief] "link"] } {


            _styleconfigure $path raised
        }
    }
}


proc Button::_styleconfigure { path relief_or_style } {

    if { [BWidget::using ttk] } {
        # do not override the toolbutton style:
        if { [$path:cmd cget -style] != "BWSlim.Toolbutton" } {
            $path:cmd configure -style "${relief_or_style}BW.TButton"
	}
    } else {
        $path:cmd configure -relief $relief_or_style
    }
}


# ----------------------------------------------------------------------------
#  Command Button::_leave
# ----------------------------------------------------------------------------
proc Button::_leave { path } {
    variable _current
    variable _pressed
................................................................................
    if { ![string equal [$path:cmd cget -state] "disabled"] } {
        $path:cmd configure -state [Widget::cget $path -state]
        set relief [Widget::cget $path -relief]
        if { $_pressed == $path } {
            if { [string equal $relief "link"] } {
                set relief raised
            }
            _styleconfigure $path $relief
        } elseif { [string equal $relief "link"] } {
            _styleconfigure $path flat
        }
    }
}


# ----------------------------------------------------------------------------
#  Command Button::_press
# ----------------------------------------------------------------------------
proc Button::_press { path } {
    variable _pressed

    if { ![string equal [$path:cmd cget -state] "disabled"] } {
        set _pressed $path

        _styleconfigure $path sunken
	
	set cmd [Widget::getMegawidgetOption $path -armcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
	    set repeatdelay [Widget::getMegawidgetOption $path -repeatdelay]
	    set repeatint [Widget::getMegawidgetOption $path -repeatinterval]
            if { $repeatdelay > 0 } {
                after $repeatdelay "Button::_repeat $path"
................................................................................
    if { $_pressed == $path } {
        set _pressed ""
        set relief [Widget::getMegawidgetOption $path -relief]
	after cancel "Button::_repeat $path"
        if { [string equal $relief "link"] } {
            set relief raised
        }

        _styleconfigure $path $relief

	set cmd [Widget::getMegawidgetOption $path -disarmcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
        if { $_current == $path &&
             ![string equal [$path:cmd cget -state] "disabled"] && \
	     [set cmd [Widget::getMegawidgetOption $path -command]] != "" } {

Changes to buttonbox.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
...
146
147
148
149
150
151
152





153
154
155
156
157
158
159
...
408
409
410
411
412
413
414











# ----------------------------------------------------------------------------
#  buttonbox.tcl
#  This file is part of Unifix BWidget Toolkit

# ----------------------------------------------------------------------------
#  Index of commands:
#     - ButtonBox::create
#     - ButtonBox::configure
#     - ButtonBox::cget
#     - ButtonBox::add
#     - ButtonBox::itemconfigure
#     - ButtonBox::itemcget
#     - ButtonBox::setfocus
#     - ButtonBox::invoke
#     - ButtonBox::index
#     - ButtonBox::_destroy

# ----------------------------------------------------------------------------

namespace eval ButtonBox {
    Widget::define ButtonBox buttonbox Button

    Widget::declare ButtonBox {
	{-background  TkResource ""	    0 frame}
	{-orient      Enum	 horizontal 1 {horizontal vertical}}
	{-state	      Enum	 "normal"   0 {normal disabled}}
	{-homogeneous Boolean	 1	    1}
	{-spacing     Int	 10	    0 "%d >= 0"}
	{-padx	      TkResource ""	    0 button}
	{-pady	      TkResource ""	    0 button}
	{-default     Int	 -1	    0 "%d >= -1"}
	{-bg	      Synonym	 -background}








    }

    Widget::addmap ButtonBox "" :cmd {-background {}}

    bind ButtonBox <Destroy> [list ButtonBox::_destroy %W]




}


# ----------------------------------------------------------------------------
#  Command ButtonBox::create
# ----------------------------------------------------------------------------
proc ButtonBox::create { path args } {
    Widget::init ButtonBox $path $args

    variable $path
    upvar 0  $path data

    eval [list frame $path] [Widget::subcget $path :cmd] \
	[list -class ButtonBox -takefocus 0 -highlightthickness 0]

    # For 8.4+ we don't want to inherit the padding
    catch {$path configure -padx 0 -pady 0}

    set data(max)      0
    set data(nbuttons) 0
    set data(buttons)  [list]
    set data(default)  [Widget::getoption $path -default]




    return [Widget::create ButtonBox $path]
}


# ----------------------------------------------------------------------------
#  Command ButtonBox::configure
................................................................................
    }

    eval [list Button::create $but \
	      -background [Widget::getoption $path -background]\
	      -padx       [Widget::getoption $path -padx] \
	      -pady       [Widget::getoption $path -pady]] \
        $args [list -default $style]






    # [email protected]:  set up tags, just like the menu items
    foreach tag $tags {
	lappend data(tags,$tag) $but
	if { ![info exists data(tagstate,$tag)] } {
	    set data(tagstate,$tag) 0
	}
................................................................................
# ----------------------------------------------------------------------------
proc ButtonBox::_destroy { path } {
    variable $path
    upvar 0  $path data
    Widget::destroy $path
    unset data
}













>












>






|








>
>
>
>
>
>
>
>





>
>
>
>













|
>







>
>
>







 







>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
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
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
...
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
# ----------------------------------------------------------------------------
#  buttonbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: buttonbox.tcl,v 1.14 2009/09/06 21:03:48 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ButtonBox::create
#     - ButtonBox::configure
#     - ButtonBox::cget
#     - ButtonBox::add
#     - ButtonBox::itemconfigure
#     - ButtonBox::itemcget
#     - ButtonBox::setfocus
#     - ButtonBox::invoke
#     - ButtonBox::index
#     - ButtonBox::_destroy
#     - ButtonBox::_themechanged
# ----------------------------------------------------------------------------

namespace eval ButtonBox {
    Widget::define ButtonBox buttonbox Button

    Widget::declare ButtonBox {
        {-background  Color     "SystemWindowFrame" 0}
	{-orient      Enum	 horizontal 1 {horizontal vertical}}
	{-state	      Enum	 "normal"   0 {normal disabled}}
	{-homogeneous Boolean	 1	    1}
	{-spacing     Int	 10	    0 "%d >= 0"}
	{-padx	      TkResource ""	    0 button}
	{-pady	      TkResource ""	    0 button}
	{-default     Int	 -1	    0 "%d >= -1"}
	{-bg	      Synonym	 -background}
        {-style       String "" 0}
    }

    if { ![BWidget::using ttk] } {
        Widget::addmap ButtonBox "" :cmd {-background {}}
    }
    if { [BWidget::using ttk] } {
        Widget::addmap Button "" :cmd {-style {}}
    }

    Widget::addmap ButtonBox "" :cmd {-background {}}

    bind ButtonBox <Destroy> [list ButtonBox::_destroy %W]

    if {[lsearch [bindtags .] ButtonBoxThemeChanged] < 0} {
        bindtags . [linsert [bindtags .] 1 ButtonBoxThemeChanged]
    }
}


# ----------------------------------------------------------------------------
#  Command ButtonBox::create
# ----------------------------------------------------------------------------
proc ButtonBox::create { path args } {
    Widget::init ButtonBox $path $args

    variable $path
    upvar 0  $path data

    eval [list frame $path] [Widget::subcget $path :cmd] \
	 [list -class ButtonBox -takefocus 0 -highlightthickness 0]

    # For 8.4+ we don't want to inherit the padding
    catch {$path configure -padx 0 -pady 0}

    set data(max)      0
    set data(nbuttons) 0
    set data(buttons)  [list]
    set data(default)  [Widget::getoption $path -default]

    bind ButtonBoxThemeChanged <<ThemeChanged>> \
	   "+ [namespace current]::_themechanged $path"

    return [Widget::create ButtonBox $path]
}


# ----------------------------------------------------------------------------
#  Command ButtonBox::configure
................................................................................
    }

    eval [list Button::create $but \
	      -background [Widget::getoption $path -background]\
	      -padx       [Widget::getoption $path -padx] \
	      -pady       [Widget::getoption $path -pady]] \
        $args [list -default $style]

    # a button box button - by default - is flat!
    if { [BWidget::using ttk] } {
       $but configure -style "BWSlim.Toolbutton"
    }

    # [email protected]:  set up tags, just like the menu items
    foreach tag $tags {
	lappend data(tags,$tag) $but
	if { ![info exists data(tagstate,$tag)] } {
	    set data(tagstate,$tag) 0
	}
................................................................................
# ----------------------------------------------------------------------------
proc ButtonBox::_destroy { path } {
    variable $path
    upvar 0  $path data
    Widget::destroy $path
    unset data
}

# ----------------------------------------------------------------------------
#  Command ButtonBox::_themechanged
# ----------------------------------------------------------------------------
proc ButtonBox::_themechanged { path } {

    if { ![winfo exists $path] } { return }
    BWidget::set_themedefaults
    
    $path configure -background $BWidget::colors(SystemWindowFrame)
}

Changes to color.tcl.








1
2
3
4
5
6
7
8
9


10
11
12
13
14
15
16
..
68
69
70
71
72
73
74

75
76
77
78
79
80
81
..
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
...
166
167
168
169
170
171
172



173

174
175
176
177
178
179
180
...
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






namespace eval SelectColor {
    Widget::define SelectColor color Dialog

    Widget::declare SelectColor {
        {-title     String     "Select a color" 0}
        {-parent    String     ""               0}
        {-color     TkResource ""               0 {label -background}}
	{-type      Enum       "dialog"         1 {dialog popup}}
	{-placement String     "center"         1}


    }

    variable _baseColors {
        \#0000ff \#00ff00 \#00ffff \#ff0000 \#ff00ff \#ffff00
        \#000099 \#009900 \#009999 \#990000 \#990099 \#999900
        \#000000 \#333333 \#666666 \#999999 \#cccccc \#ffffff
    }
................................................................................
    variable _baseColors
    variable _userColors
    variable _wcolor
    variable _selectype
    variable _selection

    Widget::init SelectColor $path $args

    set top [toplevel $path]
    set parent [winfo toplevel [winfo parent $top]]
    wm withdraw  $top
    wm transient $top $parent
    wm overrideredirect $top 1
    catch { wm attributes $top -topmost 1 }

................................................................................
    set col    0
    set row    0
    set count  0
    set colors [concat $_baseColors $_userColors]
    foreach color $colors {
        set f [frame $frame.c$count \
                   -highlightthickness 2 \
                   -highlightcolor white \
                   -relief solid -borderwidth 1 \
                   -width 16 -height 16 -background $color]
        bind $f <1>     "set SelectColor::_selection $count; break"
        bind $f <Enter> {focus %W}
        grid $f -column $col -row $row
        incr count
        if {[incr col] == 6 } {
            set  col 0
            incr row
        }
    }
    set f [label $frame.c$count \
               -highlightthickness 2 \
               -highlightcolor white \
               -relief flat -borderwidth 0 \
               -width 16 -height 16 -image [Bitmap::get palette]]
    grid $f -column $col -row $row
    bind $f <1>     "set SelectColor::_selection $count; break"
    bind $f <Enter> {focus %W}
    pack $frame

................................................................................
    Widget::init SelectColor $path:SelectColor $args
    set top   [Dialog::create $path \
                   -title  [Widget::cget $path:SelectColor -title]  \
                   -parent [Widget::cget $path:SelectColor -parent] \
                   -separator 1 -default 0 -cancel 1 -anchor e]
    wm resizable $top 0 0
    set dlgf  [$top getframe]



    set fg    [frame $dlgf.fg]

    set desc  [list \
                   base _baseColors "Base colors" \
                   user _userColors "User colors"]
    set count 0
    foreach {type varcol defTitle} $desc {
        set col   0
        set lin   0
................................................................................
            if {[incr col] == 6} {
                incr lin
                set  col 0
            }
        }
        pack $titf -anchor w -pady 2
    }

    set fround [frame $fg.round \
                    -highlightthickness 0 \
                    -relief sunken -borderwidth 2]
    set fcolor [frame $fg.color \
                    -width 50 \
                    -highlightthickness 0 \
                    -relief flat -borderwidth 0]

    pack $fcolor -in $fround -fill y -expand yes
    pack $fround -anchor e -pady 2 -fill y -expand yes






    set fd  [frame $dlgf.fd]
    set f1  [frame $fd.f1 -relief sunken -borderwidth 2]
    set f2  [frame $fd.f2 -relief sunken -borderwidth 2]

    set c1  [canvas $f1.c -width 200 -height 200 -bd 0 -highlightthickness 0]
    set c2  [canvas $f2.c -width 15  -height 200 -bd 0 -highlightthickness 0]

    for {set val 0} {$val < 40} {incr val} {
        $c2 create rectangle 0 [expr {5*$val}] 15 [expr {5*$val+5}] -tags val[expr {39-$val}]
    }
    $c2 create polygon 0 0 10 5 0 10 -fill black -outline white -tags target
>
>
>
>
>
>
>






|


>
>







 







>







 







|













|







 







>
>
>
|
>







 







>

|
|

|
|
|
>



>
>
>
>
>
|
|
|
>







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
..
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
..
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
...
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
...
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
# ---------------------------------------------------------------------------
#  color.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: color.tcl,v 1.14 2009/09/06 21:04:47 oberdorfer Exp $
# ---------------------------------------------------------------------------


namespace eval SelectColor {
    Widget::define SelectColor color Dialog

    Widget::declare SelectColor {
        {-title     String     "Select a color" 0}
        {-parent    String     ""               0}
        {-color     Color      "SystemWindowFrame"  0}
	{-type      Enum       "dialog"         1 {dialog popup}}
	{-placement String     "center"         1}
        {-background		Color      "SystemWindowFrame" 0}
        {-highlightcolor 	Color      "SystemHighlight"   0}
    }

    variable _baseColors {
        \#0000ff \#00ff00 \#00ffff \#ff0000 \#ff00ff \#ffff00
        \#000099 \#009900 \#009999 \#990000 \#990099 \#999900
        \#000000 \#333333 \#666666 \#999999 \#cccccc \#ffffff
    }
................................................................................
    variable _baseColors
    variable _userColors
    variable _wcolor
    variable _selectype
    variable _selection

    Widget::init SelectColor $path $args

    set top [toplevel $path]
    set parent [winfo toplevel [winfo parent $top]]
    wm withdraw  $top
    wm transient $top $parent
    wm overrideredirect $top 1
    catch { wm attributes $top -topmost 1 }

................................................................................
    set col    0
    set row    0
    set count  0
    set colors [concat $_baseColors $_userColors]
    foreach color $colors {
        set f [frame $frame.c$count \
                   -highlightthickness 2 \
                   -highlightcolor [Widget::getoption $path -highlightcolor] \
                   -relief solid -borderwidth 1 \
                   -width 16 -height 16 -background $color]
        bind $f <1>     "set SelectColor::_selection $count; break"
        bind $f <Enter> {focus %W}
        grid $f -column $col -row $row
        incr count
        if {[incr col] == 6 } {
            set  col 0
            incr row
        }
    }
    set f [label $frame.c$count \
               -highlightthickness 2 \
               -highlightcolor [Widget::getoption $path -highlightcolor] \
               -relief flat -borderwidth 0 \
               -width 16 -height 16 -image [Bitmap::get palette]]
    grid $f -column $col -row $row
    bind $f <1>     "set SelectColor::_selection $count; break"
    bind $f <Enter> {focus %W}
    pack $frame

................................................................................
    Widget::init SelectColor $path:SelectColor $args
    set top   [Dialog::create $path \
                   -title  [Widget::cget $path:SelectColor -title]  \
                   -parent [Widget::cget $path:SelectColor -parent] \
                   -separator 1 -default 0 -cancel 1 -anchor e]
    wm resizable $top 0 0
    set dlgf  [$top getframe]

    if { [BWidget::using ttk] } {
             set fg [ttk::frame $dlgf.fg]
    } else { set fg [frame $dlgf.fg] }

    set desc  [list \
                   base _baseColors "Base colors" \
                   user _userColors "User colors"]
    set count 0
    foreach {type varcol defTitle} $desc {
        set col   0
        set lin   0
................................................................................
            if {[incr col] == 6} {
                incr lin
                set  col 0
            }
        }
        pack $titf -anchor w -pady 2
    }

    set fround [frame $fg.round \
                      -highlightthickness 0 \
                      -relief sunken -borderwidth 2]
    set fcolor [frame $fg.color \
                      -width 50 \
                      -highlightthickness 0 \
                      -relief flat -borderwidth 0]

    pack $fcolor -in $fround -fill y -expand yes
    pack $fround -anchor e -pady 2 -fill y -expand yes

    if { [BWidget::using ttk] } {
        set fd  [ttk::frame $dlgf.fd]
        set f1  [ttk::frame $fd.f1 -relief sunken]
        set f2  [ttk::frame $fd.f2 -relief sunken]
    } else {
        set fd  [frame $dlgf.fd]
        set f1  [frame $fd.f1 -relief sunken -borderwidth 2]
        set f2  [frame $fd.f2 -relief sunken -borderwidth 2]
    }    
    set c1  [canvas $f1.c -width 200 -height 200 -bd 0 -highlightthickness 0]
    set c2  [canvas $f2.c -width 15  -height 200 -bd 0 -highlightthickness 0]

    for {set val 0} {$val < 40} {incr val} {
        $c2 create rectangle 0 [expr {5*$val}] 15 [expr {5*$val+5}] -tags val[expr {39-$val}]
    }
    $c2 create polygon 0 0 10 5 0 10 -fill black -outline white -tags target

Changes to dialog.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
25
26
27
28
29
30
31

32
33
34
35
36
37
38
..
40
41
42
43
44
45
46

47
48

49
50
51
52
53
54
55
..
73
74
75
76
77
78
79

80

81
82
83
84
85

86
87
88
89
90
91
92
..
99
100
101
102
103
104
105
106

107
108
109







110



111

112
113
114
115
116
117
118
...
172
173
174
175
176
177
178

179






180
181
182
183
184
185
186
# ----------------------------------------------------------------------------
#  dialog.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dialog.tcl,v 1.15 2004/09/24 23:56:59 hobbs Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Dialog::create
#     - Dialog::configure
#     - Dialog::cget
#     - Dialog::getframe
#     - Dialog::add
................................................................................
    Widget::define Dialog dialog ButtonBox

    Widget::bwinclude Dialog ButtonBox .bbox \
	remove	   {-orient} \
	initialize {-spacing 10 -padx 10}

    Widget::declare Dialog {

	{-title	      String	 ""	  0}
	{-geometry    String	 ""	  0}
	{-modal	      Enum	 local	  0 {none local global}}
	{-bitmap      TkResource ""	  1 label}
	{-image	      TkResource ""	  1 label}
	{-separator   Boolean	 0	  1}
	{-cancel      Int	 -1	  0 "%d >= -1"}
................................................................................
	{-side	      Enum	 bottom	  1 {bottom left top right}}
	{-anchor      Enum	 c	  1 {n e w s c}}
	{-class	      String	 Dialog	  1}
	{-transient   Boolean	 1	  1}
	{-place	      Enum	 center	  0 {none center left right above below}}
    }


    Widget::addmap Dialog "" :cmd   {-background {}}
    Widget::addmap Dialog "" .frame {-background {}}


    bind BwDialog <Destroy> [list Dialog::_destroy %W]

    variable _widget
}


................................................................................
    if { [string equal $tcl_platform(platform) "unix"] } {
	set re raised
	set bd 1
    } else {
	set re flat
	set bd 0
    }

    toplevel $path -relief $re -borderwidth $bd -class $dialogClass

    wm withdraw $path

    Widget::initFromODB Dialog $path $maps(Dialog)

    bindtags $path [list $path BwDialog all]

    wm overrideredirect $path 1
    wm title $path [Widget::cget $path -title]
    set parent [Widget::cget $path -parent]
    if { ![winfo exists $parent] } {
        set parent [winfo parent $path]
    }
    # JDC: made transient optional
................................................................................
        set orient vertical
    } else {
        set orient horizontal
    }

    set bbox  [eval [list ButtonBox::create $path.bbox] $maps(.bbox) \
		   -orient $orient]
    set frame [frame $path.frame -relief flat -borderwidth 0]

    set bg [Widget::cget $path -background]
    $path configure -background $bg
    $frame configure -background $bg







    if { [set bitmap [Widget::getoption $path -image]] != "" } {



        set label [label $path.label -image $bitmap -background $bg]

    } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } {
        set label [label $path.label -bitmap $bitmap -background $bg]
    }
    if { [Widget::getoption $path -separator] } {
	Separator::create $path.sep -orient $orient -background $bg
    }
    set _widget($path,realized) 0
................................................................................
	&& $::tk_version >= 8.4} {
	set width -11
    } else {
	set width 8
    }
    set cmd [list ButtonBox::add $path.bbox -width $width \
		 -command [list Dialog::enddialog $path $_widget($path,nbut)]]

    set res [eval $cmd $args]






    incr _widget($path,nbut)
    return $res
}


# ----------------------------------------------------------------------------
#  Command Dialog::itemconfigure


|







 







>







 







>
|
|
>







 







>
|
>





>







 







<
>


<
>
>
>
>
>
>
>

>
>
>
|
>







 







>

>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
..
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
..
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
..
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
...
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
...
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
# ----------------------------------------------------------------------------
#  dialog.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dialog.tcl,v 1.16 2009/09/06 21:09:39 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Dialog::create
#     - Dialog::configure
#     - Dialog::cget
#     - Dialog::getframe
#     - Dialog::add
................................................................................
    Widget::define Dialog dialog ButtonBox

    Widget::bwinclude Dialog ButtonBox .bbox \
	remove	   {-orient} \
	initialize {-spacing 10 -padx 10}

    Widget::declare Dialog {
        {-background  Color     "SystemWindowFrame" 0}
	{-title	      String	 ""	  0}
	{-geometry    String	 ""	  0}
	{-modal	      Enum	 local	  0 {none local global}}
	{-bitmap      TkResource ""	  1 label}
	{-image	      TkResource ""	  1 label}
	{-separator   Boolean	 0	  1}
	{-cancel      Int	 -1	  0 "%d >= -1"}
................................................................................
	{-side	      Enum	 bottom	  1 {bottom left top right}}
	{-anchor      Enum	 c	  1 {n e w s c}}
	{-class	      String	 Dialog	  1}
	{-transient   Boolean	 1	  1}
	{-place	      Enum	 center	  0 {none center left right above below}}
    }

    if { ![BWidget::using ttk] } {
       Widget::addmap Dialog "" :cmd   {-background {}}
       Widget::addmap Dialog "" .frame {-background {}}
    }

    bind BwDialog <Destroy> [list Dialog::_destroy %W]

    variable _widget
}


................................................................................
    if { [string equal $tcl_platform(platform) "unix"] } {
	set re raised
	set bd 1
    } else {
	set re flat
	set bd 0
    }
    toplevel $path \
      -relief $re -borderwidth $bd -class $dialogClass \
      -background $::BWidget::colors(SystemWindowFrame)
    wm withdraw $path

    Widget::initFromODB Dialog $path $maps(Dialog)

    bindtags $path [list $path BwDialog all]
 
    wm overrideredirect $path 1
    wm title $path [Widget::cget $path -title]
    set parent [Widget::cget $path -parent]
    if { ![winfo exists $parent] } {
        set parent [winfo parent $path]
    }
    # JDC: made transient optional
................................................................................
        set orient vertical
    } else {
        set orient horizontal
    }

    set bbox  [eval [list ButtonBox::create $path.bbox] $maps(.bbox) \
		   -orient $orient]


    set bg [Widget::cget $path -background]
    $path configure -background $bg


    if { [BWidget::using ttk] } {
         set frame [ttk::frame $path.frame -relief flat]
    } else {
         set frame [frame $path.frame -relief flat -borderwidth 0 -background $bg]
    }

    if { [set bitmap [Widget::getoption $path -image]] != "" } {
        if { [BWidget::using ttk] } {
            set label [ttk::label $path.label -image $bitmap]
        } else {
            set label [label $path.label -image $bitmap -background $bg]
        }
    } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } {
        set label [label $path.label -bitmap $bitmap -background $bg]
    }
    if { [Widget::getoption $path -separator] } {
	Separator::create $path.sep -orient $orient -background $bg
    }
    set _widget($path,realized) 0
................................................................................
	&& $::tk_version >= 8.4} {
	set width -11
    } else {
	set width 8
    }
    set cmd [list ButtonBox::add $path.bbox -width $width \
		 -command [list Dialog::enddialog $path $_widget($path,nbut)]]

    set res [eval $cmd $args]

    # a button box button - by default - is flat!
    if { [BWidget::using ttk] } {
        $res configure -style "TButton"
    }

    incr _widget($path,nbut)
    return $res
}


# ----------------------------------------------------------------------------
#  Command Dialog::itemconfigure