Skip to content

Commit 16ca6a1

Browse files
author
oberdorfer
committed
*** code consolidation + refracturing
 related to BWSlim.Toolbutton style, attempt to improve Button behavior when ttk is used (still not perfect thought)
1 parent e047422 commit 16ca6a1

File tree

5 files changed

+91
-94
lines changed

5 files changed

+91
-94
lines changed

‎button.tcl

+36-62
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,23 @@
11
# ----------------------------------------------------------------------------
22
# button.tcl
33
# This file is part of Unifix BWidget Toolkit
4-
# $Id: button.tcl,v 1.14 2009/09/11 16:04:14 oberdorfer Exp $
4+
# $Id: button.tcl,v 1.15 2009/11/01 20:20:50 oberdorfer Exp $
55
# ----------------------------------------------------------------------------
66
# Index of commands:
77
# Public commands
88
# - Button::create
99
# - Button::configure
1010
# - Button::cget
1111
# - Button::invoke
12+
# - Button::getSlimButtonStyle
1213
# Private commands (event bindings)
1314
# - Button::_destroy
1415
# - Button::_enter
1516
# - Button::_leave
1617
# - Button::_press
1718
# - Button::_release
1819
# - Button::_repeat
20+
# - Button::_styleconfigure
1921
# ----------------------------------------------------------------------------
2022

