Bwidget Source Code
Check-in [10d9b3e6db]
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:*** important: programming interface changed:

# BWidget::use # Argument usage: # -package ttk # | # specify a package name to be initialized, currently # support for the following packages is implemented: # ttk ... try to use tile'd widget set (if available) # # -style default / native / myFavoriteStyleName # | | | # | | specify a valid style name, # | | use "BWidget::_get_colordcls" which gives # | | you a list of what's avaliable for tk # | | # | if specified, BW tries to emulate OS color scheme, # | a specific color schema associated to each individual # | operationg system is going to be used # | # same behaviour as before, stay compatible # with previous releases # # -setoptdb [no=default|0|yes|1] # | # maintain the option database # if you need a dynamic behavior when changing # the underlying style, activate this option! # # -themedirs {} = default / a list of valid directory names, # to specifing additional ttk theme packages

Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 10d9b3e6db2bc7480a36b316a300819458f0ded8
User & Date: oberdorfer 2009-10-25 20:57:26
Context
2009-10-27
22:14
* continuous developement, minor changes check-in: afb47531db user: oberdorfer tags: trunk
2009-10-25
20:57
*** important: programming interface changed:

# BWidget::use # Argument usage: # -package ttk # | # specify a package name to be initialized, currently # support for the following packages is implemented: # ttk ... try to use tile'd widget set (if available) # # -style default / native / myFavoriteStyleName # | | | # | | specify a valid style name, # | | use "BWidget::_get_colordcls" which gives # | | you a list of what's avaliable for tk # | | # | if specified, BW tries to emulate OS color scheme, # | a specific color schema associated to each individual # | operationg system is going to be used # | # same behaviour as before, stay compatible # with previous releases # # -setoptdb [no=default|0|yes|1] # | # maintain the option database # if you need a dynamic behavior when changing # the underlying style, activate this option! # # -themedirs {} = default / a list of valid directory names, # to specifing additional ttk theme packages check-in: 10d9b3e6db user: oberdorfer tags: trunk

20:54
*** continous developement, some small improvements check-in: 9c53cf5397 user: oberdorfer tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to themeutils.tcl.


1
2

3



4
5
6
7
8
9
10
11
12
13
14





15
16
17
18
19
20
21
..
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
...
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
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
322
...
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
346
347
348
349
350
351
352















































353
354
355
356
357
358
359
...
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
...
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
...
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
...
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
...
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
# ----------------------------------------------------------------------------
#  themeutils.tcl

#  This file is part of Unifix BWidget Toolkit



#  $Id: themeutils.tcl,v 1.1 2009/09/09 19:35:04 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - BWidget::usepackage
#     - BWidget::using
#     - BWidget::wrap
#     - BWidget::getcurrent_theme
#     - BWidget::read_ttkstylecolors
#     - BWidget::set_themedefaults
#     - BWidget::default_Color
#     - BWidget::[themename]_Color





#     - BWidget::_themechanged
# ----------------------------------------------------------------------------
# color mapping:
#     SystemWindow        -background
#     SystemWindowFrame   -background
#     SystemWindowText    -foreground
#     SystemButtonText    -activeforeground
................................................................................
# Notes:
#
#   - Themed color declarations and names do not follow a strict rule,
#     so -most likely- there might be differences from theme to theme.
#     As a consequece of this fact, we have to support a minimum set
#     of color declarations which needs to be declared for most common
#     themes. Unsupported themes 'll fall back to the "default" color scheme.





































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

namespace eval BWidget {
    variable colors


    # theme related bindings:
    if {[lsearch [bindtags .] BWThemeChanged] < 0} {
        bindtags . [linsert [bindtags .] 1 BWThemeChanged]

    }







    bind BWThemeChanged <<ThemeChanged>> \
            "+ [namespace current]::_themechanged"
}


