#
# $Id: tile.tcl,v 1.24 2004/01/06 16:43:23 patthoyts Exp $
#
# Widget bindings and default appearance for Tile widget set.
#
if {![info exists tile_library]} {
set tile_library [file dirname [info script]]
}
source [file join $tile_library keynav.tcl]
source [file join $tile_library button.tcl]
source [file join $tile_library scrollbar.tcl]
source [file join $tile_library scale.tcl]
#
# Helper routines:
#
namespace eval Tile {
proc takefocus {w} {
return [$w instate !disabled]
}
proc activate {w} {
set oldState [$w state pressed]
update ; after 100
$w state $oldState
after idle [list $w invoke]
}
proc arm {w} {
$w state pressed
event generate $w <<Arm>>
}
proc disarm {w} {
$w state !pressed
event generate $w <<Disarm>>
}
#
# Routines for auto-repeat:
#
# NOTE: repeating widgets do not have -repeatdelay
# or -repeatinterval resources as in standard Tk;
# instead a single set of settings is applied application-wide.
# (TODO: make this user-configurable)
#
# (@@@ Windows seems to use something like 500/50 millisecons
# @@@ for -repeatdelay/-repeatinterval)
#
variable Repeat
array set Repeat {
delay 300
interval 100
timer {}
script {}
}
proc Repeatedly {args} {
variable Repeat
after cancel $Repeat(timer)
set script [uplevel 1 [list namespace code $args]]
set Repeat(script) $script
uplevel #0 $script
set Repeat(timer) [after $Repeat(delay) Tile::Repeat]
}
proc Repeat {} {
variable Repeat
uplevel #0 $Repeat(script)
set Repeat(timer) [after $Repeat(interval) Tile::Repeat]
}
proc CancelRepeat {} {
variable Repeat
after cancel $Repeat(timer)
}
#
# ThemeChanged --
# Called from [style settheme].
# Notifies all widgets that the theme has changed.
#
proc ThemeChanged {} {
set Q .
while {[llength $Q]} {
set QN [list]
foreach w $Q {
catch { $w configure -style [$w cget -style] }
foreach child [winfo children $w] {
lappend QN $child
}
}
set Q $QN
}
}
}
# Appearance:
#
catch {font create ButtonFont}
namespace eval Tile {
switch $tcl_platform(platform) {
windows {
font configure ButtonFont -family {MS Sans Serif} -size 8 -weight normal
set defaultBG "SystemButtonFace"
set activeBG "SystemButtonFace"
set troughColor "SystemButtonFace"
}
unix -
default {
font configure ButtonFont -family Helvetica -size -12 -weight bold
set defaultBG #d9d9d9
set activeBG #ececec
set troughColor #c3c3c3
} }
style elementconfigure "" background -background "
disabled $defaultBG
active $activeBG
{} $defaultBG
"
style elementconfigure "alt" background -background "
disabled $defaultBG
active $activeBG
{} $defaultBG
"
foreach class {
TRadiobutton TCheckbutton
TScrollbarHorizontal TScrollbarVertical
} {
foreach theme {"" "alt"} {
style configure $theme $class -background "
disabled $defaultBG
active $activeBG
{} $defaultBG
"
}
}
style configure "" TButton -relief {
{pressed !disabled} sunken
{active !disabled} raised
}
style configure alt TButton -relief {
{pressed !disabled} sunken
{active !disabled} raised
}
# @@@ TODO: rename "label" -> "text", "compound" -> "label",
# use "label" everywhere.
foreach theme {{} alt step} {
foreach element {label compound} {
style elementconfigure $theme $element -foreground {
disabled #a3a3a3
}
}
foreach style {TButton TCheckbutton TRadiobutton} {
style configure $theme $style -foreground {
disabled #a3a3a3
}
}
}
foreach class {TCheckbutton TRadiobutton} {
style configure "" $class -indicatorrelief {
selected sunken
pressed sunken
{} raised
}
style configure "" $class -indicatorcolor "
pressed $defaultBG
selected #b03060
{} $defaultBG
"
style configure alt $class -indicatorcolor "
disabled $defaultBG
pressed $defaultBG
{} #FFFFFF
"
}
foreach theme {{} alt step} {
style configure $theme TScrollbarHorizontal -relief {
pressed sunken
{} raised
} \
-troughcolor [list {} $troughColor] \
style configure $theme TScrollbarVertical -relief {
pressed sunken
{} raised
} -troughcolor [list {} $troughColor]
# @@@ Sort out scrollbar "background" vs. "trough"
style elementconfigure $theme Scrollbar.background \
-background [list {} $troughColor]
style elementconfigure $theme Scrollbar.border \
-relief [list {} sunken] \
;
}
# Scale widget settings
foreach elt {hslider vslider} {
style elementconfigure {} $elt -background [list \
{active !disabled} $activeBG \
{} $defaultBG \
]
style elementconfigure {} $elt -sliderrelief {
{pressed !disabled} sunken
{} raised
}
}
foreach theme {{} step} {
style elementconfigure $theme hslider -sliderstyle {{} flat}
style elementconfigure $theme vslider -sliderstyle {{} flat}
}
style elementconfigure {} hslider -sliderstyle {{} flat}
style elementconfigure {} vslider -sliderstyle {{} vertical}
style elementconfigure alt hslider -sliderstyle {{} bottom}
style elementconfigure alt vslider -sliderstyle {{} right}
style elementconfigure step hslider -sliderstyle {{} flat}
style elementconfigure step vslider -sliderstyle {{} vertical}
foreach elt {Scale.htrough Scale.vtrough} {
foreach theme {{} alt step} {
style elementconfigure $theme $elt \
-troughcolor [list {} $troughColor ]
}
if {[tk windowingsystem] == "win32"} {
style elementconfigure alt $elt \
-troughcolor [list {} SystemScrollbar]
}
foreach theme {{} alt step} {
style elementconfigure $theme $elt \
-troughrelief { {} sunken }
}
}
if {![catch {package present tile::xpnative}]} {
style elementconfigure xpnative Scrollbar.background -background {
{} white
}
style elementconfigure xpnative Button.padding -padding {{} "4m 0" }
style elementconfigure xpnative hslider -sliderstyle {{} "top"}
style elementconfigure xpnative vslider -sliderstyle {{} "left"}
}
}
namespace eval Tile {
set step_defaultBG $defaultBG ;#"#a0a0a0"
set step_lightBG $defaultBG
set step_activeBG $activeBG ;#"#d0d0d0"
set step_scrollBG $defaultBG ;#"#aeb2c3"
style elementconfigure "step" background -background "
disabled $step_defaultBG
active $step_activeBG
{} $step_defaultBG
"
style elementconfigure "step" Button.border -relief {
{pressed !disabled} sunken
{active !disabled} raised
}
style elementconfigure "step" Checkbutton.indicator -indicatorrelief {
{pressed !disabled} sunken
{} raised
}
style elementconfigure "step" Radiobutton.indicator -indicatorrelief {
pressed sunken
{} groove
}
style elementconfigure "step" Radiobutton.indicator -indicatorcolor "
{} $step_lightBG
"
style elementconfigure "step" Scrollbar.background -background "
disabled $step_defaultBG
active $step_scrollBG
{} $step_defaultBG
"
style elementconfigure "step" background -background "{} $step_defaultBG"
}
option add *TButton.padding "3m 1m"
style elementconfigure alt Button.padding -padding {{} "3m 0" }
option add *TButton.relief raised
option add *TButton.font ButtonFont
option add *TCheckbutton.relief flat
option add *TCheckbutton.font ButtonFont
option add *TRadiobutton.relief flat
option add *TRadiobutton.font ButtonFont
option add *TScrollbar.takeFocus 0
option add *TScrollbar.relief sunken
#*EOF*