2123
namespace eval Button {
@@ -27,7 +29,7 @@ namespace eval Button {
2729
lappend remove -repeatdelay -repeatinterval
2830
}
2931

30-
# if { [BWidget::using ttk] } { lappend remove -borderwidth }
32+
if { [BWidget::using ttk] } { lappend remove -borderwidth }
3133

3234
Widget::tkinclude Button button :cmd remove $remove
3335

@@ -73,47 +75,13 @@ namespace eval Button {
7375
}
7476

7577

76-
proc Button::createButtonStyles {} {
77-
variable _styles_created
78-
79-
if { [info exists _styles_created] && $_styles_created != 0 } {
80-
return
81-
}
82-
if { ![BWidget::using ttk] } { return }
83-
84-
# create a new element for each available theme...
85-
foreach themeName [ttk::style theme names] {
86-
87-
# temporarily sets the current theme to themeName,
88-
# evaluate script, then restore the previous theme.
89-
90-
ttk::style theme settings $themeName {
91-
92-
# emulate tk behavior, referenced later on such like:
93-
# -style "${relief}BW.TButton"
94-
95-
::ttk::style configure raisedBW.TButton -relief raised
96-
::ttk::style configure sunkenBW.TButton -relief sunken
97-
::ttk::style configure flatBW.TButton -relief flat
98-
::ttk::style configure solidBW.TButton -relief solid
99-
::ttk::style configure grooveBW.TButton -relief groove
100-
::ttk::style configure linkBW.TButton -relief flat -bd 2
101-
}
102-
}
103-
104-
set _styles_created 1
105-
}
106-
107-
108-
10978
# ----------------------------------------------------------------------------
11079
# Command Button::create
11180
# ----------------------------------------------------------------------------
11281
proc Button::create { path args } {
11382
variable _ttkunsupported_opt
11483

11584
if { [BWidget::using ttk] } {
116-
createButtonStyles
11785

11886
# remove unsupported tk options
11987
# (hope that's all we need to take care about)
@@ -129,18 +97,16 @@ proc Button::create { path args } {
12997
array set maps [list Button {} :cmd {}]
13098
array set maps [Widget::parseArgs Button $args]
13199

132-
if {[BWidget::using ttk]} {
133-
eval [concat [list ttk::button $path] $maps(:cmd)]
134-
} else {
135-
eval [concat [list button $path] $maps(:cmd)]
136-
}
100+
if { [BWidget::using ttk] } {
101+
eval [concat [list ttk::button $path] $maps(:cmd)]
102+
} else { eval [concat [list button $path] $maps(:cmd)] }
137103

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

140-
# Do some extra configuration on the button
106+
# do some extra configuration on the button
141107
set relief [Widget::getMegawidgetOption $path -relief]
142108

143-
if { [string equal $relief "link"] } {
109+
if { ![BWidget::using ttk] && [string equal $relief "link"] } {
144110
set relief "flat"
145111
}
146112
set var [Widget::getMegawidgetOption $path -textvariable]
@@ -162,13 +128,17 @@ proc Button::create { path args } {
162128
Widget::configure $path [list -underline $under]
163129
}
164130

165-
166131
if { [BWidget::using ttk] } {
167132
$path configure -text $text -underline $under \
168133
-textvariable $var -state $st
169134

170-
if { [$path cget -style] != "BWSlim.Toolbutton" } {
171-
$path configure -style "${relief}BW.TButton"
135+
# distinguish between a standard button (raised) which sould appear
136+
# as declared in the celated style and button with user defined arg's
137+
# where the style 'll be overwritten to emulate existing behavior
138+
139+
if { $relief != "raised" &&
140+
[$path cget -style] != "BWSlim.Toolbutton" } {
141+
$path configure -style "BW${relief}.Toolbutton"
172142
}
173143
} else {
174144
$path configure -relief $relief -text $text -underline $under \
@@ -221,28 +191,27 @@ proc Button::configure { path args } {
221191
if { $cr || $cs } {
222192
set relief [Widget::cget $path -relief]
223193
set state [Widget::cget $path -state]
224-
if { [string equal $relief "link"] } {
194+
195+
if { ![BWidget::using ttk] && [string equal $relief "link"] } {
225196
if { [string equal $state "active"] } {
226-
set relief "raised"
227-
} else {
228-
set relief "flat"
229-
}
197+
set relief "raised"
198+
} else { set relief "flat" }
230199
}
231200

232201
if { [BWidget::using ttk] } {
233202
$path:cmd configure -state $state
234203
if { [string compare [$path:cmd cget -style] "BWSlim.Toolbutton"] != 0 } {
235-
$path:cmd configure -style "${relief}BW.TButton"
204+
$path:cmd configure -style "BW${relief}.Toolbutton"
236205
}
237206
} else {
238207
$path:cmd configure -relief $relief -state $state
239208
}
240209
}
241210

242211
if { $cv || $cn || $ct || $cu } {
243-
set var [Widget::cget $path -textvariable]
244-
set text [Widget::cget $path -text]
245-
set under [Widget::cget $path -underline]
212+
set var [Widget::cget $path -textvariable]
213+
set text [Widget::cget $path -text]
214+
set under [Widget::cget $path -underline]
246215
if { ![string length $var] } {
247216
set desc [BWidget::getname [Widget::cget $path -name]]
248217
if { [llength $desc] } {
@@ -280,6 +249,13 @@ proc Button::cget { path option } {
280249
}
281250

282251

252+
proc Button::getSlimButtonStyle {} {
253+
if { [BWidget::using ttk] } {
254+
return "BWSlim.Toolbutton"
255+
}
256+
return ""
257+
}
258+
283259
# ----------------------------------------------------------------------------
284260
# Command Button::invoke
285261
# ----------------------------------------------------------------------------
@@ -295,7 +271,7 @@ proc Button::invoke { path } {
295271
}
296272
after 100
297273
set relief [Widget::getMegawidgetOption $path -relief]
298-
if { [string equal $relief "link"] } {
274+
if { ![BWidget::using ttk] && [string equal $relief "link"] } {
299275
set relief flat
300276
}
301277

@@ -326,11 +302,8 @@ proc Button::_enter { path } {
326302
if { ![string equal [$path:cmd cget -state] "disabled"] } {
327303
$path:cmd configure -state active
328304
if { $_pressed == $path } {
329-
330305
_styleconfigure $path sunken
331-
332306
} elseif { [string equal [Widget::cget $path -relief] "link"] } {
333-
334307
_styleconfigure $path raised
335308
}
336309
}
@@ -342,7 +315,7 @@ proc Button::_styleconfigure { path relief_or_style } {
342315
if { [BWidget::using ttk] } {
343316
# do not override the toolbutton style:
344317
if { [$path:cmd cget -style] != "BWSlim.Toolbutton" } {
345-
$path:cmd configure -style "${relief_or_style}BW.TButton"
318+
$path:cmd configure -style "BW${relief_or_style}.Toolbutton"
346319
}
347320
} else {
348321
$path:cmd configure -relief $relief_or_style
@@ -382,7 +355,7 @@ proc Button::_press { path } {
382355
if { ![string equal [$path:cmd cget -state] "disabled"] } {
383356
set _pressed $path
384357

385-
_styleconfigure $path sunken
358+
if { ![BWidget::using ttk] } { _styleconfigure $path sunken }
386359

387360
set cmd [Widget::getMegawidgetOption $path -armcommand]
388361
if { $cmd != "" } {
@@ -410,11 +383,12 @@ proc Button::_release { path } {
410383
set _pressed ""
411384
set relief [Widget::getMegawidgetOption $path -relief]
412385
after cancel "Button::_repeat $path"
386+
413387
if { [string equal $relief "link"] } {
414388
set relief raised
415389
}
416390

417-
_styleconfigure $path $relief
391+
if { ![BWidget::using ttk] } { _styleconfigure $path $relief }
418392

419393
set cmd [Widget::getMegawidgetOption $path -disarmcommand]
420394
if { $cmd != "" } {

‎buttonbox.tcl

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
# ----------------------------------------------------------------------------
22
# buttonbox.tcl
33
# This file is part of Unifix BWidget Toolkit
4-
# $Id: buttonbox.tcl,v 1.14 2009/09/06 21:03:48 oberdorfer Exp $
4+
# $Id: buttonbox.tcl,v 1.15 2009/11/01 20:20:50 oberdorfer Exp $
55
# ----------------------------------------------------------------------------
66
# Index of commands:
77
# - ButtonBox::create
@@ -171,7 +171,7 @@ proc ButtonBox::insert { path idx args } {
171171

172172
# a button box button - by default - is flat!
173173
if { [BWidget::using ttk] } {
174-
$but configure -style "BWSlim.Toolbutton"
174+
$but configure -style [Button::getSlimButtonStyle]
175175
}
176176

177177
# [email protected]: set up tags, just like the menu items

‎font.tcl

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
# ----------------------------------------------------------------------------
22
# font.tcl
33
# This file is part of Unifix BWidget Toolkit
4-
# $Id: font.tcl,v 1.17 2009/09/06 21:14:46 oberdorfer Exp $
4+
# $Id: font.tcl,v 1.18 2009/11/01 20:20:50 oberdorfer Exp $
55
# ----------------------------------------------------------------------------
66
# Index of commands:
77
# - SelectFont::create
@@ -344,7 +344,7 @@ proc SelectFont::create { path args } {
344344
-image [Bitmap::get $st] \
345345
-variable SelectFont::${path}($st) \
346346
-command [list SelectFont::_update $path] \
347-
-style "BWSlimCB.Toolbutton"
347+
-style [Button::getSlimButtonStyle]
348348
} else {
349349
button $path.$st \
350350
-highlightthickness 0 -takefocus 0 -padx 0 -pady 0 \

‎themeutils.tcl

+45-17
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@
55
# An approach to re-vitalize the package and to take advantage of tile!
66
# Author: Johann dot Oberdorfer at Googlemail dot com
77
#
8-
# $Id: themeutils.tcl,v 1.3 2009/10/27 22:15:09 oberdorfer Exp $
8+
# $Id: themeutils.tcl,v 1.4 2009/11/01 20:20:50 oberdorfer Exp $
99
# ----------------------------------------------------------------------------
1010
# Index of commands:
1111
# - BWidget::use
@@ -157,21 +157,8 @@ proc ::BWidget::use { args } {
157157
# }
158158

159159
if { [catch {uplevel "#0" package require tile 0.8}] != 0 } {
160-
set _properties($package) 0
161-
} else {
162-
163-
# create a new element for each available theme...
164-
foreach themeName [ttk::style theme names] {
165-
# temporarily sets the current theme to themeName,
166-
# evaluate script, then restore the previous theme.
167-
ttk::style theme settings $themeName {
168-
ttk::style configure BWSlimCB.Toolbutton -relief flat -bd 2
169-
ttk::style map BWSlimCB.Toolbutton \
170-
-relief [list {selected !disabled} sunken]
171-
}
172-
}
173-
set _properties($package) 1
174-
}
160+
set _properties($package) 0
161+
} else { set _properties($package) 1 }
175162
}
176163
default {
177164
return -code error \
@@ -239,9 +226,15 @@ proc ::BWidget::using { optName } {
239226
# a simple wrapper to distinguish between tk and ttk
240227
proc ::BWidget::wrap {wtype wpath args} {
241228

229+
set _ttkunsupported_opt \
230+
{ -font -fg -foreground -background
231+
-highlightthickness -bd -borderwidth
232+
-padx -pady -anchor
233+
-relief -selectforeground -selectbackground }
234+
242235
if { [using ttk] } {
243236
# filter out (ttk-)unsupported (tk-)options:
244-
foreach opt {-background -bd -borderwith -highlightthickness} {
237+
foreach opt $$_ttkunsupported_opt {
245238
set args [Widget::getArgument $args $opt tmp]
246239
}
247240

@@ -403,6 +396,39 @@ proc ::BWidget::_read_ttkstylecolors {} {
403396
}
404397

405398

399+
proc ::BWidget::_createOrUpdateButtonStyles {} {
400+
401+
if { ![using ttk] } { return }
402+
403+
# create a new element for each available theme...
404+
foreach themeName [ttk::style theme names] {
405+
406+
# temporarily sets the current theme to themeName,
407+
# evaluate script, then restore the previous theme.
408+
409+
ttk::style theme settings $themeName {
410+
411+
# emulate tk behavior, referenced later on such like:
412+
# -style "${relief}BW.Toolbutton"
413+
414+
::ttk::style configure BWraised.Toolbutton -relief raised
415+
::ttk::style configure BWsunken.Toolbutton -relief sunken
416+
::ttk::style configure BWflat.Toolbutton -relief flat
417+
::ttk::style configure BWsolid.Toolbutton -relief solid
418+
::ttk::style configure BWgroove.Toolbutton -relief groove
419+
::ttk::style configure BWlink.Toolbutton -relief flat -bd 2
420+
421+
::ttk::style map BWlink.Toolbutton \
422+
-relief [list {selected !disabled} sunken]
423+
424+
::ttk::style configure BWSlim.Toolbutton -relief flat -bd 2
425+
::ttk::style map BWSlim.Toolbutton \
426+
-relief [list {selected !disabled} sunken]
427+
}
428+
}
429+
}
430+
431+
406432
# Purpose:
407433
# Sets the current style + default ttk (tyled) theme,
408434
# ensure, color related array: "BWidget::colors" is updated as well
@@ -474,6 +500,8 @@ proc ::BWidget::set_themedefaults { {styleName ""} } {
474500
"-troughcolor" { set colors(SystemScrollbar) $val }
475501
}
476502
}
503+
504+
_createOrUpdateButtonStyles
477505
}
478506

479507

0 commit comments

Comments
 (0)