proc BWidget::usepackage { package } {






























    variable _includes





    if { ![info exists _includes($package)] } { 










        # each package supported to enhance BWidgets is setup here.
        switch -- $package {
            "ttk" {


	        if { [catch {package present tile 0.8}] != 0 } {
                    return -code error "Tile 0.8 is not available!"

		}
		# check, if the theme name currently set has a
		# color array declaration, represented by a defined
		# procedure such as "BWidget::[themename]_Color




		set ctheme [getcurrent_theme]
		if { [lsearch [get_colordcls] $ctheme] == -1 } {
		    return -code error \
                        "color declarations for $ctheme missing!"
		}
                set_themedefaults

                # create a new element for each available theme...
                foreach themeName [ttk::style theme names] {
                    # temporarily sets the current theme to themeName,
                    # evaluate script, then restore the previous theme.
                    ttk::style theme settings $themeName {
                        ttk::style configure BWSlimCB.Toolbutton -relief flat -bd 2
                        ttk::style map BWSlimCB.Toolbutton \
	                               -relief [list {selected !disabled} sunken]
		    }
		}
  		Widget::theme 1


            }
	    default {
	        return -code error \
		  "[namespace curren] - invalid argument specified!"
	    }
        }
    }

    set _includes($package) 1
    return 1
}











































proc BWidget::using { package } {


    if {[info exists ::BWidget::_includes($package)]} {
        return $::BWidget::_includes($package)

    }
    return 0
}


# a simple wrapper to distinguish between tk and ttk
proc BWidget::wrap {wtype wpath args} {

    if { [using ttk] } {
        # filter out (ttk-)unsupported (tk-)options:
	foreach opt {-background -bd -borderwith -highlightthickness} {
            set args [Widget::getArgument $args $opt tmp]
	}

................................................................................
        return [eval ttk::${wtype} $wpath $args]
    } else {
        return [eval $wtype $wpath $args]
    }
}


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


































# returns the current (tile) theme name
#------------------------------------------------------------------------------




























proc BWidget::getcurrent_theme {} {
    variable colors

    if { [using ttk] } {
         # future version: "return [ttk::style theme use]"
         return $ttk::currentTheme
    } else {

















         if { [info exists colors(style)] } {


























             return $colors(style)
	 }
    }
    return -code error "cannot read style name - declaration is missing!"
}





# this function is a replacement for [ttk::style configure .]
# and takes as well the style decl's from the "default" style into account

proc BWidget::read_ttkstylecolors {} {

    # default style comes 1st:
    # temporarily sets the current theme to themeName,
    # evaluate script, then restore the previous theme.

    ttk::style theme settings "default" {
        set cargs [ttk::style configure .]
................................................................................
      }
    }

    return $cargs
}


#------------------------------------------------------------------------------
# make sure, to keep the commonly used "BWidget::colors" array up to date
#------------------------------------------------------------------------------









proc BWidget::set_themedefaults { {initialize ""} } {
    variable colors

    variable _prevtheme

    if { [string length $initialize] != 0 } {
        default_Color









        return
    }


    set currtheme [getcurrent_theme]





    if { [info exists _prevtheme] &&
         [string equal $_prevtheme $currtheme] } { return }
    set _prevtheme $currtheme

    # evaluate procedure where the naming matches the currently active theme:
    if { [catch { "${currtheme}_Color" }] != 0 } {
        default_Color
    }

    if { ![using ttk] } { return }














    # superseed color options from the ones provided by ttk theme (if available),
    # to fit as close as possible with the curent style, if one of the refered
    # option is not provided (which is most likely the case), we take the ones
    # which are declared by our own!

    # "-selectbackground" { set colors(SystemHighlight)     $val }
    # "-selectforeground" { set colors(SystemHighlightText) $val }

    foreach {opt val} [BWidget::read_ttkstylecolors] {
      switch -- $opt {
          "-foreground"  { set colors(SystemWindowText)  $val }
          "-background"  { set colors(SystemWindowFrame) $val }
          "-troughcolor" { set colors(SystemScrollbar)   $val }
      }
    }
}


