1## Paned Window Procs inspired by code by Stephen Uhler @ Sun. 2## Thanks to John Ellson (ellson@lucent.com) for bug reports & code ideas. 3## 4## Copyright 1996-1997 Jeffrey Hobbs, jeff.hobbs@acm.org 5## 6## Modified by Kish Shen, Jan 1999, to allow specification of initial relative 7## sizes of windows 8package provide Pane 1.0 9 10##------------------------------------------------------------------ 11## PROCEDURE 12## pane 13## 14## DESCRIPTION 15## paned window management function 16## 17## METHODS 18## 19## pane configure <widget> ?<widget> ...? ?<option> <value>? 20## pane <widget> ?<widget> ...? ?<option> <value>? 21## Sets up the management of the named widgets as paned windows. 22## 23## OPTIONS 24## -dynamic Whether to dynamically resize or to resize only 25## when the user lets go of the handle 26## -orient Orientation of window to determing tiling. 27## Can be either horizontal (default) or vertical. 28## -parent A master widget to use for the slaves. 29## Defaults to the parent of the first widget. 30## -handlelook Options to pass to the handle during 'frame' creation. 31## -handleplace Options to pass to the handle during 'place'ment. 32## Make sure you know what you're doing. 33## (Added by Kish Shen) 34## -initfrac A list specifying the fractional sizes for all the 35## widgets that are currently managed by this pane. 36## 37## pane forget <master> ?<slave> ...? 38## If called without a slave name, it forgets all slaves and removes 39## all handles, otherwise just removes the named slave(s) and redraws. 40## 41## pane info <slave> 42## Returns the value of [place info <slave>]. 43## 44## pane slaves <master> 45## Returns the slaves currently managed by <master>. 46## 47## pane master <slave> 48## Returns the master currently managing <slave>. 49## 50## BEHAVIORAL NOTES 51## pane is a limited interface to paned window management. Error 52## catching is minimal. When you add more widgets to an already managed 53## parent, all the fractions are recalculated. Handles have the name 54## $parent.__h#, and will be created/destroyed automagically. You must 55## use 'pane forget $parent' to clean up what 'pane' creates, otherwise 56## critical state info about the parent pane will not be deleted. This 57## could support -before/after without too much effort if the desire 58## was there. Because this uses 'place', you have to take the same care 59## to size the parent yourself. 60## 61## VERSION 1.0 62## 63## EXAMPLES AT END OF FILE 64## 65 66proc pane {opt args} { 67 global PANE 68 switch -glob -- $opt { 69 c* { eval pane_config $args } 70 f* { 71 set p [lindex $args 0] 72 if {[info exists PANE($p,w)]} { 73 if {[llength $args]==1} { 74 foreach w $PANE($p,w) { catch {place forget $w} } 75 foreach w [array names PANE $p,*] { unset PANE($w) } 76 if {![catch {winfo children $p} kids]} { 77 foreach w $kids { 78 if {[string match *.__h* $w]} { destroy $w } 79 } 80 } 81 } else { 82 foreach w [lrange $args 1 end] { 83 place forget $w 84 set i [lsearch -exact $PANE($p,w) $w] 85 set PANE($p,w) [lreplace $PANE($p,w) $i $i] 86 } 87 if [llength $PANE($p,w)] { 88 eval pane_config $PANE($p,w) 89 } else { 90 pane forget $p 91 } 92 } 93 } else { 94 95 } 96 } 97 i* { return [place info $args] } 98 s* { 99 if {[info exists PANE($args,w)]} { 100 return $PANE($args,w) 101 } { 102 return {} 103 } 104 } 105 m* { 106 foreach w [array names PANE *,w] { 107 if {[lsearch $PANE($w) $args] != -1} { 108 regexp {([^,]*),w} $w . res 109 return $res 110 } 111 } 112 return -code error \ 113 "no master found. perhaps $args is not a pane slave?" 114 } 115 default { eval pane_config [list $opt] $args } 116 } 117} 118 119## 120## PRIVATE FUNCTIONS 121## 122## I don't advise playing with these because they are slapped together 123## and delicate. I don't recommend calling them directly either. 124## 125 126;proc pane_config args { 127 global PANE 128 array set opt {orn none par {} dyn 0 hpl {} hlk {} initf {} } 129 set wids {} 130 for {set i 0;set num [llength $args];set cargs {}} {$i<$num} {incr i} { 131 set arg [lindex $args $i] 132 if [winfo exists $arg] { lappend wids $arg; continue } 133 set val [lindex $args [incr i]] 134 switch -glob -- $arg { 135 -d* { set opt(dyn) [regexp -nocase {^(1|yes|true|on)$} $val] } 136 -o* { set opt(orn) $val } 137 -p* { set opt(par) $val } 138 -handlep* { set opt(hpl) $val } 139 -handlel* { set opt(hlk) $val } 140 -initfrac { set opt(initf) $val } 141 default { return -code error "unknown option \"$arg\"" } 142 } 143 } 144 if {[string match {} $wids]} { 145 return -code error "no widgets specified to configure" 146 } 147 if {[string compare {} $opt(par)]} { 148 set p $opt(par) 149 } else { 150 set p [winfo parent [lindex $wids 0]] 151 } 152 if {[string match none $opt(orn)]} { 153 if {![info exists PANE($p,o)]} { set PANE($p,o) h } 154 } else { 155 set PANE($p,o) $opt(orn) 156 } 157 if {[string match h* $PANE($p,o)]} { 158 set owh height; set wh width; set xy x; set hv h 159 } else { 160 set owh width; set wh height; set xy y; set hv v 161 } 162 if ![info exists PANE($p,w)] { set PANE($p,w) {} } 163 foreach w [winfo children $p] { 164 if {[string match *.__h* $w]} { destroy $w } 165 } 166 foreach w $wids { 167 set i [lsearch -exact $PANE($p,w) $w] 168 if {$i<0} { lappend PANE($p,w) $w } 169 } 170 set ll [llength $PANE($p,w)] 171 set frac [expr {1.0/$ll}] 172 set pos 0.0 173 array set hndconf $opt(hlk) 174 if {![info exists hndconf(-$wh)]} { 175 set hndconf(-$wh) 4 176 } 177 set idx -1 178 foreach w $PANE($p,w) { 179 incr idx 1 180 place forget $w 181 if {[string match $opt(initf) {}] || (\ 182 [llength $PANE($p,w)] != [llength $opt(initf)]) } { 183 set relfrac $frac 184 } else { 185 set relfrac [lindex $opt(initf) $idx] 186 } 187 place $w -in $p -rel$owh 1 -rel$xy $pos -$wh -$hndconf(-$wh) \ 188 -rel$wh $relfrac -anchor nw 189 raise $w 190 set pos [expr $pos+$relfrac] 191 } 192 place $w -$wh 0 193 while {[incr ll -1]} { 194 if {[string match $opt(initf) {}] || (\ 195 [llength $PANE($p,w)] != [llength $opt(initf)]) } { 196 set relfrac [expr $frac*$ll] 197 } else { 198 set relfrac [sumlistfront $opt(initf) [expr $ll -1]] 199 } 200 set h [eval frame [list $p.__h$ll] -bd 2 -relief sunken \ 201 -cursor sb_${hv}_double_arrow [array get hndconf]] 202 eval place [list $h] -rel$owh 1 -rel$xy $relfrac \ 203 -$xy -$hndconf(-$wh) -anchor nw $opt(hpl) 204 raise $h 205 bind $h <ButtonPress-1> "pane_constrain $p $h \ 206 [lindex $PANE($p,w) [expr $ll-1]] [lindex $PANE($p,w) $ll] \ 207 $wh $xy $opt(dyn)" 208 } 209} 210 211;proc pane_constrain {p h w0 w1 wh xy d} { 212 global PANE 213 regexp -- "\-rel$xy (\[^ \]+)" [place info $w0] junk t0 214 regexp -- "\-rel$xy (\[^ \]+).*\-rel$wh (\[^ \]+)" \ 215 [place info $w1] junk t1 t2 216 set offset [expr ($t1+$t2-$t0)/10.0] 217 array set PANE [list XY [winfo root$xy $p] WH [winfo $wh $p].0 \ 218 W0 $w0 W1 $w1 XY0 $t0 XY1 [expr $t1+$t2] \ 219 C0 [expr $t0+$offset] C1 [expr $t1+$t2-$offset]] 220 bind $h <B1-Motion> "pane_motion %[string toup $xy] $p $h $wh $xy $d" 221 if !$d { 222 bind $h <ButtonRelease-1> \ 223 "pane_motion %[string toup $xy] $p $h $wh $xy 1" 224 } 225} 226 227;proc pane_motion {X p h wh xy d} { 228 global PANE 229 set f [expr ($X-$PANE(XY))/$PANE(WH)] 230 if {$f<$PANE(C0)} { set f $PANE(C0) } 231 if {$f>$PANE(C1)} { set f $PANE(C1) } 232 if $d { 233 place $PANE(W0) -rel$wh [expr $f-$PANE(XY0)] 234 place $h -rel$xy $f 235 place $PANE(W1) -rel$wh [expr $PANE(XY1)-$f] -rel$xy $f 236 } else { 237 place $h -rel$xy $f 238 } 239} 240 241;proc sumlistfront {l idx} { 242 set sub [lrange $l 0 $idx] 243 set len [llength $sub] 244 set sum 0 245 for {set i 0} {$i < $len} {incr i 1} { 246 set sum [expr $sum + [lindex $sub $i]] 247 } 248 return $sum 249} 250 251## 252## EXAMPLES 253## 254## These auto-generate for the plugin. Remove these for regular use. 255## 256if {[info exists embed_args]} { 257 ## Hey, super-pane the one toplevel we get! 258 pane [frame .0] [frame .1] 259 ## Use the line below for a good non-plugin example 260 #toplevel .0; toplevel .1 261 pane [listbox .0.0] [listbox .0.1] -dynamic 1 262 pane [frame .1.0] [frame .1.1] -dyn 1 263 pane [listbox .1.0.0] [listbox .1.0.1] [listbox .1.0.2] -orient vertical 264 pack [label .1.1.0 -text "Text widget:"] -fill x 265 pack [text .1.1.1] -fill both -expand 1 266 set i [info procs] 267 foreach w {.0.0 .0.1 .1.0.0 .1.0.1 .1.0.2 .1.1.1} { eval $w insert end $i } 268} 269## Example of use of initfrac: 270## pane $t1 -orient horizontal 271## pane $t2 -orient horizontal 272## pane $t3 -orient horizontal -initfrac [list 0.1 0.2 0.7] 273## or the equivalent in one line: 274## pane $t1 $t2 $t3 -orient horizontal -initfrac [list 0.1 0.2 0.7] 275## 276## 277## END EXAMPLES 278## 279## EOF 280