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