1# ---------------------------------------------------------------------------- 2# statusbar.tcl --- 3# This file is part of Unifix BWidget Toolkit 4# $Id: statusbar.tcl,v 1.91 2009/09/06 21:42:14 oberdorfer Exp $ 5# ---------------------------------------------------------------------------- 6# Create a status bar Tk widget 7# 8# Provides a status bar to be placed at the bottom of a toplevel. 9# Currently does not support being placed in a toplevel that has 10# gridding applied (via widget -setgrid or wm grid). 11# 12# Ensure that the widget is placed at the very bottom of the toplevel, 13# otherwise the resize behavior may behave oddly. 14# ------------------------------------------------------------------------ 15# 16 17package require Tk 8.3 18 19if {0} { 20 proc sample {} { 21 # sample usage 22 eval destroy [winfo children .] 23 pack [text .t -width 0 -height 0] -fill both -expand 1 24 25 set sbar .s 26 StatusBar $sbar 27 pack $sbar -side bottom -fill x 28 set f [$sbar getframe] 29 30 # Specify -width 1 for the label widget so it truncates nicely 31 # instead of requesting large sizes for long messages 32 set w [label $f.status -width 1 -anchor w -textvariable ::STATUS] 33 set ::STATUS "This is a status message" 34 # give the entry weight, as we want it to be the one that expands 35 $sbar add $w -weight 1 36 37 # BWidget's progressbar 38 set w [ProgressBar $f.bpbar -orient horizontal \ 39 -variable ::PROGRESS -bd 1 -relief sunken] 40 set ::PROGRESS 50 41 $sbar add $w 42 } 43} 44 45namespace eval StatusBar { 46 Widget::define StatusBar statusbar 47 48 Widget::declare StatusBar { 49 {-background Color "SystemWindow" 0} 50 {-borderwidth TkResource 0 0 frame} 51 {-relief TkResource flat 0 frame} 52 {-showseparator Boolean 1 0} 53 {-showresizesep Boolean 0 0} 54 {-showresize Boolean 1 0} 55 {-width TkResource 100 0 frame} 56 {-height TkResource 18 0 frame} 57 {-ipad String 1 0} 58 {-pad String 0 0} 59 {-bg Synonym -background} 60 {-bd Synonym -borderwidth} 61 } 62 63 # -background, -borderwidth and -relief apply to outer frame, but relief 64 # should be left flat for proper look 65 Widget::addmap StatusBar "" :cmd { 66 -background {} -width {} -height {} -borderwidth {} -relief {} 67 } 68 Widget::addmap StatusBar "" .sbar { 69 -background {} 70 } 71 Widget::addmap StatusBar "" .resize { 72 -background {} 73 } 74 Widget::addmap StatusBar "" .hsep { 75 -background {} 76 } 77 78 # -pad provides general padding around the status bar 79 # -ipad provides padding around each status bar item 80 # Padding can be a list of {padx pady} 81 82 variable HaveMarlett \ 83 [expr {[lsearch -exact [font families] "Marlett"] != -1}] 84 85 bind StatusResize <1> \ 86 [namespace code [list begin_resize %W %X %Y]] 87 bind StatusResize <B1-Motion> \ 88 [namespace code [list continue_resize %W %X %Y]] 89 bind StatusResize <ButtonRelease-1> \ 90 [namespace code [list end_resize %W %X %Y]] 91 92 bind StatusBar <Destroy> [list StatusBar::_destroy %W] 93 94 # PNG version has partial alpha transparency for better look 95 variable pngdata { 96 iVBORw0KGgoAAAANSUhEUgAAAA8AAAAPCAYAAAFM0aXcAAAABGdBTUEAAYagM 97 eiWXwAAAGJJREFUGJW9kVEOgCAMQzs8GEezN69fkKlbUAz2r3l5NGTA+pCU+Q 98 IA5sv39wGgZKClZGBhJMVTklRr3VNwMz04mVfQzQiEm79EkrYZycxIkq8kkv2 99 v6RFGku9TUrj8RGr9AGy6mhv2ymLwAAAAAElFTkSuQmCC 100 } 101 variable gifdata { 102 R0lGODlhDwAPAJEAANnZ2f///4CAgD8/PyH5BAEAAAAALAAAAAAPAA8AAAJEh 103 I+py+1IQvh4IZlG0Qg+QshkAokGQfAvZCBIhG8hA0Ea4UPIQJBG+BAyEKQhCH 104 bIQAgNEQCAIA0hAyE0AEIGgjSEDBQAOw== 105 } 106 if {[package provide img::png] != ""} { 107 image create photo ::StatusBar::resizer -format PNG -data $pngdata 108 } else { 109 image create photo ::StatusBar::resizer -format GIF -data $gifdata 110 } 111} 112 113 114# ------------------------------------------------------------------------ 115# Command StatusBar::create 116# ------------------------------------------------------------------------ 117proc StatusBar::create { path args } { 118 variable _widget 119 variable HaveMarlett 120 121 # Allow for img::png loaded after initial source 122 if {[package provide img::png] != ""} { 123 variable pngdata 124 ::StatusBar::resizer configure -format PNG -data $pngdata 125 } 126 127 Widget::init StatusBar $path $args 128 129 eval [list frame $path -class StatusBar] [Widget::subcget $path :cmd] 130 131 foreach {padx pady} [_padval [Widget::cget $path -pad]] \ 132 {ipadx ipady} [_padval [Widget::cget $path -ipad]] { break } 133 134 if {[BWidget::using ttk]} { 135 set sbar [ttk::frame $path.sbar -padding [list $padx $pady]] 136 } else { 137 set sbar [eval [list frame $path.sbar -padx $padx -pady $pady] \ 138 [Widget::subcget $path .sbar]] 139 } 140 if {[string equal $::tcl_platform(platform) "windows"]} { 141 set cursor size_nw_se 142 } else { 143 set cursor sizing; # bottom_right_corner ?? 144 } 145 set resize [eval [list label $path.resize] \ 146 [Widget::subcget $path .resize] \ 147 [list -borderwidth 0 -relief flat -anchor se \ 148 -cursor $cursor -anchor se -padx 0 -pady 0]] 149 if {$HaveMarlett} { 150 $resize configure -font "Marlett -16" -text \u006f 151 } else { 152 $resize configure -image ::StatusBar::resizer 153 } 154 bindtags $resize [list all [winfo toplevel $path] StatusResize $resize] 155 156 if {[BWidget::using ttk]} { 157 set fsep [ttk::separator $path.hsep -orient horizontal] 158 } else { 159 set fsep [eval [list frame $path.hsep -bd 1 -height 2 -relief sunken] \ 160 [Widget::subcget $path .hsep]] 161 } 162 set sep [_sep $path sepresize {}] 163 164 grid $fsep -row 0 -column 0 -columnspan 3 -sticky ew 165 grid $sbar -row 1 -column 0 -sticky news 166 grid $sep -row 1 -column 1 -sticky ns -padx $ipadx -pady $ipady 167 grid $resize -row 1 -column 2 -sticky news 168 grid columnconfigure $path 0 -weight 1 169 if {![Widget::cget $path -showseparator]} { 170 grid remove $fsep 171 } 172 if {![Widget::cget $path -showresize]} { 173 grid remove $sep $resize 174 } elseif {![Widget::cget $path -showresizesep]} { 175 grid remove $sep 176 } 177 set _widget($path,items) {} 178 179 return [Widget::create StatusBar $path] 180} 181 182 183# ------------------------------------------------------------------------ 184# Command StatusBar::configure 185# ------------------------------------------------------------------------ 186proc StatusBar::configure { path args } { 187 variable _widget 188 189 set res [Widget::configure $path $args] 190 191 foreach {chshow chshowrsep chshowsep chipad chpad} \ 192 [Widget::hasChangedX $path -showresize -showresizesep -showseparator \ 193 -ipad -pad] { break } 194 195 if {$chshow} { 196 set show [Widget::cget $path -showresize] 197 set showrsep [Widget::cget $path -showresizesep] 198 if {$show} { 199 if {$showrsep} { 200 grid $path.sepresize 201 } 202 grid $path.resize 203 } else { 204 grid remove $path.sepresize $path.resize 205 } 206 } 207 if {$chshowsep} { 208 if {$show} { 209 grid $path.hsep 210 } else { 211 grid remove $path.hsep 212 } 213 } 214 if {$chipad} { 215 foreach {ipadx ipady} [_padval [Widget::cget $path -ipad]] { break } 216 foreach w [grid slaves $path.sbar] { 217 grid configure $w -padx $ipadx -pady $ipady 218 } 219 } 220 if {$chpad} { 221 foreach {padx pady} [_padval [Widget::cget $path -pad]] { break } 222 if {[string equal [winfo class $path.sbar] "TFrame"]} { 223 $path.sbar configure -padding [list $padx $pady] 224 } else { 225 $path.sbar configure -padx $padx -pady $pady 226 } 227 } 228 return $res 229} 230 231 232# ------------------------------------------------------------------------ 233# Command StatusBar::cget 234# ------------------------------------------------------------------------ 235proc StatusBar::cget { path option } { 236 return [Widget::cget $path $option] 237} 238 239# ------------------------------------------------------------------------ 240# Command StatusBar::getframe 241# ------------------------------------------------------------------------ 242proc StatusBar::getframe {path} { 243 # This is the frame that users should place their statusbar widgets in 244 return $path.sbar 245} 246 247# ------------------------------------------------------------------------ 248# Command StatusBar::add 249# ------------------------------------------------------------------------ 250proc StatusBar::add {path w args} { 251 variable _widget 252 253 array set opts [list \ 254 -weight 0 \ 255 -separator 1 \ 256 -sticky news \ 257 -pad [Widget::cget $path -ipad] \ 258 ] 259 foreach {key val} $args { 260 if {[info exists opts($key)]} { 261 set opts($key) $val 262 } else { 263 set msg "unknown option \"$key\", must be one of: " 264 append msg [join [lsort [array names opts]] {, }] 265 return -code error $msg 266 } 267 } 268 foreach {ipadx ipady} [_padval $opts(-pad)] { break } 269 270 set sbar $path.sbar 271 foreach {cols rows} [grid size $sbar] break 272 # Add separator if requested, and we aren't the first element 273 if {$opts(-separator) && $cols != 0} { 274 set sep [_sep $path sep[winfo name $w]] 275 # only append name, to distinguish us from them 276 lappend _widget($path,items) [winfo name $sep] 277 grid $sep -in $sbar -row 0 -column $cols \ 278 -sticky ns -padx $ipadx -pady $ipady 279 incr cols 280 } 281 282 lappend _widget($path,items) $w 283 grid $w -in $sbar -row 0 -column $cols -sticky $opts(-sticky) \ 284 -padx $ipadx -pady $ipady 285 grid columnconfigure $sbar $cols -weight $opts(-weight) 286 287 return $w 288} 289 290# ------------------------------------------------------------------------ 291# Command StatusBar::delete 292# ------------------------------------------------------------------------ 293proc StatusBar::remove {path args} { 294 variable _widget 295 296 set destroy [string equal [lindex $args 0] "-destroy"] 297 if {$destroy} { 298 set args [lrange $args 1 end] 299 } 300 foreach w $args { 301 set idx [lsearch -exact $_widget($path,items) $w] 302 if {$idx == -1 || ![winfo exists $w]} { 303 # ignore unknown or non-widget items (like our separators) 304 continue 305 } 306 # separator is always previous item 307 set sidx [expr {$idx - 1}] 308 set sep [lindex $_widget($path,items) $sidx] 309 if {[string match .* $sep]} { 310 # not one of our separators 311 incr sidx 312 } elseif {$sep != ""} { 313 # destroy separator too 314 set sep $path.sbar.$sep 315 destroy $sep 316 } 317 if {$destroy} { 318 destroy $w 319 } else { 320 grid forget $w 321 } 322 if {$idx == 0} { 323 # separator of next item is no longer necessary 324 set sep [lindex $_widget($path,items) [expr {$idx + 1}]] 325 if {$sep != "" && ![string match .* $sep]} { 326 incr idx 327 set sep $path.sbar.$sep 328 destroy $sep 329 } 330 } 331 set _widget($path,items) [lreplace $_widget($path,items) $sidx $idx] 332 } 333} 334 335# ------------------------------------------------------------------------ 336# Command StatusBar::delete 337# ------------------------------------------------------------------------ 338proc StatusBar::delete {path args} { 339 return [StatusBar::remove $path -destroy $args] 340} 341 342# ------------------------------------------------------------------------ 343# Command StatusBar::items 344# ------------------------------------------------------------------------ 345proc StatusBar::items {path} { 346 variable _widget 347 return $_widget($path,items) 348} 349 350proc StatusBar::_sep {path name {sub .sbar}} { 351 if {[BWidget::using ttk]} { 352 return [ttk::separator $path$sub.$name -orient vertical] 353 } else { 354 return [frame $path$sub.$name -bd 1 -width 2 -relief sunken] 355 } 356} 357 358proc StatusBar::_padval {padval} { 359 set len [llength $padval] 360 foreach {a b} $padval { break } 361 if {$len == 0 || $len > 2} { 362 return -code error \ 363 "invalid pad value \"$padval\", must be 1 or 2 pixel values" 364 } elseif {$len == 1} { 365 return [list $a $a] 366 } elseif {$len == 2} { 367 return $padval 368 } 369} 370 371# ------------------------------------------------------------------------ 372# Command StatusBar::_destroy 373# ------------------------------------------------------------------------ 374proc StatusBar::_destroy { path } { 375 variable _widget 376 variable resize 377 array unset widget $path,* 378 array unset resize $path.resize,* 379 Widget::destroy $path 380} 381 382# The following proc handles the mouse click on the resize control. It stores 383# the original size of the window and the initial coords of the mouse relative 384# to the root. 385 386proc StatusBar::begin_resize {w rootx rooty} { 387 variable resize 388 set t [winfo toplevel $w] 389 set relx [expr {$rootx - [winfo rootx $t]}] 390 set rely [expr {$rooty - [winfo rooty $t]}] 391 set resize($w,x) $relx 392 set resize($w,y) $rely 393 set resize($w,w) [winfo width $t] 394 set resize($w,h) [winfo height $t] 395 set resize($w,winc) 1 396 set resize($w,hinc) 1 397 set resize($w,grid) [wm grid $t] 398} 399 400# The following proc handles mouse motion on the resize control by asking the 401# wm to adjust the size of the window. 402 403proc StatusBar::continue_resize {w rootx rooty} { 404 variable resize 405 if {[llength $resize($w,grid)]} { 406 # at this time, we don't know how to handle gridded resizing 407 return 408 } 409 set t [winfo toplevel $w] 410 set relx [expr {$rootx - [winfo rootx $t]}] 411 set rely [expr {$rooty - [winfo rooty $t]}] 412 set width [expr {$relx - $resize($w,x) + $resize($w,w)}] 413 set height [expr {$rely - $resize($w,y) + $resize($w,h)}] 414 if {$width < 0} { set width 0 } 415 if {$height < 0} { set height 0 } 416 wm geometry $t ${width}x${height} 417 418 if {[string equal $::tcl_platform(platform) "windows"]} { 419 update idletasks 420 } 421} 422 423# The following proc cleans up when the user releases the mouse button. 424 425proc StatusBar::end_resize {w rootx rooty} { 426 variable resize 427 #continue_resize $w $rootx $rooty 428 #wm grid $t $resize($w,grid) 429 array unset resize $w,* 430} 431