proc BWidget::_themechanged {} {


    set_themedefaults







    # -- propagate new color settings:
    # note:
    #   modifying the option database doesn't affect existing widgets,
    #   only new widgets 'll be taken into account
    #
    #     Priorities:
................................................................................
            foreach optitem [$child configure] {
                if { [lsearch $optitem $copt] != -1 } {
	            catch { $child configure $copt $cval }
                }
            }
	}
    }

}


#------------------------------------------------------------------------------
# get color declarations
#------------------------------------------------------------------------------

proc BWidget::get_colordcls { } {
    set stylelist {}
    set keyword "_Color"
    foreach name [info proc] {
         if { [regexp -all -- $keyword $name] } {
	     set nlen [string length $name]
	     set klen [string length $keyword]
	     set stylename [string range $name 0 [expr {$nlen - $klen - 1}]]
................................................................................
             lappend stylelist $stylename
	 }
    }
    return [lsort -dictionary $stylelist]
}


proc BWidget::default_Color { } {
    variable colors
    set colors(style) "default"

    # !!! doesn't work on winxp64
    #     + starpacked executable from equi4
    # if {[string equal $::tcl_platform(platform) "---windows---"]} {
    #    array set colors {
................................................................................
    #      SystemHighlightText SystemHighlightText
    #      SystemMenu          SystemMenu
    #      SystemMenuText      SystemMenuText
    #      SystemScrollbar     SystemScrollbar
    #    }
    # }
















































    array set colors {
            SystemWindow        "White"
            SystemWindowFrame   "#d9d9d9"
            SystemWindowText    "Black"
            SystemButtonFace    "#d9d9d9"
            SystemButtonText    "Black"
            SystemDisabledText  "#a3a3a3"
................................................................................
            SystemMenu          "#d9d9d9"
            SystemMenuText      "Black"
            SystemScrollbar     "#d9d9d9"
   }
}


proc BWidget::winxpblue_Color { } {
    variable colors
    set colors(style) "winxpblue"

    array set colors {
      Style               "winxpblue"
      SystemWindow        "White"
      SystemWindowFrame   "#ece9d8"
................................................................................
      SystemHighlightText "Black"
      SystemMenu          "LightGrey"
      SystemMenuText      "Black"
      SystemScrollbar     "#d9d9d9"
    }
}

proc BWidget::plastik_Color { } {
    variable colors
    set colors(style) "plastik"

    array set colors {
      SystemWindow        "LightGrey"
      SystemWindowFrame   "#efefef"
      SystemWindowText    "Black"
................................................................................
      SystemHighlightText "Black"
      SystemMenu          "LightGrey"
      SystemMenuText      "Black"
      SystemScrollbar     "#efefef"
    }
}

proc BWidget::keramik_Color { } {
    variable colors
    set colors(style) "keramik"

    array set colors {
      SystemWindow        "#ffffff"
      SystemWindowFrame   "#dddddd"
      SystemWindowText    "Black"
................................................................................
      SystemHighlightText "Black"
      SystemMenu          "LightGrey"
      SystemMenuText      "Black"
      SystemScrollbar     "#efefef"
    }
}

proc BWidget::keramik_alt_Color { } {
    keramik_Color
    set colors(style) "keramik_alt"

}

proc BWidget::black_Color { } {
    variable colors
    set colors(style) "black"

    array set colors {
      SystemWindow        "#424242"
      SystemWindowFrame   "#424242"
      SystemWindowText    "Black"
................................................................................
      SystemMenu          "#222222"
      SystemMenuText      "#ffffff"
      SystemScrollbar     "#626262"
    }
}


