1# ---------------------------------------------------------------------------- 2# buttonbox.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: buttonbox.tcl,v 1.15 2009/11/01 20:20:50 oberdorfer Exp $ 5# ---------------------------------------------------------------------------- 6# Index of commands: 7# - ButtonBox::create 8# - ButtonBox::configure 9# - ButtonBox::cget 10# - ButtonBox::add 11# - ButtonBox::itemconfigure 12# - ButtonBox::itemcget 13# - ButtonBox::setfocus 14# - ButtonBox::invoke 15# - ButtonBox::index 16# - ButtonBox::_destroy 17# - ButtonBox::_themechanged 18# ---------------------------------------------------------------------------- 19 20namespace eval ButtonBox { 21 Widget::define ButtonBox buttonbox Button 22 23 Widget::declare ButtonBox { 24 {-background Color "SystemWindowFrame" 0} 25 {-orient Enum horizontal 1 {horizontal vertical}} 26 {-state Enum "normal" 0 {normal disabled}} 27 {-homogeneous Boolean 1 1} 28 {-spacing Int 10 0 "%d >= 0"} 29 {-padx TkResource "" 0 button} 30 {-pady TkResource "" 0 button} 31 {-default Int -1 0 "%d >= -1"} 32 {-bg Synonym -background} 33 {-style String "" 0} 34 } 35 36 if { ![BWidget::using ttk] } { 37 Widget::addmap ButtonBox "" :cmd {-background {}} 38 } 39 if { [BWidget::using ttk] } { 40 Widget::addmap Button "" :cmd {-style {}} 41 } 42 43 Widget::addmap ButtonBox "" :cmd {-background {}} 44 45 bind ButtonBox <Destroy> [list ButtonBox::_destroy %W] 46 47 if {[lsearch [bindtags .] ButtonBoxThemeChanged] < 0} { 48 bindtags . [linsert [bindtags .] 1 ButtonBoxThemeChanged] 49 } 50} 51 52 53# ---------------------------------------------------------------------------- 54# Command ButtonBox::create 55# ---------------------------------------------------------------------------- 56proc ButtonBox::create { path args } { 57 Widget::init ButtonBox $path $args 58 59 variable $path 60 upvar 0 $path data 61 62 eval [list frame $path] [Widget::subcget $path :cmd] \ 63 [list -class ButtonBox -takefocus 0 -highlightthickness 0] 64 65 # For 8.4+ we don't want to inherit the padding 66 catch {$path configure -padx 0 -pady 0} 67 68 set data(max) 0 69 set data(nbuttons) 0 70 set data(buttons) [list] 71 set data(default) [Widget::getoption $path -default] 72 73 bind ButtonBoxThemeChanged <<ThemeChanged>> \ 74 "+ [namespace current]::_themechanged $path" 75 76 return [Widget::create ButtonBox $path] 77} 78 79 80# ---------------------------------------------------------------------------- 81# Command ButtonBox::configure 82# ---------------------------------------------------------------------------- 83proc ButtonBox::configure { path args } { 84 variable $path 85 upvar 0 $path data 86 87 set res [Widget::configure $path $args] 88 89 if { [Widget::hasChanged $path -default val] } { 90 if { $data(default) != -1 && $val != -1 } { 91 set but $path.b$data(default) 92 if { [winfo exists $but] } { 93 $but configure -default normal 94 } 95 set but $path.b$val 96 if { [winfo exists $but] } { 97 $but configure -default active 98 } 99 set data(default) $val 100 } else { 101 Widget::setoption $path -default $data(default) 102 } 103 } 104 105 if {[Widget::hasChanged $path -state val]} { 106 foreach i $data(buttons) { 107 $path.b$i configure -state $val 108 } 109 } 110 111 return $res 112} 113 114 115# ---------------------------------------------------------------------------- 116# Command ButtonBox::cget 117# ---------------------------------------------------------------------------- 118proc ButtonBox::cget { path option } { 119 return [Widget::cget $path $option] 120} 121 122 123# ---------------------------------------------------------------------------- 124# Command ButtonBox::add 125# ---------------------------------------------------------------------------- 126proc ButtonBox::add { path args } { 127 return [eval [linsert $args 0 insert $path end]] 128} 129 130 131proc ButtonBox::insert { path idx args } { 132 variable $path 133 upvar 0 $path data 134 135 set but $path.b$data(nbuttons) 136 set spacing [Widget::getoption $path -spacing] 137 138 ## Save the current spacing setting for this button. Buttons 139 ## appended to the end of the box have their spacing applied 140 ## to their left while all other have their spacing applied 141 ## to their right. 142 if {$idx == "end"} { 143 set data(spacing,$data(nbuttons)) [list left $spacing] 144 lappend data(buttons) $data(nbuttons) 145 } else { 146 set data(spacing,$data(nbuttons)) [list right $spacing] 147 set data(buttons) [linsert $data(buttons) $idx $data(nbuttons)] 148 } 149 150 if { $data(nbuttons) == $data(default) } { 151 set style active 152 } elseif { $data(default) == -1 } { 153 set style disabled 154 } else { 155 set style normal 156 } 157 158 array set flags $args 159 set tags "" 160 if { [info exists flags(-tags)] } { 161 set tags $flags(-tags) 162 unset flags(-tags) 163 set args [array get flags] 164 } 165 166 eval [list Button::create $but \ 167 -background [Widget::getoption $path -background]\ 168 -padx [Widget::getoption $path -padx] \ 169 -pady [Widget::getoption $path -pady]] \ 170 $args [list -default $style] 171 172 # a button box button - by default - is flat! 173 if { [BWidget::using ttk] } { 174 $but configure -style [Button::getSlimButtonStyle] 175 } 176 177 # ericm@scriptics.com: set up tags, just like the menu items 178 foreach tag $tags { 179 lappend data(tags,$tag) $but 180 if { ![info exists data(tagstate,$tag)] } { 181 set data(tagstate,$tag) 0 182 } 183 } 184 set data(buttontags,$but) $tags 185 # ericm@scriptics.com 186 187 _redraw $path 188 189 incr data(nbuttons) 190 191 return $but 192} 193 194 195proc ButtonBox::delete { path idx } { 196 variable $path 197 upvar 0 $path data 198 199 set i [lindex $data(buttons) $idx] 200 set data(buttons) [lreplace $data(buttons) $idx $idx] 201 destroy $path.b$i 202} 203 204 205# ButtonBox::setbuttonstate -- 206# 207# Set the state of a given button tag. If this makes any buttons 208# enable-able (ie, all of their tags are TRUE), enable them. 209# 210# Arguments: 211# path the button box widget name 212# tag the tag to modify 213# state the new state of $tag (0 or 1) 214# 215# Results: 216# None. 217 218proc ButtonBox::setbuttonstate {path tag state} { 219 variable $path 220 upvar 0 $path data 221 # First see if this is a real tag 222 if { [info exists data(tagstate,$tag)] } { 223 set data(tagstate,$tag) $state 224 foreach but $data(tags,$tag) { 225 set expression "1" 226 foreach buttontag $data(buttontags,$but) { 227 append expression " && $data(tagstate,$buttontag)" 228 } 229 if { [expr $expression] } { 230 set state normal 231 } else { 232 set state disabled 233 } 234 $but configure -state $state 235 } 236 } 237 return 238} 239 240# ButtonBox::getbuttonstate -- 241# 242# Retrieve the state of a given button tag. 243# 244# Arguments: 245# path the button box widget name 246# tag the tag to modify 247# 248# Results: 249# None. 250 251proc ButtonBox::getbuttonstate {path tag} { 252 variable $path 253 upvar 0 $path data 254 # First see if this is a real tag 255 if { [info exists data(tagstate,$tag)] } { 256 return $data(tagstate,$tag) 257 } else { 258 error "unknown tag $tag" 259 } 260} 261 262# ---------------------------------------------------------------------------- 263# Command ButtonBox::itemconfigure 264# ---------------------------------------------------------------------------- 265proc ButtonBox::itemconfigure { path index args } { 266 if { [set idx [lsearch $args -default]] != -1 } { 267 set args [lreplace $args $idx [expr {$idx+1}]] 268 } 269 return [eval [list Button::configure $path.b[index $path $index]] $args] 270} 271 272 273# ---------------------------------------------------------------------------- 274# Command ButtonBox::itemcget 275# ---------------------------------------------------------------------------- 276proc ButtonBox::itemcget { path index option } { 277 return [Button::cget $path.b[index $path $index] $option] 278} 279 280 281# ---------------------------------------------------------------------------- 282# Command ButtonBox::setfocus 283# ---------------------------------------------------------------------------- 284proc ButtonBox::setfocus { path index } { 285 set but $path.b[index $path $index] 286 if { [winfo exists $but] } { 287 focus $but 288 } 289} 290 291 292# ---------------------------------------------------------------------------- 293# Command ButtonBox::invoke 294# ---------------------------------------------------------------------------- 295proc ButtonBox::invoke { path index } { 296 set but $path.b[index $path $index] 297 if { [winfo exists $but] } { 298 Button::invoke $but 299 } 300} 301 302 303# ---------------------------------------------------------------------------- 304# Command ButtonBox::index 305# ---------------------------------------------------------------------------- 306proc ButtonBox::index { path index } { 307 variable $path 308 upvar 0 $path data 309 310 set n [expr {$data(nbuttons) - 1}] 311 312 if {[string equal $index "default"]} { 313 set res [Widget::getoption $path -default] 314 } elseif {$index == "end" || $index == "last"} { 315 set res $n 316 } elseif {![string is integer -strict $index]} { 317 ## It's not an integer. Search the text of each button 318 ## in the box and return the index that matches. 319 foreach i $data(buttons) { 320 set w $path.b$i 321 lappend text [$w cget -text] 322 lappend names [$w cget -name] 323 } 324 set res [lsearch -exact [concat $names $text] $index] 325 } else { 326 set res $index 327 if {$index > $n} { set res $n } 328 } 329 return $res 330} 331 332 333# ButtonBox::gettags -- 334# 335# Return a list of all the tags on all the buttons in a buttonbox. 336# 337# Arguments: 338# path the buttonbox to query. 339# 340# Results: 341# taglist a list of tags on the buttons in the buttonbox 342 343proc ButtonBox::gettags {path} { 344 upvar ::ButtonBox::$path data 345 set taglist {} 346 foreach tag [array names data "tags,*"] { 347 lappend taglist [string range $tag 5 end] 348 } 349 return $taglist 350} 351 352 353# ---------------------------------------------------------------------------- 354# Command ButtonBox::_redraw 355# ---------------------------------------------------------------------------- 356proc ButtonBox::_redraw { path } { 357 variable $path 358 upvar 0 $path data 359 Widget::getVariable $path buttons 360 361 # For tk >= 8.4, -uniform gridding option is used. 362 # Otherwise, there is the constraint, that button size may not change after 363 # creation. 364 set uniformAvailable [expr {0 <= [package vcompare [info patchlevel] 8.4.0]}] 365 366 ## We re-grid the buttons from left-to-right. As we go through 367 ## each button, we check its spacing and which direction the 368 ## spacing applies to. Once spacing has been applied to an index, 369 ## it is not changed. This means spacing takes precedence from 370 ## left-to-right. 371 372 set idx 0 373 set idxs [list] 374 foreach i $data(buttons) { 375 set dir [lindex $data(spacing,$i) 0] 376 set spacing [lindex $data(spacing,$i) 1] 377 set but $path.b$i 378 if {[string equal [Widget::getoption $path -orient] "horizontal"]} { 379 grid $but -column $idx -row 0 -sticky nsew 380 if { [Widget::getoption $path -homogeneous] } { 381 if {$uniformAvailable} { 382 grid columnconfigure $path $idx -uniform koen -weight 1 383 } else { 384 set req [winfo reqwidth $but] 385 if { $req > $data(max) } { 386 grid columnconfigure $path [expr {2*$i}] -minsize $req 387 set data(max) $req 388 } 389 grid columnconfigure $path $idx -weight 1 390 } 391 } else { 392 grid columnconfigure $path $idx -weight 0 393 } 394 395 set col [expr {$idx - 1}] 396 if {[string equal $dir "right"]} { set col [expr {$idx + 1}] } 397 if {$col > 0 && [lsearch $idxs $col] < 0} { 398 lappend idxs $col 399 grid columnconfigure $path $col -minsize $spacing 400 } 401 } else { 402 grid $but -column 0 -row $idx -sticky nsew 403 grid rowconfigure $path $idx -weight 0 404 405 set row [expr {$idx - 1}] 406 if {[string equal $dir "right"]} { set row [expr {$idx + 1}] } 407 if {$row > 0 && [lsearch $idxs $row] < 0} { 408 lappend idxs $row 409 grid rowconfigure $path $row -minsize $spacing 410 } 411 } 412 incr idx 2 413 } 414 415 if {!$uniformAvailable} { 416 # Now that the maximum size has been calculated, go back through 417 # and correctly set the size for homogeneous horizontal buttons. 418 if { [string equal [Widget::getoption $path -orient] "horizontal"] && [Widget::getoption $path -homogeneous] } { 419 set idx 0 420 foreach i $data(buttons) { 421 grid columnconfigure $path $idx -minsize $data(max) 422 incr idx 2 423 } 424 } 425 } 426} 427 428 429# ---------------------------------------------------------------------------- 430# Command ButtonBox::_destroy 431# ---------------------------------------------------------------------------- 432proc ButtonBox::_destroy { path } { 433 variable $path 434 upvar 0 $path data 435 Widget::destroy $path 436 unset data 437} 438 439# ---------------------------------------------------------------------------- 440# Command ButtonBox::_themechanged 441# ---------------------------------------------------------------------------- 442proc ButtonBox::_themechanged { path } { 443 444 if { ![winfo exists $path] } { return } 445 BWidget::set_themedefaults 446 447 $path configure -background $BWidget::colors(SystemWindowFrame) 448} 449