1# -*- tcl -*- 2# 3# statusbar.tcl - 4# Create a status bar Tk widget 5# 6# RCS: @(#) $Id: statusbar.tcl,v 1.8 2010/06/01 18:06:52 hobbs Exp $ 7# 8 9# Creation and Options - widget::scrolledwindow $path ... 10# 11# -separator -default 1 ; show horizontal separator on top of statusbar 12# -resize -default 1 ; show resize control on bottom right 13# -resizeseparator -default 1 ; show separator for resize control 14# ## Padding can be a list of {padx pady} 15# -ipad -default 1 ; provides padding around each status bar item 16# -pad -default 0 ; provides general padding around the status bar 17# 18# All other options to frame 19# 20# Methods 21# $path getframe => $frame 22# $path add $widget ?args? => $widget 23# All other methods to frame 24# 25# Bindings 26# NONE 27# 28# Provides a status bar to be placed at the bottom of a toplevel. 29# Currently does not support being placed in a toplevel that has 30# gridding applied (via widget -setgrid or wm grid). 31# 32# Ensure that the widget is placed at the very bottom of the toplevel, 33# otherwise the resize behavior may behave oddly. 34# 35 36package require widget 37 38if {0} { 39 proc sample {} { 40 # sample usage 41 eval destroy [winfo children .] 42 pack [text .t -width 0 -height 0] -fill both -expand 1 43 44 set sbar .s 45 widget::statusbar $sbar 46 pack $sbar -side bottom -fill x 47 set f [$sbar getframe] 48 49 # Specify -width 1 for the label widget so it truncates nicely 50 # instead of requesting large sizes for long messages 51 set w [label $f.status -width 1 -anchor w -textvariable ::STATUS] 52 set ::STATUS "This is a status message" 53 # give the entry weight, as we want it to be the one that expands 54 $sbar add $w -weight 1 55 56 # BWidget's progressbar 57 set w [ProgressBar $f.bpbar -orient horizontal \ 58 -variable ::PROGRESS -bd 1 -relief sunken] 59 set ::PROGRESS 50 60 $sbar add $w 61 } 62} 63 64snit::widget widget::statusbar { 65 hulltype ttk::frame 66 67 component resizer 68 component separator 69 component sepresize 70 component frame 71 72 # -background, -borderwidth and -relief apply to outer frame, but relief 73 # should be left flat for proper look 74 delegate option * to hull 75 delegate method * to hull 76 77 option -separator -default 1 -configuremethod C-separator \ 78 -type [list snit::boolean] 79 option -resize -default 1 -configuremethod C-resize \ 80 -type [list snit::boolean] 81 option -resizeseparator -default 1 -configuremethod C-resize \ 82 -type [list snit::boolean] 83 # -pad provides general padding around the status bar 84 # -ipad provides padding around each status bar item 85 # Padding can be a list of {padx pady} 86 option -ipad -default 2 -configuremethod C-ipad \ 87 -type [list snit::listtype -type {snit::integer} -minlen 1 -maxlen 4] 88 delegate option -pad to frame as -padding 89 90 variable ITEMS -array {} 91 variable uid 0 92 93 constructor args { 94 $hull configure -height 18 95 96 install frame using ttk::frame $win.frame 97 98 install resizer using ttk::sizegrip $win.resizer 99 100 install separator using ttk::separator $win.separator \ 101 -orient horizontal 102 103 install sepresize using ttk::separator $win.sepresize \ 104 -orient vertical 105 106 grid $separator -row 0 -column 0 -columnspan 3 -sticky ew 107 grid $frame -row 1 -column 0 -sticky news 108 grid $sepresize -row 1 -column 1 -sticky ns;# -padx $ipadx -pady $ipady 109 grid $resizer -row 1 -column 2 -sticky se 110 grid columnconfigure $win 0 -weight 1 111 112 $self configurelist $args 113 } 114 115 method C-ipad {option value} { 116 set options($option) $value 117 # returns pad values - each will be a list of 2 ints 118 foreach {px py} [$self _padval $value] { break } 119 foreach w [grid slaves $frame] { 120 if {[string match _sep* $w]} { 121 grid configure $w -padx $px -pady 0 122 } else { 123 grid configure $w -padx $px -pady $py 124 } 125 } 126 } 127 128 method C-separator {option value} { 129 set options($option) $value 130 if {$value} { 131 grid $separator 132 } else { 133 grid remove $separator 134 } 135 } 136 137 method C-resize {option value} { 138 set options($option) $value 139 if {$options(-resize)} { 140 if {$options(-resizeseparator)} { 141 grid $sepresize 142 } 143 grid $resizer 144 } else { 145 grid remove $sepresize $resizer 146 } 147 } 148 149 # Use this or 'add' - but not both 150 method getframe {} { return $frame } 151 152 method add {what args} { 153 if {[winfo exists $what]} { 154 set w $what 155 set symbol $w 156 set ours 0 157 } else { 158 set w $frame._$what[incr uid] 159 set symbol [lindex $args 0] 160 set args [lrange $args 1 end] 161 if {![llength $args] || $symbol eq "%AUTO%"} { 162 # Autogenerate symbol name 163 set symbol _$what$uid 164 } 165 if {[info exists ITEMS($symbol)]} { 166 return -code error "item '$symbol' already exists" 167 } 168 if {$what eq "label" || $what eq "button" 169 || $what eq "checkbutton" || $what eq "radiobutton"} { 170 set w [ttk::$what $w -style Toolbutton -takefocus 0] 171 } elseif {$what eq "separator"} { 172 set w [ttk::separator $w -orient vertical] 173 } elseif {$what eq "space"} { 174 set w [ttk::frame $w] 175 } else { 176 return -code error "unknown item type '$what'" 177 } 178 set ours 1 179 } 180 set opts(-weight) [string equal $what "space"] 181 set opts(-separator) 0 182 set opts(-sticky) news 183 set opts(-pad) $options(-ipad) 184 if {$what eq "separator"} { 185 # separators should not have pady by default 186 lappend opts(-pad) 0 187 } 188 set cmdargs [list] 189 set len [llength $args] 190 for {set i 0} {$i < $len} {incr i} { 191 set key [lindex $args $i] 192 set val [lindex $args [incr i]] 193 if {$key eq "--"} { 194 eval [list lappend cmdargs] [lrange $args $i end] 195 break 196 } 197 if {[info exists opts($key)]} { 198 set opts($key) $val 199 } else { 200 # no error - pass to command 201 lappend cmdargs $key $val 202 } 203 } 204 if {[catch {eval [linsert $cmdargs 0 $w configure]} err]} { 205 # we only want to destroy widgets we created 206 if {$ours} { destroy $w } 207 return -code error $err 208 } 209 set ITEMS($symbol) $w 210 widget::isa listofint 4 -pad $opts(-pad) 211 # returns pad values - each will be a list of 2 ints 212 foreach {px py} [$self _padval $opts(-pad)] { break } 213 214 # get cols,rows extent 215 foreach {cols rows} [grid size $frame] break 216 # Add separator if requested, and we aren't the first element 217 if {$opts(-separator) && $cols != 0} { 218 set sep [ttk::separator $frame._sep[winfo name $w] \ 219 -orient vertical] 220 # No pady for separators, and adjust padx for separator space 221 set sx $px 222 if {[lindex $sx 0] < 2} { lset sx 0 2 } 223 lset px 1 0 224 grid $sep -row 0 -column $cols -sticky ns -padx $sx -pady 0 225 incr cols 226 } 227 228 grid $w -in $frame -row 0 -column $cols -sticky $opts(-sticky) \ 229 -padx $px -pady $py 230 grid columnconfigure $frame $cols -weight $opts(-weight) 231 232 return $symbol 233 } 234 235 method remove {args} { 236 set destroy [string equal [lindex $args 0] "-destroy"] 237 if {$destroy} { 238 set args [lrange $args 1 end] 239 } 240 foreach sym $args { 241 # Should we ignore unknown (possibly already removed) items? 242 #if {![info exists ITEMS($sym)]} { continue } 243 set w $ITEMS($sym) 244 # separator name is based off item name 245 set sep $frame._sep[winfo name $w] 246 # destroy separator for remove or destroy case 247 destroy $sep 248 if {$destroy} { 249 destroy $w 250 } else { 251 grid forget $w 252 } 253 unset ITEMS($sym) 254 } 255 } 256 257 method delete {args} { 258 eval [linsert $args 0 $self remove -destroy] 259 } 260 261 method items {{ptn *}} { 262 # return from ordered list 263 if {$ptn ne "*"} { 264 return [array names ITEMS $ptn] 265 } 266 return [array names ITEMS] 267 } 268 269 method _padval {val} { 270 set len [llength $val] 271 if {$len == 0} { 272 return [list 0 0 0 0] 273 } elseif {$len == 1} { 274 return [list [list $val $val] [list $val $val]] 275 } elseif {$len == 2} { 276 set x [lindex $val 0] ; set y [lindex $val 1] 277 return [list [list $x $x] [list $y $y]] 278 } elseif {$len == 3} { 279 return [list [list [lindex $val 0] [lindex $val 2]] \ 280 [list [lindex $val 1] [lindex $val 1]]] 281 } else { 282 return $val 283 } 284 } 285} 286 287package provide widget::statusbar 1.2.1 288