proc BWidget::aquativo_Color { } {
    variable colors
    set colors(style) "aquativo"

    array set colors {
      SystemWindow        "#EDF3FE"
      SystemWindowFrame   "White"
      SystemWindowText    "Black"
>

<
>
|
>
>
>
|


|


|
<
|


>
>
>
>
>







 







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



|

>

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



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

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



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

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

|
|
<
>
>



|




|
|
|
>

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






|







 







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

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

<
|
|
>
|
>
>



|







 







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

>
|

<
<
>
>
>
>
>
>
>
>
>


>

<
>
>
>
>
|
<
<
<


|



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









|









|
>


>
>
>
>
>
>







 







<




|

>
|







 







|







 







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







 







|







 







|







 







|







 







|





|







 







|







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
..
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
279
280
281
282
283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319

320
321
322
323

324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370

371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
...
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422


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

436
437
438
439
440



441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
...
573
574
575
576
577
578
579

580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
...
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
...
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
...
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
...
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
...
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
...
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
...
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
# themeutils.tcl ---
# ----------------------------------------------------------------------------

# Purpose:
#      This file is a contribution to the Unifix BWidget Toolkit.
#      An approach to re-vitalize the package and to take advantage of tile!
#      Author: Johann dot Oberdorfer at Googlemail dot com
#
#  $Id: themeutils.tcl,v 1.2 2009/10/25 20:57:26 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - BWidget::use
#     - BWidget::using
#     - BWidget::wrap
#     - BWidget::set_themedefaults

#     - BWidget::getAvailableThemes
#     - BWidget::default_Color
#     - BWidget::[themename]_Color
#     - BWidget::_get_colordcls
#     - BWidget::_getSystemDefaultStyle
#     - BWidget::_read_ttk_current_theme
#     - BWidget::_getDefaultClassOpt
#     - BWidget::_read_ttkstylecolors
#     - BWidget::_themechanged
# ----------------------------------------------------------------------------
# color mapping:
#     SystemWindow        -background
#     SystemWindowFrame   -background
#     SystemWindowText    -foreground
#     SystemButtonText    -activeforeground
................................................................................
# Notes:
#
#   - Themed color declarations and names do not follow a strict rule,
#     so -most likely- there might be differences from theme to theme.
#     As a consequece of this fact, we have to support a minimum set
#     of color declarations which needs to be declared for most common
#     themes. Unsupported themes 'll fall back to the "default" color scheme.
#
# Further explanations:
#   - In respect of color settings, BW basically runs in 2 different modes:
#
#       - without tile:
#            the standard initialization sequence (as usual) is:
#               "package require BWidget"
#            in this case, color codes are set according to the OS
#            currently running on and acc. to a predefined color scheme,
#            which is a "best guess" of what might look good for most of the
#            users ...
#            
#       - With tile - "themed":
#           See notes above.
#           In addition to the standard initialization sequence,
#           the following line must be present in order to activate theming:
#              "BWidget::usepackage ttk"
#           and within the code:
#              "BWidget::using ttk"
#           might be used to distinguish between the 2 different modes.
#
#       - As themes are not support within the BW distribution (except some
#         themes found in the demo), a programmer needs to support prefered
#         theme packages separately.
#         A typical initialization code block might look like:
#              ...
#              lappend auto_path [where to find specific theme package]
#              set ctheme winxpblue
#              package require ttk::theme::${ctheme}
#              ttk::setTheme $ctheme
#              ...
#         
#       - In addition, a separate procedure must be provided, to manage
#         and control standard tk "widgets", which needs to be re-colorized
#         as well, when a <<ThemeChanged>> virtual event arises.
#         See code below, how a "BWidget::<mythemeName>_Color" procedure
#         looks like!
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------

namespace eval ::BWidget:: {
    variable colors
    variable _properties




    set colors(style) default

    array set _properties \
      [list \
          package   "" \
          style     "default" \
          setoptdb  "no" \
          themedirs {} \
      ]


}


# BWidget::use
#   Argument usage:
#      -package ttk
#               |
#               specify a package name to be initialized, currently
#		support for the following packages is implemented:
#		   ttk ... try to use tile'd widget set (if available)
#		
#      -style default / native / myFavoriteStyleName
#             |         |        |
#	      |		|	 specify a valid style name,
#	      |		|	 use "BWidget::_get_colordcls" which gives
#	      | 	|	 you a list of what's avaliable for tk
#	      |		|
#	      |		if specified, BW tries to emulate OS color scheme,
#             |         a specific color schema associated to each individual
#             |         operationg system is going to be used
#	      |
#             same behaviour as before, stay compatible
#             with previous releases
#	 
#      -setoptdb [no=default|0|yes|1]
#                              |
#                              maintain the option database
#                              if you need a dynamic behavior when changing
#                              the underlying style, activate this option!
#
#      -themedirs {} = default / a list of valid directory names,
#                                to specifing additional ttk theme packages

proc ::BWidget::use { args } {
    variable _properties

    # argument processing:
    array set p { -package "" -style "" -setoptdb 0 -themedirs "" }

    foreach {key value} $args {
      if { ![info exists p($key)] } {
          return -code error "[namespace current] - bad option: '$key'"
      }
      set p($key) $value
    }

    # -- package:
    set package $p(-package)
    if { [string length $package] > 0 &&
         ![info exists _properties($package)] } { 

        # each package supported to enhance BWidgets is setup here.
        switch -- $package {
            "ttk" {
	    
	        # attempt to load tile package (with the required version)
	        #   if { [catch {package present tile 0.8}] != 0 } {
                #       return -code error "Tile 0.8 is not available!"
		#   }




                if { [catch {uplevel "#0" package require tile 0.8}] != 0 } {
                    set _properties($package) 0
		} else {








                    # create a new element for each available theme...
                    foreach themeName [ttk::style theme names] {
                        # temporarily sets the current theme to themeName,
                        # evaluate script, then restore the previous theme.
                        ttk::style theme settings $themeName {
                            ttk::style configure BWSlimCB.Toolbutton -relief flat -bd 2
                            ttk::style map BWSlimCB.Toolbutton \
	                               -relief [list {selected !disabled} sunken]
		        }
		    }

                    set _properties($package) 1
		}
            }
	    default {
	        return -code error \
		  "[namespace current] bad option: '$package'"
	    }
        }
    }

    # -- style:
    if { [string length $p(-style)] > 0 } {

        set _properties(style) $p(-style)

        if { [string compare $p(-style) "native"] == 0 } {
             set _properties(style) [_getSystemDefaultStyle]
        }
    }

    # -- setoptdb:
    if { [string length $p(-setoptdb)] > 0 } {
	set _properties(setoptdb) \
	      [regexp -nocase {^(1|yes|true|on)$} $p(-setoptdb)]
    }

    # -- themedirs:
    if { [llength $p(-themedirs)] > 0 } {
        foreach themedir $p(-themedirs) {
            if { [file isdirectory $themedir] &&
	         [lsearch $_properties(themedirs) $themedir] == -1 } {
                
		# maintain auto_path for further usage of theme'd packages
		if { [lsearch -exact ::auto_path $themedir] == -1 } {
                    lappend ::auto_path $themedir
                }

		lappend _properties(themedirs) $themedir
            }
	}
    }

    # perform required initializations
    set_themedefaults $_properties(style)

    # theme related bindings:    
    if { $_properties(setoptdb) != 0 } {
        if {[lsearch [bindtags .] BWThemeChanged] < 0} {
            bindtags . [linsert [bindtags .] 1 BWThemeChanged]
	    bind BWThemeChanged <<ThemeChanged>> \
                    "+ [namespace current]::_themechanged"
        }
    }
}


proc ::BWidget::using { optName } {
    variable _properties

    if {[info exists _properties($optName)]} {

        return $_properties($optName)
    }
    return 0
}


# a simple wrapper to distinguish between tk and ttk
proc ::BWidget::wrap {wtype wpath args} {

    if { [using ttk] } {
        # filter out (ttk-)unsupported (tk-)options:
	foreach opt {-background -bd -borderwith -highlightthickness} {
            set args [Widget::getArgument $args $opt tmp]
	}

................................................................................
        return [eval ttk::${wtype} $wpath $args]
    } else {
        return [eval $wtype $wpath $args]
    }
}


# returns a list of themes, which are are declared as well for both: tk and ttk,
# all other ttk themes, that might be available down below the given theme dir's
# are skipped!

proc ::BWidget::getAvailableThemes {} {
  variable _properties

  set themes [list default]
  set tk_colordcls [_get_colordcls]

  if { [BWidget::using ttk] } {
  
      foreach themedir $_properties(themedirs) {
          if { [file isdirectory $themedir] } {
              foreach dir [glob -nocomplain [file join $themedir "*"]] {
	        set themeName [file tail $dir]
	        # check, if there is a corresponding color declaration available
                if { [file isdirectory $dir] &&
		     [lsearch $tk_colordcls $themeName] != -1 } {
                   lappend themes $themeName
              }}
          }
      }

  } else {
      foreach dcls $tk_colordcls {
          if { [lsearch $themes $dcls] == -1 } {
              lappend themes $dcls
      }}
  }

  return $themes
}


# returns the system default theme


proc ::BWidget::_getSystemDefaultStyle {} {

    if {$::tcl_version >= 8.4} {
        set plat [tk windowingsystem]
	if { $plat == "x11" } {
	    switch -- $::tcl_platform(os) {
		"AIX"    { set plat "AIX" }
	        "Darwin" { set plat "Darwin" }
	    }
	}   
    } else {
        set plat $::tcl_platform(platform)
    }

    switch -glob -- $plat {
	"classic" - "aqua" - "Darwin" \
	          { set style "aquativo" }
	"win*"    { set style "winxpblue" }
	"AIX"     { set style "grey" }
	"x11" -
	default   { set style "default" }
    }

    return $style
}


proc ::BWidget::_read_ttk_current_theme {} {

 
    if { [using ttk] } {
        # future version: "return [ttk::style theme use]"
        return $ttk::currentTheme

    } 
    return ""
}


# arguments:
#   cname = a valid class name
#           e.g.: "foreground", "background", "font"...
#   return value: the desired option or an empty string
# example call:
#   set fg [_getDefaultClassOpt "foreground" "nocache"]

proc ::BWidget::_getDefaultClassOpt {cname {mode ""}} {
  variable _class_options

  # should we use the cached list?
  if { $mode != "" ||
       ![info exists _class_options] ||
        [llength $_class_options] == 0 } {

     # retrieve options from the listbox

     set tmpWidget ".__tmp__"
     set count 0
     while {[winfo exists $tmpWidget] == 1} {
       set tmpWidget ".__tmp__$count"
       incr count
     }
  
     label $tmpWidget 
     set _class_options [$tmpWidget configure]
     destroy $tmpWidget
  }
  
  # and now, we retrieve the option ...
  # foreach c [lsort -dictionary $_class_options] { puts $c }

  foreach opt $_class_options {

    if {[llength $opt] == 5} {
      set option [lindex $opt 1]
      set value  [lindex $opt 4]

      if {$cname == $option} {
        return $value
      }
    }

  }
  
  return ""
}


# this function is a replacement for [ttk::style configure .]
# and takes as well the style decl's from the "default" style into account

proc ::BWidget::_read_ttkstylecolors {} {

    # default style comes 1st:
    # temporarily sets the current theme to themeName,
    # evaluate script, then restore the previous theme.

    ttk::style theme settings "default" {
        set cargs [ttk::style configure .]
................................................................................
      }
    }

    return $cargs
}


# Purpose:
#   Sets the current style + default ttk (tyled) theme,
#   ensure, color related array: "BWidget::colors" is updated as well
#
#   This procedure is called under the following conditions:
#      - When initializing the package, to make sure, that the default
#        style is set (which basically establishes a color array with
#        predefined colors).
#      - In any case a style has changed, if a ttk theme driven style is
#        changed, the virtual event <<ThemeChanged>> is fired, which in turn
#        causes this function to be called.

proc ::BWidget::set_themedefaults { {styleName ""} } {
    variable colors
    variable _properties
    variable _previous_style



    if { $styleName != "" } {
        set cstyle $styleName
    } else {
        set cstyle $colors(style)
    }

    # determine, it style has changed in the meantime...
    if { [info exists _previous_style] &&
         [string compare $_previous_style $cstyle] == 0 } {
        return
    }
    set _previous_style $cstyle


    # style name available ?
    if { [lsearch [_get_colordcls] $cstyle] == -1 } {
        return -code error \
	   "specified style '$cstyle' is not available!"
    }




    # evaluate procedure where the naming matches the currently active theme:
    if { [catch { "${cstyle}_Color" }] != 0 } {
        default_Color
    }

    if { ![using ttk] } {
        if { $_properties(setoptdb) != 0 } {
            event generate . <<ThemeChanged>>
	}

        return
    }

    # if not already set, try to set specified ttk style as well
    if { [string compare [_read_ttk_current_theme] $cstyle] != 0 } {

        uplevel "#0" package require ttk::theme::${cstyle}
        ttk::setTheme $cstyle
    }

    # superseed color options from the ones provided by ttk theme (if available),
    # to fit as close as possible with the curent style, if one of the refered
    # option is not provided (which is most likely the case), we take the ones
    # which are declared by our own!

    # "-selectbackground" { set colors(SystemHighlight)     $val }
    # "-selectforeground" { set colors(SystemHighlightText) $val }

    foreach {opt val} [BWidget::_read_ttkstylecolors] {
      switch -- $opt {
          "-foreground"  { set colors(SystemWindowText)  $val }
          "-background"  { set colors(SystemWindowFrame) $val }
          "-troughcolor" { set colors(SystemScrollbar)   $val }
      }
    }
}


proc ::BWidget::_themechanged {} {
  variable _properties

    set_themedefaults

    # proceed in case the user really want's this behaviour - might cause some
    # side effects - as the option settings are affecting almost everything...
    if { $_properties(setoptdb) == 0 } {
        return
    }

    # -- propagate new color settings:
    # note:
    #   modifying the option database doesn't affect existing widgets,
    #   only new widgets 'll be taken into account
    #
    #     Priorities:
................................................................................
            foreach optitem [$child configure] {
                if { [lsearch $optitem $copt] != -1 } {
	            catch { $child configure $copt $cval }
                }
            }
	}
    }

}


