1# -*- tcl -*- 2# 3# toolbar - /snit::widget 4# Manage items in a toolbar. 5# 6# RCS: @(#) $Id: toolbar.tcl,v 1.12 2010/06/01 18:06:52 hobbs Exp $ 7# 8 9# ## Padding can be a list of {padx pady} 10# -ipad -default 1 ; provides padding around each status bar item 11# -pad -default 0 ; provides general padding around the status bar 12# -separator -default {} ; one of {top left bottom right {}} 13# 14# All other options to frame 15# 16# Methods 17# $path getframe => $frame 18# $path add $widget ?args? => $widget 19# All other methods to frame 20# 21# Bindings 22# NONE 23# 24 25if 0 { 26 # Example 27 lappend auto_path ~/cvs/tcllib/tklib/modules/widget 28 29 package require widget::toolbar 30 set f [ttk::frame .f -padding 4] 31 pack $f -fill both -expand 1 32 set tb [widget::toolbar .f.tb] 33 pack $tb -fill both -expand 1 34 $tb add button foo -text Foo 35 $tb add button bar -text Bar -separator 1 36 $tb add button baz -text Baz 37 set b [ttk::button $tb.zippy -text Zippy -state disabled] 38 $tb add $b 39} 40 41package require widget 42#package require tooltip 43 44snit::widget widget::toolbar { 45 hulltype ttk::frame 46 47 component separator 48 component frame 49 50 delegate option * to hull 51 delegate method * to hull 52 53 option -wrap -default 0 -type [list snit::boolean] 54 option -separator -default {} -configuremethod C-separator \ 55 -type [list snit::enum -values [list top left bottom right {}]] 56 # -pad provides general padding around the status bar 57 # -ipad provides padding around each status bar item 58 # Padding can be a list of {padx pady} 59 option -ipad -default 2 -configuremethod C-ipad \ 60 -type [list snit::listtype -type {snit::integer} -minlen 1 -maxlen 4] 61 delegate option -pad to frame as -padding 62 63 variable ITEMS -array {} 64 variable uid 0 65 66 constructor {args} { 67 $hull configure -height 18 68 69 install frame using ttk::frame $win.frame 70 71 install separator using ttk::separator $win.separator 72 73 grid $frame -row 1 -column 1 -sticky news 74 grid columnconfigure $win 1 -weight 1 75 76 # we should have a <Configure> binding to wrap long toolbars 77 #bind $win <Configure> [mymethod resize [list $win] %w] 78 79 $self configurelist $args 80 } 81 82 method C-ipad {option value} { 83 set options($option) $value 84 # returns pad values - each will be a list of 2 ints 85 foreach {px py} [$self _padval $value] { break } 86 foreach w [grid slaves $frame] { 87 if {[string match _sep* $w]} { 88 grid configure $w -padx $px -pady 0 89 } else { 90 grid configure $w -padx $px -pady $py 91 } 92 } 93 } 94 95 method C-separator {option value} { 96 set options($option) $value 97 switch -exact -- $value { 98 top { 99 $separator configure -orient horizontal 100 grid $separator -row 0 -column 1 -sticky ew 101 } 102 left { 103 $separator configure -orient vertical 104 grid $separator -row 1 -column 0 -sticky ns 105 } 106 bottom { 107 $separator configure -orient horizontal 108 grid $separator -row 2 -column 1 -sticky ew 109 } 110 right { 111 $separator configure -orient vertical 112 grid $separator -row 1 -column 2 -sticky ns 113 } 114 {} { 115 grid remove $separator 116 } 117 } 118 } 119 120 # Use this or 'add' - but not both 121 method getframe {} { return $frame } 122 123 method add {what args} { 124 if {[winfo exists $what]} { 125 set w $what 126 set symbol $w 127 set ours 0 128 } else { 129 set w $frame._$what[incr uid] 130 set symbol [lindex $args 0] 131 set args [lrange $args 1 end] 132 if {![llength $args] || $symbol eq "%AUTO%"} { 133 # Autogenerate symbol name 134 set symbol _$what$uid 135 } 136 if {[info exists ITEMS($symbol)]} { 137 return -code error "item '$symbol' already exists" 138 } 139 if {$what eq "label" || $what eq "button" 140 || $what eq "checkbutton" || $what eq "radiobutton"} { 141 set w [ttk::$what $w -style Toolbutton -takefocus 0] 142 } elseif {$what eq "separator"} { 143 set w [ttk::separator $w -orient vertical] 144 } elseif {$what eq "space"} { 145 set w [ttk::frame $w] 146 } else { 147 return -code error "unknown item type '$what'" 148 } 149 set ours 1 150 } 151 set opts(-weight) [string equal $what "space"] 152 set opts(-separator) 0 153 set opts(-sticky) news 154 set opts(-pad) $options(-ipad) 155 if {$what eq "separator"} { 156 # separators should not have pady by default 157 lappend opts(-pad) 0 158 } 159 set cmdargs [list] 160 set len [llength $args] 161 for {set i 0} {$i < $len} {incr i} { 162 set key [lindex $args $i] 163 set val [lindex $args [incr i]] 164 if {$key eq "--"} { 165 eval [list lappend cmdargs] [lrange $args $i end] 166 break 167 } 168 if {[info exists opts($key)]} { 169 set opts($key) $val 170 } else { 171 # no error - pass to command 172 lappend cmdargs $key $val 173 } 174 } 175 if {[catch {eval [linsert $cmdargs 0 $w configure]} err]} { 176 # we only want to destroy widgets we created 177 if {$ours} { destroy $w } 178 return -code error $err 179 } 180 set ITEMS($symbol) $w 181 widget::isa listofint 4 -pad $opts(-pad) 182 # returns pad values - each will be a list of 2 ints 183 foreach {px py} [$self _padval $opts(-pad)] { break } 184 185 # get cols,rows extent 186 foreach {cols rows} [grid size $frame] break 187 # Add separator if requested, and we aren't the first element 188 if {$opts(-separator) && $cols != 0} { 189 set sep [ttk::separator $frame._sep[winfo name $w] \ 190 -orient vertical] 191 # No pady for separators, and adjust padx for separator space 192 set sx [lindex $px 0] 193 if {$sx < 2} { set sx 2 } 194 lset px 0 0 195 grid $sep -row 0 -column $cols -sticky ns -padx $sx -pady 0 196 incr cols 197 } 198 199 grid $w -in $frame -row 0 -column $cols -sticky $opts(-sticky) \ 200 -pady $py -padx $px 201 grid columnconfigure $frame $cols -weight $opts(-weight) 202 203 return $symbol 204 } 205 206 method remove {args} { 207 set destroy [string equal [lindex $args 0] "-destroy"] 208 if {$destroy} { 209 set args [lrange $args 1 end] 210 } 211 foreach sym $args { 212 # Should we ignore unknown (possibly already removed) items? 213 #if {![info exists ITEMS($sym)]} { continue } 214 set w $ITEMS($sym) 215 # separator name is based off item name 216 set sep $frame._sep[winfo name $w] 217 # destroy separator for remove or destroy case 218 destroy $sep 219 if {$destroy} { 220 destroy $w 221 } else { 222 grid forget $w 223 } 224 unset ITEMS($sym) 225 # XXX separator of next item is no longer necessary, if it exists 226 } 227 } 228 229 method delete {args} { 230 eval [linsert $args 0 $self remove -destroy] 231 } 232 233 method itemconfigure {symbol args} { 234 if {[info exists ITEMS($symbol)]} { 235 # configure exact item 236 return [eval [linsert $args 0 $ITEMS($symbol) configure]] 237 } 238 # configure based on $symbol as a glob pattern 239 set res {} 240 foreach sym [array names ITEMS -glob $symbol] { 241 lappend res \ 242 [catch { eval [linsert $args 0 $ITEMS($sym) configure] } msg] \ 243 $msg 244 } 245 # return something when we can figure out what is good to return 246 #return $res 247 } 248 249 method itemcget {symbol option} { 250 if {![info exists ITEMS($symbol)]} { 251 return -code error "unknown toolbar item '$symbol'" 252 } 253 return [$ITEMS($symbol) cget $option] 254 } 255 256 method itemid {symbol} { 257 if {![info exists ITEMS($symbol)]} { 258 return -code error "unknown toolbar item '$symbol'" 259 } 260 return $ITEMS($symbol) 261 } 262 263 method items {{ptn *}} { 264 if {$ptn ne "*"} { 265 return [array names ITEMS $ptn] 266 } 267 return [array names ITEMS] 268 } 269 270 method _padval {val} { 271 set len [llength $val] 272 if {$len == 0} { 273 return [list 0 0 0 0] 274 } elseif {$len == 1} { 275 return [list [list $val $val] [list $val $val]] 276 } elseif {$len == 2} { 277 set x [lindex $val 0] ; set y [lindex $val 1] 278 return [list [list $x $x] [list $y $y]] 279 } elseif {$len == 3} { 280 return [list [list [lindex $val 0] [lindex $val 2]] \ 281 [list [lindex $val 1] [lindex $val 1]]] 282 } else { 283 return $val 284 } 285 } 286 287 method resize {w width} { 288 if {$w ne $win} { return } 289 if {$width < [winfo reqwidth $win]} { 290 # Take the last column item and move it down 291 } 292 } 293 294} 295 296package provide widget::toolbar 1.2.1 297