[11] | 1 | # ---------------------------------------------------------------------- |
---|
| 2 | # COMPONENT: Panes - creates a series of adjustable panes |
---|
| 3 | # |
---|
| 4 | # This is a simple paned window with an adjustable sash. |
---|
| 5 | # the same quantity, but for various ranges of input values. |
---|
| 6 | # It also manages the controls to select and visualize the data. |
---|
| 7 | # ====================================================================== |
---|
| 8 | # AUTHOR: Michael McLennan, Purdue University |
---|
[5044] | 9 | # Copyright (c) 2004-2015 HUBzero Foundation, LLC |
---|
[115] | 10 | # |
---|
| 11 | # See the file "license.terms" for information on usage and |
---|
| 12 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
[11] | 13 | # ====================================================================== |
---|
| 14 | package require Itk |
---|
| 15 | |
---|
| 16 | option add *Panes.width 3i widgetDefault |
---|
| 17 | option add *Panes.height 3i widgetDefault |
---|
[413] | 18 | option add *Panes.sashRelief sunken widgetDefault |
---|
| 19 | option add *Panes.sashWidth 2 widgetDefault |
---|
| 20 | option add *Panes.sashPadding 4 widgetDefault |
---|
[5044] | 21 | option add *Panes.orientation vertical widgetDefault |
---|
[11] | 22 | |
---|
| 23 | itcl::class Rappture::Panes { |
---|
| 24 | inherit itk::Widget |
---|
| 25 | |
---|
[413] | 26 | itk_option define -sashrelief sashRelief SashRelief "" |
---|
| 27 | itk_option define -sashwidth sashWidth SashWidth 0 |
---|
| 28 | itk_option define -sashpadding sashPadding SashPadding 0 |
---|
[5044] | 29 | itk_option define -orientation orientation Orientation "" |
---|
[11] | 30 | |
---|
| 31 | constructor {args} { # defined below } |
---|
| 32 | |
---|
| 33 | public method insert {pos args} |
---|
| 34 | public method pane {pos} |
---|
[5044] | 35 | public method visibility {pos args} |
---|
| 36 | public method fraction {pos args} |
---|
[428] | 37 | public method hilite {state sash} |
---|
[5044] | 38 | public method size {} |
---|
[11] | 39 | |
---|
| 40 | protected method _grab {pane X Y} |
---|
| 41 | protected method _drag {pane X Y} |
---|
| 42 | protected method _drop {pane X Y} |
---|
| 43 | protected method _fixLayout {args} |
---|
[413] | 44 | protected method _fixSashes {args} |
---|
[11] | 45 | |
---|
| 46 | private variable _dispatcher "" ;# dispatcher for !events |
---|
| 47 | private variable _panes "" ;# list of pane frames |
---|
[785] | 48 | private variable _visibility "" ;# list of visibilities for panes |
---|
[11] | 49 | private variable _counter 0 ;# counter for auto-generated names |
---|
[5044] | 50 | private variable _reqfrac 0.0 ;# requested fraction size of each pane |
---|
| 51 | private variable _dragfrom 0 ;# starting coordinate of drag operation |
---|
| 52 | private variable _dragfrac 0 ;# limit on fraction of drag operation |
---|
[11] | 53 | } |
---|
| 54 | |
---|
| 55 | itk::usual Panes { |
---|
[5044] | 56 | keep -background -cursor -sashwidth -sashrelief |
---|
[11] | 57 | } |
---|
| 58 | |
---|
| 59 | # ---------------------------------------------------------------------- |
---|
| 60 | # CONSTRUCTOR |
---|
| 61 | # ---------------------------------------------------------------------- |
---|
| 62 | itcl::body Rappture::Panes::constructor {args} { |
---|
| 63 | itk_option add hull.width hull.height |
---|
| 64 | |
---|
| 65 | # create a dispatcher for events |
---|
| 66 | Rappture::dispatcher _dispatcher |
---|
| 67 | $_dispatcher register !layout |
---|
| 68 | $_dispatcher dispatch $this !layout [itcl::code $this _fixLayout] |
---|
[413] | 69 | $_dispatcher register !sashes |
---|
| 70 | $_dispatcher dispatch $this !sashes [itcl::code $this _fixSashes] |
---|
[11] | 71 | |
---|
| 72 | # fix the layout whenever the window size changes |
---|
| 73 | bind Panes <Configure> [itcl::code %W _fixLayout] |
---|
| 74 | |
---|
| 75 | set pname "pane[incr _counter]" |
---|
| 76 | itk_component add $pname { |
---|
[1929] | 77 | frame $itk_interior.$pname |
---|
[11] | 78 | } |
---|
| 79 | |
---|
| 80 | lappend _panes $pname |
---|
[785] | 81 | lappend _visibility 1 |
---|
[5044] | 82 | set _reqfrac 0.5 |
---|
[11] | 83 | |
---|
| 84 | eval itk_initialize $args |
---|
| 85 | |
---|
| 86 | # make sure we fix up the layout at some point |
---|
| 87 | $_dispatcher event -idle !layout |
---|
| 88 | } |
---|
| 89 | |
---|
| 90 | # ---------------------------------------------------------------------- |
---|
| 91 | # USAGE: insert <pos> ?-fraction f? |
---|
| 92 | # |
---|
| 93 | # Adds a new page to this widget at the given position <pos>. |
---|
| 94 | # ---------------------------------------------------------------------- |
---|
| 95 | itcl::body Rappture::Panes::insert {pos args} { |
---|
| 96 | Rappture::getopts args params { |
---|
[1929] | 97 | value -fraction 0.5 |
---|
[11] | 98 | } |
---|
| 99 | if {[llength $args] > 0} { |
---|
[1929] | 100 | error "wrong # args: should be \"insert pos ?-fraction f?\"" |
---|
[11] | 101 | } |
---|
| 102 | |
---|
| 103 | set pname "pane[incr _counter]" |
---|
| 104 | set sash "${pname}sash" |
---|
| 105 | itk_component add $sash { |
---|
[1929] | 106 | frame $itk_interior.$sash |
---|
[11] | 107 | } { |
---|
[1929] | 108 | usual |
---|
[5044] | 109 | ignore -cursor |
---|
[11] | 110 | } |
---|
[428] | 111 | bind $itk_component($sash) <Enter> [itcl::code $this hilite on $sash] |
---|
| 112 | bind $itk_component($sash) <Leave> [itcl::code $this hilite off $sash] |
---|
[11] | 113 | |
---|
| 114 | itk_component add ${sash}ridge { |
---|
[1929] | 115 | frame $itk_component($sash).ridge |
---|
[11] | 116 | } { |
---|
[1929] | 117 | usual |
---|
| 118 | rename -relief -sashrelief sashRelief SashRelief |
---|
| 119 | ignore -borderwidth |
---|
[11] | 120 | } |
---|
[5044] | 121 | if {$itk_option(-orientation) eq "vertical"} { |
---|
[1929] | 122 | pack $itk_component(${sash}ridge) -fill x |
---|
[5044] | 123 | $itk_component($sash) configure -cursor sb_v_double_arrow |
---|
| 124 | $itk_component(${sash}ridge) configure -cursor sb_v_double_arrow |
---|
[1373] | 125 | } else { |
---|
[1929] | 126 | pack $itk_component(${sash}ridge) -fill y -side left |
---|
[5044] | 127 | $itk_component($sash) configure -cursor sb_h_double_arrow |
---|
| 128 | $itk_component(${sash}ridge) configure -cursor sb_h_double_arrow |
---|
[1373] | 129 | } |
---|
[11] | 130 | foreach comp [list $sash ${sash}ridge] { |
---|
[1929] | 131 | bind $itk_component($comp) <ButtonPress-1> \ |
---|
| 132 | [itcl::code $this _grab $pname %X %Y] |
---|
| 133 | bind $itk_component($comp) <B1-Motion> \ |
---|
| 134 | [itcl::code $this _drag $pname %X %Y] |
---|
| 135 | bind $itk_component($comp) <ButtonRelease-1> \ |
---|
| 136 | [itcl::code $this _drop $pname %X %Y] |
---|
[11] | 137 | } |
---|
| 138 | |
---|
| 139 | |
---|
| 140 | itk_component add $pname { |
---|
[1929] | 141 | frame $itk_interior.$pname |
---|
[11] | 142 | } |
---|
[785] | 143 | set _panes [linsert $_panes $pos $pname] |
---|
| 144 | set _visibility [linsert $_visibility $pos 1] |
---|
[5044] | 145 | set _reqfrac [linsert $_reqfrac $pos $params(-fraction)] |
---|
[11] | 146 | |
---|
[413] | 147 | # fix sash characteristics |
---|
| 148 | $_dispatcher event -idle !sashes |
---|
| 149 | |
---|
[11] | 150 | # make sure we fix up the layout at some point |
---|
| 151 | $_dispatcher event -idle !layout |
---|
| 152 | |
---|
| 153 | return $itk_component($pname) |
---|
| 154 | } |
---|
| 155 | |
---|
| 156 | # ---------------------------------------------------------------------- |
---|
| 157 | # USAGE: pane <pos> |
---|
| 158 | # |
---|
| 159 | # Returns the frame representing the pane at position <pos>. |
---|
| 160 | # ---------------------------------------------------------------------- |
---|
| 161 | itcl::body Rappture::Panes::pane {pos} { |
---|
| 162 | set pname [lindex $_panes $pos] |
---|
| 163 | if {[info exists itk_component($pname)]} { |
---|
[1929] | 164 | return $itk_component($pname) |
---|
[11] | 165 | } |
---|
| 166 | return "" |
---|
| 167 | } |
---|
| 168 | |
---|
| 169 | # ---------------------------------------------------------------------- |
---|
[5044] | 170 | # USAGE: visibility <pos> ?<newval>? ?<pos> <newval> ...? |
---|
[785] | 171 | # |
---|
| 172 | # Clients use this to get/set the visibility of the pane at position |
---|
[5044] | 173 | # <pos>. Can also be used to set the visibility for multiple panes |
---|
| 174 | # if multiple <pos>/<newval> pairs are specified in the same command. |
---|
[785] | 175 | # ---------------------------------------------------------------------- |
---|
[5044] | 176 | itcl::body Rappture::Panes::visibility {pos args} { |
---|
| 177 | if {[llength $args] == 0} { |
---|
[1929] | 178 | return [lindex $_visibility $pos] |
---|
[785] | 179 | } |
---|
[5044] | 180 | if {[llength $args] % 2 == 0} { |
---|
| 181 | error "wrong # args: should be \"visibility pos ?val pos val ...?\"" |
---|
[785] | 182 | } |
---|
[5044] | 183 | |
---|
| 184 | set args [linsert $args 0 $pos] |
---|
| 185 | foreach {pos newval} $args { |
---|
| 186 | if {![string is boolean -strict $newval]} { |
---|
| 187 | error "bad value \"$newval\": should be boolean" |
---|
| 188 | } |
---|
| 189 | if {$pos eq "end" || ($pos >= 0 && $pos < [llength $_visibility])} { |
---|
| 190 | set _visibility [lreplace $_visibility $pos $pos [expr {$newval}]] |
---|
| 191 | $_dispatcher event -idle !layout |
---|
| 192 | } else { |
---|
| 193 | error "bad index \"$pos\": out of range" |
---|
| 194 | } |
---|
[785] | 195 | } |
---|
| 196 | } |
---|
| 197 | |
---|
| 198 | # ---------------------------------------------------------------------- |
---|
[5044] | 199 | # USAGE: fraction <pos> ?<newval>? ?<pos> <newval> ...? |
---|
[11] | 200 | # |
---|
| 201 | # Clients use this to get/set the fraction of real estate associated |
---|
[5044] | 202 | # with the pane at position <pos>. Can also be used to set the |
---|
| 203 | # fractions for multiple panes if multiple <pos>/<newval> pairs |
---|
| 204 | # are specified in the same command. |
---|
[11] | 205 | # ---------------------------------------------------------------------- |
---|
[5044] | 206 | itcl::body Rappture::Panes::fraction {pos args} { |
---|
| 207 | if {[llength $args] == 0} { |
---|
| 208 | return [lindex $_reqfrac $pos] |
---|
[11] | 209 | } |
---|
[5044] | 210 | if {[llength $args] % 2 == 0} { |
---|
| 211 | error "wrong # args: should be \"fraction pos ?val pos val ...?\"" |
---|
[11] | 212 | } |
---|
[5044] | 213 | |
---|
| 214 | set args [linsert $args 0 $pos] |
---|
| 215 | foreach {pos newval} $args { |
---|
| 216 | if {![string is double -strict $newval]} { |
---|
| 217 | error "bad value \"$newval\": should be fraction 0-1" |
---|
[1929] | 218 | } |
---|
[5044] | 219 | if {$pos eq "end" || ($pos >= 0 && $pos < [llength $_reqfrac])} { |
---|
| 220 | set _reqfrac [lreplace $_reqfrac $pos $pos $newval] |
---|
| 221 | $_dispatcher event -idle !layout |
---|
| 222 | } else { |
---|
| 223 | error "bad index \"$pos\": out of range" |
---|
[1929] | 224 | } |
---|
[11] | 225 | } |
---|
| 226 | } |
---|
| 227 | |
---|
| 228 | # ---------------------------------------------------------------------- |
---|
[428] | 229 | # USAGE: hilite <state> <sash> |
---|
| 230 | # |
---|
| 231 | # Invoked automatically whenever the user touches a sash. Highlights |
---|
| 232 | # the sash by changing its size or relief. |
---|
| 233 | # ---------------------------------------------------------------------- |
---|
| 234 | itcl::body Rappture::Panes::hilite {state sash} { |
---|
| 235 | switch -- $itk_option(-sashrelief) { |
---|
[5044] | 236 | flat { |
---|
| 237 | if {$state} { |
---|
| 238 | $itk_component(${sash}ridge) configure -background black |
---|
| 239 | } else { |
---|
| 240 | $itk_component(${sash}ridge) configure -background $itk_option(-background) |
---|
| 241 | } |
---|
| 242 | } |
---|
[428] | 243 | sunken { |
---|
[1929] | 244 | if {$state} { |
---|
| 245 | $itk_component(${sash}ridge) configure -relief raised |
---|
| 246 | } else { |
---|
| 247 | $itk_component(${sash}ridge) configure -relief sunken |
---|
| 248 | } |
---|
[428] | 249 | } |
---|
| 250 | raised { |
---|
[1929] | 251 | if {$state} { |
---|
| 252 | $itk_component(${sash}ridge) configure -relief sunken |
---|
| 253 | } else { |
---|
| 254 | $itk_component(${sash}ridge) configure -relief raised |
---|
| 255 | } |
---|
[428] | 256 | } |
---|
| 257 | solid { |
---|
[1929] | 258 | if {$state} { |
---|
| 259 | $itk_component($sash) configure -background black |
---|
| 260 | } else { |
---|
| 261 | $itk_component($sash) configure \ |
---|
| 262 | -background $itk_option(-background) |
---|
| 263 | } |
---|
[428] | 264 | } |
---|
| 265 | } |
---|
| 266 | } |
---|
| 267 | |
---|
| 268 | # ---------------------------------------------------------------------- |
---|
[5044] | 269 | # USAGE: size |
---|
| 270 | # |
---|
| 271 | # Returns the number of panes in this widget. That makes it easier |
---|
| 272 | # to index the various panes, since indices run from 0 to size-1. |
---|
| 273 | # ---------------------------------------------------------------------- |
---|
| 274 | itcl::body Rappture::Panes::size {} { |
---|
| 275 | return [llength $_panes] |
---|
| 276 | } |
---|
| 277 | |
---|
| 278 | # ---------------------------------------------------------------------- |
---|
[11] | 279 | # USAGE: _grab <pane> <X> <Y> |
---|
| 280 | # |
---|
| 281 | # Invoked automatically when the user clicks on a sash, to initiate |
---|
| 282 | # movement. |
---|
| 283 | # ---------------------------------------------------------------------- |
---|
| 284 | itcl::body Rappture::Panes::_grab {pname X Y} { |
---|
[5044] | 285 | set pos [lsearch $_panes $pname] |
---|
| 286 | if {$pos < 0} return |
---|
| 287 | set frac0 [lindex $_reqfrac [expr {$pos-1}]] |
---|
| 288 | set frac1 [lindex $_reqfrac $pos] |
---|
| 289 | set _dragfrac [expr {$frac0+$frac1}] |
---|
| 290 | |
---|
| 291 | if {$itk_option(-orientation) eq "vertical"} { |
---|
| 292 | set _dragfrom $Y |
---|
| 293 | } else { |
---|
| 294 | set _dragfrom $X |
---|
| 295 | } |
---|
[11] | 296 | } |
---|
| 297 | |
---|
| 298 | # ---------------------------------------------------------------------- |
---|
| 299 | # USAGE: _drag <pane> <X> <Y> |
---|
| 300 | # |
---|
| 301 | # Invoked automatically as the user drags a sash, to resize the panes. |
---|
| 302 | # ---------------------------------------------------------------------- |
---|
| 303 | itcl::body Rappture::Panes::_drag {pname X Y} { |
---|
[5044] | 304 | set pos [lsearch $_panes $pname] |
---|
| 305 | if {$pos < 0} return |
---|
| 306 | set frac [lindex $_reqfrac $pos] |
---|
| 307 | |
---|
| 308 | if {$itk_option(-orientation) eq "vertical"} { |
---|
| 309 | set delY [expr {$_dragfrom-$Y}] |
---|
[1929] | 310 | set Ymax [winfo height $itk_component(hull)] |
---|
[5044] | 311 | set delta [expr {double($delY)/$Ymax}] |
---|
| 312 | set frac [expr {$frac + $delta}] |
---|
| 313 | set _dragfrom $Y |
---|
[1373] | 314 | } else { |
---|
[5044] | 315 | set delX [expr {$_dragfrom-$X}] |
---|
[1929] | 316 | set Xmax [winfo width $itk_component(hull)] |
---|
[5044] | 317 | set delta [expr {double($delX)/$Xmax}] |
---|
| 318 | set frac [expr {$frac + $delta}] |
---|
| 319 | set _dragfrom $X |
---|
[1373] | 320 | } |
---|
[5044] | 321 | if {$delta == 0.0} { |
---|
| 322 | return |
---|
| 323 | } |
---|
| 324 | |
---|
| 325 | # set limits so the pane can't get too large or too small |
---|
[11] | 326 | if {$frac < 0.05} { |
---|
[1929] | 327 | set frac 0.05 |
---|
[11] | 328 | } |
---|
[5044] | 329 | if {$frac > $_dragfrac-0.05} { |
---|
| 330 | set frac [expr {$_dragfrac-0.05}] |
---|
[11] | 331 | } |
---|
[5044] | 332 | |
---|
| 333 | # replace the fractions for this pane and the one before it |
---|
| 334 | set prevfrac [expr {$_dragfrac-$frac}] |
---|
| 335 | set _reqfrac [lreplace $_reqfrac [expr {$pos-1}] $pos $prevfrac $frac] |
---|
| 336 | |
---|
| 337 | # normalize all fractions and fix the layout |
---|
[11] | 338 | _fixLayout |
---|
| 339 | |
---|
| 340 | return $frac |
---|
| 341 | } |
---|
| 342 | |
---|
| 343 | # ---------------------------------------------------------------------- |
---|
| 344 | # USAGE: _drop <pane> <X> <Y> |
---|
| 345 | # |
---|
| 346 | # Invoked automatically as the user drops a sash, to resize the panes. |
---|
| 347 | # ---------------------------------------------------------------------- |
---|
| 348 | itcl::body Rappture::Panes::_drop {pname X Y} { |
---|
| 349 | set frac [_drag $pname $X $Y] |
---|
| 350 | } |
---|
| 351 | |
---|
| 352 | # ---------------------------------------------------------------------- |
---|
| 353 | # USAGE: _fixLayout ?<eventArgs>...? |
---|
| 354 | # |
---|
| 355 | # Used internally to update the layout of panes whenever a new pane |
---|
| 356 | # is added or a sash is moved. |
---|
| 357 | # ---------------------------------------------------------------------- |
---|
| 358 | itcl::body Rappture::Panes::_fixLayout {args} { |
---|
[5044] | 359 | # normalize the fractions for all panes to they add to 1.0 |
---|
| 360 | set total 0 |
---|
| 361 | foreach f $_reqfrac v $_visibility { |
---|
| 362 | if {$v && $f > 0} { |
---|
| 363 | set total [expr {$total + $f}] |
---|
| 364 | } |
---|
| 365 | } |
---|
| 366 | if {$total == 0.0} { set total 1 } |
---|
| 367 | |
---|
| 368 | set normfrac "" |
---|
| 369 | foreach f $_reqfrac v $_visibility { |
---|
| 370 | if {$v} { |
---|
| 371 | lappend normfrac [expr {double($f)/$total}] |
---|
| 372 | } else { |
---|
| 373 | lappend normfrac [expr {double($f)/$total}] |
---|
| 374 | } |
---|
| 375 | } |
---|
| 376 | |
---|
| 377 | # note that sash padding can be a single number or different on each side |
---|
| 378 | if {[llength $itk_option(-sashpadding)] == 1} { |
---|
| 379 | set pad [expr {2*$itk_option(-sashpadding)}] |
---|
| 380 | } else { |
---|
| 381 | set pad [expr [join $itk_option(-sashpadding) +]] |
---|
| 382 | } |
---|
| 383 | |
---|
| 384 | if {$itk_option(-orientation) eq "vertical"} { |
---|
[1929] | 385 | set h [winfo height $itk_component(hull)] |
---|
[5044] | 386 | set sh [expr {$itk_option(-sashwidth) + $pad}] |
---|
[785] | 387 | |
---|
[1929] | 388 | set plist "" |
---|
| 389 | set flist "" |
---|
[5044] | 390 | foreach p $_panes f $normfrac v $_visibility { |
---|
[1929] | 391 | set sash ${p}sash |
---|
| 392 | if {$v} { |
---|
| 393 | # this pane is visible -- make room for it |
---|
| 394 | lappend plist $p |
---|
| 395 | lappend flist $f |
---|
| 396 | if {[info exists itk_component($sash)]} { |
---|
[5044] | 397 | set h [expr {$h - $sh}] |
---|
[1929] | 398 | } |
---|
| 399 | } else { |
---|
| 400 | # this pane is not visible -- remove sash |
---|
| 401 | if {[info exists itk_component($sash)]} { |
---|
| 402 | place forget $itk_component($sash) |
---|
| 403 | } |
---|
| 404 | place forget $itk_component($p) |
---|
| 405 | } |
---|
| 406 | } |
---|
[5044] | 407 | |
---|
[1929] | 408 | # lay out the various panes |
---|
| 409 | set y 0 |
---|
| 410 | foreach p $plist f $flist { |
---|
| 411 | set sash ${p}sash |
---|
| 412 | if {[info exists itk_component($sash)]} { |
---|
| 413 | place $itk_component($sash) -y $y -relx 0.5 -anchor n \ |
---|
| 414 | -relwidth 1.0 -height $sh |
---|
| 415 | set y [expr {$y + $sh}] |
---|
| 416 | } |
---|
| 417 | |
---|
| 418 | set ph [expr {$h*$f}] |
---|
| 419 | place $itk_component($p) -y $y -relx 0.5 -anchor n \ |
---|
| 420 | -relwidth 1.0 -height $ph |
---|
| 421 | set y [expr {$y + $ph}] |
---|
| 422 | } |
---|
[1373] | 423 | } else { |
---|
[1929] | 424 | set w [winfo width $itk_component(hull)] |
---|
[5044] | 425 | set sw [expr {$itk_option(-sashwidth) + $pad}] |
---|
[11] | 426 | |
---|
[1929] | 427 | set plist "" |
---|
| 428 | set flist "" |
---|
[5044] | 429 | foreach p $_panes f $normfrac v $_visibility { |
---|
[1929] | 430 | set sash ${p}sash |
---|
| 431 | if {$v} { |
---|
| 432 | # this pane is visible -- make room for it |
---|
| 433 | lappend plist $p |
---|
| 434 | lappend flist $f |
---|
| 435 | if {[info exists itk_component($sash)]} { |
---|
[5044] | 436 | set w [expr {$w - $sw}] |
---|
[1929] | 437 | } |
---|
| 438 | } else { |
---|
| 439 | # this pane is not visible -- remove sash |
---|
| 440 | if {[info exists itk_component($sash)]} { |
---|
| 441 | place forget $itk_component($sash) |
---|
| 442 | } |
---|
| 443 | place forget $itk_component($p) |
---|
| 444 | } |
---|
| 445 | } |
---|
[5044] | 446 | |
---|
[1929] | 447 | # lay out the various panes |
---|
| 448 | set x 0 |
---|
| 449 | foreach p $plist f $flist { |
---|
| 450 | set sash ${p}sash |
---|
| 451 | if {[info exists itk_component($sash)]} { |
---|
| 452 | place $itk_component($sash) -x $x -rely 0.5 -anchor w \ |
---|
| 453 | -relheight 1.0 -width $sw |
---|
| 454 | set x [expr {$x + $sw}] |
---|
| 455 | } |
---|
| 456 | |
---|
| 457 | set pw [expr {$w*$f}] |
---|
| 458 | place $itk_component($p) -x $x -rely 0.5 -anchor w \ |
---|
| 459 | -relheight 1.0 -width $pw |
---|
| 460 | set x [expr {$x + $pw}] |
---|
| 461 | } |
---|
[2744] | 462 | } |
---|
[11] | 463 | } |
---|
[413] | 464 | |
---|
| 465 | # ---------------------------------------------------------------------- |
---|
| 466 | # USAGE: _fixSashes |
---|
| 467 | # |
---|
| 468 | # Used internally to fix the appearance of sashes whenever a new |
---|
| 469 | # sash appears or the controlling configuration options change. |
---|
| 470 | # ---------------------------------------------------------------------- |
---|
| 471 | itcl::body Rappture::Panes::_fixSashes {args} { |
---|
[5044] | 472 | if {$itk_option(-orientation) eq "vertical"} { |
---|
[1929] | 473 | set ht [winfo pixels $itk_component(hull) $itk_option(-sashwidth)] |
---|
| 474 | set bd [expr {$ht/2}] |
---|
| 475 | foreach pane $_panes { |
---|
| 476 | set sash "${pane}sashridge" |
---|
| 477 | if {[info exists itk_component($sash)]} { |
---|
[5044] | 478 | $itk_component($sash) configure -height $ht \ |
---|
| 479 | -borderwidth $bd -relief $itk_option(-sashrelief) |
---|
| 480 | pack $itk_component($sash) -pady $itk_option(-sashpadding) \ |
---|
| 481 | -side top |
---|
[1929] | 482 | } |
---|
| 483 | } |
---|
[1373] | 484 | } else { |
---|
[1929] | 485 | set w [winfo pixels $itk_component(hull) $itk_option(-sashwidth)] |
---|
| 486 | set bd [expr {$w/2}] |
---|
| 487 | foreach pane $_panes { |
---|
| 488 | set sash "${pane}sashridge" |
---|
| 489 | if {[info exists itk_component($sash)]} { |
---|
[5044] | 490 | $itk_component($sash) configure -width $w \ |
---|
| 491 | -borderwidth $bd -relief $itk_option(-sashrelief) |
---|
[1929] | 492 | pack $itk_component($sash) -padx $itk_option(-sashpadding) \ |
---|
| 493 | -side left |
---|
| 494 | } |
---|
| 495 | } |
---|
[413] | 496 | } |
---|
| 497 | } |
---|
| 498 | |
---|
| 499 | # ---------------------------------------------------------------------- |
---|
| 500 | # CONFIGURATION OPTION: -sashrelief |
---|
| 501 | # ---------------------------------------------------------------------- |
---|
| 502 | itcl::configbody Rappture::Panes::sashrelief { |
---|
| 503 | $_dispatcher event -idle !sashes |
---|
| 504 | } |
---|
| 505 | |
---|
| 506 | # ---------------------------------------------------------------------- |
---|
| 507 | # CONFIGURATION OPTION: -sashwidth |
---|
| 508 | # ---------------------------------------------------------------------- |
---|
| 509 | itcl::configbody Rappture::Panes::sashwidth { |
---|
| 510 | $_dispatcher event -idle !sashes |
---|
| 511 | } |
---|
| 512 | |
---|
| 513 | # ---------------------------------------------------------------------- |
---|
| 514 | # CONFIGURATION OPTION: -sashpadding |
---|
| 515 | # ---------------------------------------------------------------------- |
---|
| 516 | itcl::configbody Rappture::Panes::sashpadding { |
---|
[5044] | 517 | set count 0 |
---|
| 518 | foreach val $itk_option(-sashpadding) { |
---|
| 519 | if {![string is integer -strict $val]} { |
---|
| 520 | error "bad padding value \"$val\": should be integer" |
---|
| 521 | } |
---|
| 522 | incr count |
---|
| 523 | } |
---|
| 524 | if {$count < 1 || $count > 2} { |
---|
| 525 | error "bad padding value \"$itk_option(-sashpadding)\": should be \"#\" or \"# #\"" |
---|
| 526 | } |
---|
[413] | 527 | $_dispatcher event -idle !sashes |
---|
| 528 | } |
---|
[5044] | 529 | |
---|
| 530 | # ---------------------------------------------------------------------- |
---|
| 531 | # CONFIGURATION OPTION: -orientation |
---|
| 532 | # ---------------------------------------------------------------------- |
---|
| 533 | itcl::configbody Rappture::Panes::orientation { |
---|
| 534 | foreach pname $_panes { |
---|
| 535 | set sash "${pname}sash" |
---|
| 536 | if {$itk_option(-orientation) eq "vertical"} { |
---|
| 537 | place $itk_component($pname) -x 0 -relx 0.5 -relwidth 1 \ |
---|
| 538 | -y 0 -rely 0 -relheight 0 |
---|
| 539 | |
---|
| 540 | if {[info exists itk_component($sash)]} { |
---|
| 541 | place $itk_component($sash) -x 0 -relx 0.5 -relwidth 1 \ |
---|
| 542 | -y 0 -rely 0 -relheight 0 |
---|
| 543 | $itk_component($sash) configure \ |
---|
| 544 | -cursor sb_v_double_arrow |
---|
| 545 | |
---|
| 546 | pack $itk_component(${sash}ridge) -fill x -side top |
---|
| 547 | $itk_component(${sash}ridge) configure \ |
---|
| 548 | -cursor sb_v_double_arrow |
---|
| 549 | } |
---|
| 550 | } else { |
---|
| 551 | place $itk_component($pname) -y 0 -rely 0.5 -relheight 1 \ |
---|
| 552 | -x 0 -relx 0 -relwidth 0 |
---|
| 553 | |
---|
| 554 | if {[info exists itk_component($sash)]} { |
---|
| 555 | place $itk_component($sash) -y 0 -rely 0.5 -relheight 1 \ |
---|
| 556 | -x 0 -relx 0 -relwidth 0 |
---|
| 557 | $itk_component($sash) configure \ |
---|
| 558 | -cursor sb_h_double_arrow |
---|
| 559 | |
---|
| 560 | pack $itk_component(${sash}ridge) -fill y -side left |
---|
| 561 | $itk_component(${sash}ridge) configure \ |
---|
| 562 | -cursor sb_h_double_arrow |
---|
| 563 | } |
---|
| 564 | } |
---|
| 565 | } |
---|
| 566 | |
---|
| 567 | # fix sash characteristics |
---|
| 568 | $_dispatcher event -idle !sashes |
---|
| 569 | |
---|
| 570 | # make sure we fix up the layout at some point |
---|
| 571 | $_dispatcher event -idle !layout |
---|
| 572 | } |
---|