#------------------------------------------------------------------------------
# color declarations and related functions
#------------------------------------------------------------------------------

proc ::BWidget::_get_colordcls { } {
    set stylelist {}
    set keyword "_Color"
    foreach name [info proc] {
         if { [regexp -all -- $keyword $name] } {
	     set nlen [string length $name]
	     set klen [string length $keyword]
	     set stylename [string range $name 0 [expr {$nlen - $klen - 1}]]
................................................................................
             lappend stylelist $stylename
	 }
    }
    return [lsort -dictionary $stylelist]
}


proc ::BWidget::default_Color { } {
    variable colors
    set colors(style) "default"

    # !!! doesn't work on winxp64
    #     + starpacked executable from equi4
    # if {[string equal $::tcl_platform(platform) "---windows---"]} {
    #    array set colors {
................................................................................
    #      SystemHighlightText SystemHighlightText
    #      SystemMenu          SystemMenu
    #      SystemMenuText      SystemMenuText
    #      SystemScrollbar     SystemScrollbar
    #    }
    # }

    # try to stay compatible as much as possible,
    # therefor we try to map tk option database with the color array:

    array set colors {
            SystemWindow        "Black"
            SystemWindowFrame   "#d9d9d9"
            SystemWindowText    "Black"
            SystemButtonFace    "#d9d9d9"
            SystemButtonText    "Black"
            SystemDisabledText  "#a3a3a3"
            SystemHighlight     "#c3c3c3"
            SystemHighlightText "White"
            SystemMenu          "#d9d9d9"
            SystemMenuText      "Black"
            SystemScrollbar     "#d9d9d9"
    }
   
    # override our own defaults with
    # colors from the option database (if available):

    foreach {colSynonym colOptName} \
                  { SystemWindow        background
                    SystemWindowFrame   background
                    SystemWindowText    foreground
                    SystemButtonText    activeForeground
                    SystemButtonFace    activeBackground
                    SystemDisabledText  disabledForeground
                    SystemHighlight     selectBackground
                    SystemHighlightText selectForeground
                    SystemMenu          background
                    SystemMenuText      foreground
                    SystemScrollbar     troughcolor } {

      set opt [_getDefaultClassOpt $colOptName]

      if { [string length $opt] > 0 } {
          # puts "$colSynonym : $colOptName : $opt"
          set colors($colSynonym) $opt
      }
    }
}


