/[ascend]/trunk/tcltk98/TK/pane.tcl
ViewVC logotype

Contents of /trunk/tcltk98/TK/pane.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (show annotations) (download) (as text)
Sat Nov 13 16:40:11 2004 UTC (17 years ago) by aw0a
File MIME type: text/x-tcl
File size: 15410 byte(s)
try again to commit moving tcl stuff
1 # pane.tcl
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.2 $
6 # Last modified on: $Date: 1998/06/18 15:55:35 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: pane.tcl,v $
9 #
10 # This file is part of the ASCEND Tcl/Tk Interface.
11 #
12 # Copyright (C) 1994-1998 Carnegie Mellon University
13 #
14 # The ASCEND Tcl/Tk Interface is free software; you can redistribute
15 # it and/or modify it under the terms of the GNU General Public
16 # License as published by the Free Software Foundation; either
17 # version 2 of the License, or (at your option) any later version.
18 #
19 # The ASCEND Tcl/Tk Interface is distributed in hope that it will be
20 # useful, but WITHOUT ANY WARRANTY; without even the implied warranty
21 # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License
25 # along with the program; if not, write to the Free Software
26 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the
27 # file named COPYING. COPYING is found in ../compiler.
28
29 # Tcl Version: 8.0
30 # Tk Version: 8.0
31 #----------------------------------------------------------------------------
32
33 # This file contains the functions needed to support Panes
34
35 #----------------------------------------------------------------------------
36
37 #
38 # proc VPane-Bind {root left right {ks 10} {kf 0.85}}
39 #----------------------------------------------------------------------------
40 # Bind an existing window hierarchy to have a moveable division.
41 # The hierarchy should be a root frame with two child frames
42 # splitting the horizontal dimension and a relative height of 1 for both.
43 # can handle more than one hierarchy simultaneously.
44 # Forces divider knob to stay in window.
45 # Brings child frames under control of the placer. leaving any grandchild
46 # frames in whatever geometry manager they originated.
47 # args root - the name of a window under control of the packer or placer
48 # left - the leaf name of the left child window of root
49 # right - the leaf name of the left child window of root
50 # ks - the knob size (points) of the grip square
51 # kf - the fraction of the width of the window.
52 # - the knob will be placed almost at the bottom of the frame (0.90)
53 # $root.f is the knob
54 # eg. VPane-Bind .browser.main_frm parents_box child_box 15 0.85
55 # suggested by Kirk Abbott(inspired by the net) and generalized by Ben Allan
56 # associated procs are named starting with VPane. HPane equivalents are easy.
57 # configurable VPaned(knobcolor)
58 #
59 # kf is the fraction of the total horizontal width where the window should
60 # be split. For example .30 means a smaller left window.
61 # ks is the size of the knob.
62 #----------------------------------------------------------------------------
63 global VPaned
64 set VPaned(knobcolor) white
65 proc VPane-Bind {root left right {ks 10} {kf 0.85} } {
66 global VPaned
67 # make sure anything to be packed has been
68 update idletasks
69 set VPaned($root,left) $root.$left
70 set VPaned($root,right) $root.$right
71 set VPaned($root,knobsize) $ks
72 set VPaned(xdrag_start) [winfo width $root.$left]
73 set VPaned(ydrag_start) [expr $kf * [winfo height $root.$left]]
74 set VPaned(xfraction) $kf
75 if {$VPaned(xfraction) >0.9} {set VPaned(xfraction) 0.33}
76 set VPaned(newxfrac) $VPaned(xfraction)
77 set VPaned(yfraction) 0.9
78 set VPaned(newyfrac) 0.9
79 # for the square i.e. the little button.
80 frame $root.f \
81 -width $VPaned($root,knobsize) \
82 -height $VPaned($root,knobsize) \
83 -borderwidth 2 \
84 -relief raised \
85 -cursor crosshair \
86 -background $VPaned(knobcolor)
87 place $root.f \
88 -in $root \
89 -relx $VPaned(xfraction) \
90 -rely $VPaned(yfraction) \
91 -anchor n
92
93 # Now for the vertical separator.
94 frame $root.sep \
95 -width 4 \
96 -height 1 \
97 -borderwidth 2 \
98 -relief ridge
99 place $root.sep \
100 -in $root \
101 -relx $VPaned(xfraction) \
102 -relheight 1 \
103 -rely 0 \
104 -anchor n
105 raise $root.sep
106 raise $root.f
107
108 # set up the bindings for the little square
109 bind $root.f <Button-1> {VPane-start-grip %x %y %W}
110 bind $root.f <B1-Motion> {VPane-handle-grip %x %y %W}
111 bind $root.f <B1-ButtonRelease-1> {VPane-end-grip %W}
112
113 # tell the packer to quit managing left and right after establishing placer
114 # this won't hurt even if packer never knew about them
115 pack forget $root.$left
116 pack forget $root.$right
117 #remap after packer unmaps
118 VPane-end-grip $root.f
119 update idletasks
120 }
121
122 #
123 # proc HPane-Bind {root top bot {ks 10} {kf 0.85} {uminsize 0}
124 #----------------------------------------------------------------------------
125 # Bind an existing window hierarchy to have a moveable division.
126 # The hierarchy should be a root frame with two child frames
127 # splitting the horizontal dimension and a relative height of 1 for both.
128 # can handle more than one hierarchy simultaneously.
129 # Forces divider knob to stay in window.
130 # Brings child frames under control of the placer. leaving any grandchild
131 # frames in whatever geometry manager they originated.
132 # args root - the name of a window under control of the packer or placer
133 # top - the leaf name of the top child window of root
134 # bot - the leaf name of the bottom child window of root
135 # ks - the knob size (points) of the grip square
136 # kf - the fraction of vertical distance to start the knob at, 0.0=left
137 # uminsize - the minimum pixel height of one of the sub windows,
138 # if 0, no min enforced,
139 # if >0, min is min height of top window
140 # if <0, min is -min height of bottom window
141 # minimum can only be enforce on 1 pane. Enforced in HPane-replace
142 # The reason for the minsize feature is the textbox bug in tk3.6 which
143 # dumps core in tkTextDisp.c.
144 # $root.f is the knob
145 # eg. HPane-Bind .browser.main_frm parents_box child_box 15 0.85
146 # suggested by Kirk Abbott(inspired by the net) and generalized by Ben Allan
147 # associated procs are named starting with HPane. VPane equivalents are easy.
148 # configurable HPaned(knobcolor).
149 #
150 # kf is the fraction of the total vertical height where the window should
151 # be split. For example .85 means a big top window.
152 # ks is the size of the knob.
153 #----------------------------------------------------------------------------
154 global HPaned
155 set HPaned(knobcolor) white
156 proc HPane-Bind {root top bot {ks 10} {kf 0.85} {uminsize 0}} {
157 global HPaned
158 # make sure anything to be packed has been
159 update idletasks
160 set HPaned($root,top) $root.$top
161 set HPaned($root,bot) $root.$bot
162 set HPaned($root,knobsize) $ks
163 set HPaned($root,uminsize) $uminsize
164 set HPaned(ydrag_start) [winfo height $root.$top]
165 set HPaned(xdrag_start) [expr $kf * [winfo width $root.$top]]
166 set HPaned(yfraction) $kf
167 if {$HPaned(yfraction) >0.9} {set HPaned(yfraction) 0.33}
168 set HPaned(newyfrac) $HPaned(yfraction)
169 set HPaned(xfraction) 0.9
170 set HPaned(newxfrac) 0.9
171 # for the square i.e. the little button.
172 frame $root.f \
173 -width $HPaned($root,knobsize) \
174 -height $HPaned($root,knobsize) \
175 -borderwidth 2 \
176 -relief raised \
177 -cursor crosshair \
178 -background $HPaned(knobcolor)
179 place $root.f \
180 -in $root \
181 -rely $HPaned(yfraction) \
182 -relx $HPaned(xfraction) \
183 -anchor w
184
185 # Now for the horizontal separator.
186 frame $root.sep \
187 -width 1 \
188 -height 4 \
189 -borderwidth 2 \
190 -relief ridge
191 place $root.sep \
192 -in $root \
193 -rely $HPaned(yfraction) \
194 -relwidth 1 \
195 -relx 0 \
196 -anchor w
197 raise $root.sep
198 raise $root.f
199
200 # set up the bindings for the little square
201 bind $root.f <Button-1> {HPane-start-grip %x %y %W}
202 bind $root.f <B1-Motion> {HPane-handle-grip %x %y %W}
203 bind $root.f <B1-ButtonRelease-1> {HPane-end-grip %W}
204
205 # tell the packer to quit managing top and bot after establishing placer
206 # this won't hurt even if packer never knew about them
207 pack forget $root.$top
208 pack forget $root.$bot
209 #remap after packer unmaps
210 HPane-end-grip $root.f
211 update idletasks
212 }
213
214 #
215 # proc VPane-start-grip {wherex wherey w}
216 #----------------------------------------------------------------------------
217 # binding to set starting point for relative repositioning calcs when moving.
218 # start observing x events on knob
219 #----------------------------------------------------------------------------
220 proc VPane-start-grip {wherex wherey w} {
221 update idletasks
222 global VPaned
223 set VPaned(active) 1
224 set w [winfo parent $w]
225 set VPaned(xdrag_start) [winfo width $VPaned($w,left)]
226 set VPaned(ydrag_start) [winfo y $w.f]
227 grab $w.f
228 raise $w.sep
229 raise $w.f
230 $w.f configure -relief sunken
231 set VPaned(xfraction) [expr $VPaned(xdrag_start) / [winfo width $w].0]
232 set VPaned(newxfrac) $VPaned(xfraction)
233 set VPaned(yfraction) [expr $VPaned(ydrag_start) / [winfo height $w].0]
234 set VPaned(newyfrac) $VPaned(yfraction)
235 update idletasks
236 }
237 #
238 # proc HPane-start-grip {wherex wherey w}
239 #----------------------------------------------------------------------------
240 # binding to set starting point for relative repositioning calcs when moving.
241 # start observing x events on knob
242 #----------------------------------------------------------------------------
243 proc HPane-start-grip {wherex wherey w} {
244 update idletasks
245 global HPaned
246 set HPaned(active) 1
247 set w [winfo parent $w]
248 set HPaned(ydrag_start) [winfo height $HPaned($w,top)]
249 set HPaned(xdrag_start) [winfo x $w.f]
250 grab $w.f
251 raise $w.sep
252 raise $w.f
253 $w.f configure -relief sunken
254 set HPaned(yfraction) [expr $HPaned(ydrag_start) / [winfo height $w].0]
255 set HPaned(newyfrac) $HPaned(yfraction)
256 set HPaned(xfraction) [expr $HPaned(xdrag_start) / [winfo width $w].0]
257 set HPaned(newxfrac) $HPaned(xfraction)
258 update idletasks
259 }
260
261
262 #
263 # proc VPane-handle-grip {wherex wherey w}
264 #----------------------------------------------------------------------------
265 # binding for relative repositioning when moving
266 #----------------------------------------------------------------------------
267 proc VPane-handle-grip {wherex wherey w} {
268 global VPaned
269
270 set x [expr $wherex + [winfo x $w]]
271 set y [expr $wherey + [winfo y $w]]
272 set w [winfo parent $w]
273 if $VPaned(active) { # tk event management not so robust
274 set vpxf \
275 [expr "(($x.0 - $VPaned(xdrag_start)) / [winfo width $w].0) \
276 + $VPaned(xfraction)"]
277 if {$vpxf < 0.01} {set vpxf 0.01}
278 if {$vpxf > 1.0} {set vpxf 0.99}
279 set vpyf \
280 [expr "(($y.0 - $VPaned(ydrag_start)) / [winfo height $w].0) \
281 + $VPaned(yfraction)"]
282 if {$vpyf < 0.02} {set vpyf 0.02}
283 if {$vpyf > 0.95} {set vpyf 0.95}
284 } else {
285 set vpxf $VPaned(xfraction)
286 set vpyf $VPaned(yfraction)
287 }
288 place $w.sep \
289 -in $w \
290 -relx $vpxf \
291 -relheight 1 \
292 -rely 0 \
293 -anchor n
294 place $w.f \
295 -in $w \
296 -relx $vpxf \
297 -rely $vpyf \
298 -anchor n
299 set VPaned(newxfrac) $vpxf
300 set VPaned(newyfrac) $vpyf
301 }
302 #
303 # proc HPane-handle-grip {wherex wherey w}
304 #----------------------------------------------------------------------------
305 # binding for relative repositioning when moving
306 #----------------------------------------------------------------------------
307 proc HPane-handle-grip {wherex wherey w} {
308 global HPaned
309
310 set x [expr $wherex + [winfo x $w]]
311 set y [expr $wherey + [winfo y $w]]
312 set w [winfo parent $w]
313 if $HPaned(active) { # tk event management not so robust
314 set hpyf \
315 [expr "(($y.0 - $HPaned(ydrag_start)) / [winfo height $w].0) \
316 + $HPaned(yfraction)"]
317 if {$hpyf < 0.01} {set hpyf 0.01}
318 if {$hpyf > 1.0} {set hpyf 0.99}
319 set hpxf \
320 [expr "(($x.0 - $HPaned(xdrag_start)) / [winfo width $w].0) \
321 + $HPaned(xfraction)"]
322 if {$hpxf < 0.02} {set hpxf 0.02}
323 if {$hpxf > 0.99} {set hpxf 0.99}
324 } else {
325 set hpxf $HPaned(xfraction)
326 set hpyf $HPaned(yfraction)
327 }
328 place $w.sep \
329 -in $w \
330 -rely $hpyf \
331 -relwidth 1 \
332 -relx 0 \
333 -anchor w
334 place $w.f \
335 -in $w \
336 -rely $hpyf \
337 -relx $hpxf \
338 -anchor w
339 set HPaned(newxfrac) $hpxf
340 set HPaned(newyfrac) $hpyf
341 }
342
343
344 #
345 # proc VPane-replace {w}
346 #----------------------------------------------------------------------------
347 # redraw root window when split is decided on by user. record new start
348 #----------------------------------------------------------------------------
349 proc VPane-replace {w} {
350 global VPaned
351
352 set vpxf $VPaned(xfraction)
353 set vpyf $VPaned(yfraction)
354 place $w.f \
355 -in $w \
356 -rely $vpyf \
357 -relx $vpxf \
358 -anchor n
359 place $VPaned($w,left) \
360 -in $w \
361 -x 0 \
362 -y 0 \
363 -relheight 1 \
364 -relwidth $vpxf
365 place $VPaned($w,right) \
366 -in $w \
367 -y 0 \
368 -relx $vpxf \
369 -relheight 1 \
370 -relwidth [expr "1.0 - $vpxf"]
371 lower $w.sep
372 raise $w.f
373 update idletasks
374 }
375 #
376 # proc HPane-replace {w}
377 #----------------------------------------------------------------------------
378 # redraw root window when split is decided on by user. record new start.
379 # if minsize enforced, resets yfraction.
380 #----------------------------------------------------------------------------
381 proc HPane-replace {w} {
382 global HPaned
383
384 set ums $HPaned($w,uminsize)
385 set hpxf $HPaned(xfraction)
386 set hpyf $HPaned(yfraction)
387 set wdim \
388 [expr [winfo height $HPaned($w,top)] + [winfo height $HPaned($w,bot)] ]
389 if {$ums != 0} {
390 set minfrac [expr (abs($ums)*1.0)/($wdim*1.0)]
391 if {$ums > 0} {
392 if {$minfrac > $hpyf} {
393 set hpyf $minfrac
394 }
395 if {$hpyf > 1.0} {
396 set hpyf 0.99
397 }
398 } else {
399 if {(1 - $minfrac) < $hpyf} {
400 set hpyf [expr 1.0 - $minfrac]
401 }
402 if {$hpyf < 0.01} {
403 set hpyf 0.01
404 }
405 }
406 }
407 set $HPaned(yfraction) $hpyf
408 place $w.f \
409 -in $w \
410 -rely $hpyf \
411 -relx $hpxf \
412 -anchor w
413 place $w.sep \
414 -in $w \
415 -rely $hpyf \
416 -relwidth 1 \
417 -relx 0 \
418 -anchor w
419 place $HPaned($w,top) \
420 -in $w \
421 -x 0 \
422 -y 0 \
423 -relheight $hpyf \
424 -relwidth 1
425 place $HPaned($w,bot) \
426 -in $w \
427 -x 0 \
428 -rely $hpyf \
429 -relwidth 1 \
430 -relheight [expr "1.0 - $hpyf"]
431 raise $w.sep
432 raise $w.f
433 update idletasks
434 }
435
436
437 #
438 # proc VPane-end-grip {w}
439 #----------------------------------------------------------------------------
440 # fix split decided on by user and ignore any linger x events on knob.
441 #----------------------------------------------------------------------------
442 proc VPane-end-grip {w} {
443 global VPaned
444 set w [winfo parent $w]
445 set VPaned(xfraction) $VPaned(newxfrac)
446 set VPaned(yfraction) $VPaned(newyfrac)
447 set VPaned(active) 0
448 $w.f configure \
449 -relief raised \
450 -height $VPaned($w,knobsize) \
451 -width $VPaned($w,knobsize)
452 VPane-replace $w
453 grab release $w.f
454 }
455 #
456 # proc HPane-end-grip {w}
457 #----------------------------------------------------------------------------
458 # fix split decided on by user and ignore any linger x events on knob.
459 # here we need to enforce the min pixel size if specified for part of the
460 # window.
461 #----------------------------------------------------------------------------
462 proc HPane-end-grip {w} {
463 global HPaned
464 set w [winfo parent $w]
465 set HPaned(xfraction) $HPaned(newxfrac)
466 set HPaned(yfraction) $HPaned(newyfrac)
467 set HPaned(active) 0
468 $w.f configure \
469 -relief raised \
470 -height $HPaned($w,knobsize) \
471 -width $HPaned($w,knobsize)
472 HPane-replace $w
473 grab release $w.f
474 }
475

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22