proc ::BWidget::grey_Color { } {
    variable colors
    set colors(style) "grey"

    array set colors {
            SystemWindow        "White"
            SystemWindowFrame   "#d9d9d9"
            SystemWindowText    "Black"
            SystemButtonFace    "#d9d9d9"
            SystemButtonText    "Black"
            SystemDisabledText  "#a3a3a3"
................................................................................
            SystemMenu          "#d9d9d9"
            SystemMenuText      "Black"
            SystemScrollbar     "#d9d9d9"
   }
}


proc ::BWidget::winxpblue_Color { } {
    variable colors
    set colors(style) "winxpblue"

    array set colors {
      Style               "winxpblue"
      SystemWindow        "White"
      SystemWindowFrame   "#ece9d8"
................................................................................
      SystemHighlightText "Black"
      SystemMenu          "LightGrey"
      SystemMenuText      "Black"
      SystemScrollbar     "#d9d9d9"
    }
}

proc ::BWidget::plastik_Color { } {
    variable colors
    set colors(style) "plastik"

    array set colors {
      SystemWindow        "LightGrey"
      SystemWindowFrame   "#efefef"
      SystemWindowText    "Black"
................................................................................
      SystemHighlightText "Black"
      SystemMenu          "LightGrey"
      SystemMenuText      "Black"
      SystemScrollbar     "#efefef"
    }
}

proc ::BWidget::keramik_Color { } {
    variable colors
    set colors(style) "keramik"

    array set colors {
      SystemWindow        "#ffffff"
      SystemWindowFrame   "#dddddd"
      SystemWindowText    "Black"
................................................................................
      SystemHighlightText "Black"
      SystemMenu          "LightGrey"
      SystemMenuText      "Black"
      SystemScrollbar     "#efefef"
    }
}

proc ::BWidget::keramik_alt_Color { } {
    keramik_Color
    set colors(style) "keramik_alt"

}

proc ::BWidget::black_Color { } {
    variable colors
    set colors(style) "black"

    array set colors {
      SystemWindow        "#424242"
      SystemWindowFrame   "#424242"
      SystemWindowText    "Black"
................................................................................
      SystemMenu          "#222222"
      SystemMenuText      "#ffffff"
      SystemScrollbar     "#626262"
    }
}


proc ::BWidget::aquativo_Color { } {
    variable colors
    set colors(style) "aquativo"

    array set colors {
      SystemWindow        "#EDF3FE"
      SystemWindowFrame   "White"
      SystemWindowText    "Black"