1#
2# fdispPopup.tcl
3#
4# Nested folder popup (or popdown) display.
5#
6# Copyright (c) 1993 Xerox Corporation.
7# Use and copying of this software and preparation of derivative works based
8# upon this software are permitted. Any distribution of this software or
9# derivative works must comply with all applicable United States export
10# control laws. This software is made available AS IS, and Xerox Corporation
11# makes no warranty about the software, its performance or its conformity to
12# any specification.
13
14# Reset notion of displayed popdowns when canvas is init'd or destroyed
15proc FdispPopdownReset {} {
16    global fdisp
17    set fdisp(poptop) -1
18}
19# Remove all displayed popdowns
20proc FdispPopdownRemove {} {
21    FdispDisplayPopdown "" remove
22}
23proc FdispDisplayPopdown {folder pop {bx -1} {by -1}} {
24    global fdisp
25
26    set can canvas	;# popdowns only on main display
27
28    set folderSet [Flist_FolderSet $folder]
29    set canvas $fdisp($can)
30    set width [winfo width $canvas]
31
32    if ![info exists fdisp(maxy,canvas)] {
33	return	;# display not initialized yet
34    }
35    case $fdisp(popdownStyle) in {
36	{r*}	{set style 1}
37	default	{set style 0}
38    }
39    set tag T_$folder
40
41    #Exmh_Debug FdispDisplayPopdown $folder $pop top=$fdisp(poptop) $tag
42    if {($pop == "down") && ($fdisp(poptop) != -1)} {
43	if {$fdisp(popdown,0) == $tag} {
44	    # Clicking on a folder with popup already displayed.
45	    set pop "remove"
46	}
47    }
48    if {($pop == "stack") && ($fdisp(popdown,$fdisp(poptop)) == $tag) &&
49	($fdisp(popdownAction) == "navbutton")} {
50	Exmh_Debug Remove leaf $tag
51	$canvas lower $fdisp(popdown,$fdisp(poptop))
52	incr fdisp(poptop) -1
53	return
54    }
55
56    if {$pop == "stack"} {
57	if {$fdisp(popdownAction) == "navbutton"} {
58	    set hit 0
59	    for {set i 0} {$i <= $fdisp(poptop)} {incr i} {
60		if {$fdisp(popdown,$i) == $tag} {
61		    set hit 1	;# Already visible.  Decide what to nuke.
62		}
63	    }
64	    if {$hit} {
65		for {set i $fdisp(poptop)} {$i >= 0} {incr i -1} {
66		    Exmh_Debug remove popdown $fdisp(popdown,$i)
67		    $canvas lower $fdisp(popdown,$i)
68		    incr fdisp(poptop) -1
69		    if {$fdisp(popdown,$i) == $tag} {
70			return
71		    }
72		}
73	    }
74	}
75	if {$fdisp(popdown,$fdisp(poptop)) == $tag} {
76	    Exmh_Debug "Reuse top of stack $tag"
77	    FdispPopupView $canvas $tag
78	    return
79	}
80	for {set i 0} {$i <= $fdisp(poptop)} { incr i} {
81	    if {$fdisp(popdown,$i) == $tag} {
82		Exmh_Debug popdown already visible $tag
83		FdispPopupView $canvas $tag
84		return
85	    }
86	}
87	incr fdisp(poptop)
88    } else {
89	for {set i $fdisp(poptop)} {$i >= 0} {incr i -1} {
90	    Exmh_Debug remove popdown $fdisp(popdown,$i)
91	    $canvas lower $fdisp(popdown,$i)
92	}
93	if {$pop == "remove"} {
94	    FdispPopupResetView $can
95	    set fdisp(poptop) -1
96	    return
97	}
98	set fdisp(poptop) 0
99    }
100
101    if {[$canvas gettag $tag] != ""} {
102	set fdisp(popdown,$fdisp(poptop)) $tag
103	Exmh_Debug reuse popdown $tag
104	$canvas raise $tag
105	FdispPopupView $canvas $tag
106	return
107    }
108
109    Exmh_Status "Building popdown display for $folder"
110
111    set bid [FdispGetBmap $can $folder]
112    if {$bid == ""} {
113	set id [$canvas find closest $bx $by]
114	Exmh_Debug CLOSEST: x=$bx y=$by is id=$id [$canvas type $id]
115
116	if {[$canvas type $id] == "text"} {
117	    set bid [$canvas find below $id]
118	    Exmh_Debug bid=$bid [$canvas type $bid] @ [$canvas coo $bid]
119	} else {
120	    set bid $id
121	}
122    }
123
124    set bbox [$canvas coords $bid]
125    if {[string length $bbox] == 0} {
126	Exmh_Status "No coords for box <$bid>" error
127	return
128    }
129
130    # compute bounding coords of anchoring folder name/bitmap
131    #    bx1,by1
132    #       +-----------+
133    #	    |folder name|
134    #       +-----------+
135    #		     bx2,by2
136
137    set bx1 [lindex $bbox 0]
138    set bx2 [lindex $bbox 2]
139    set by1 [lindex $bbox 1]
140    set by2 [lindex $bbox 3]
141
142    # layout subfolder display
143    #	will be centered around anchor with a width equal to 3/4 of canvas
144    FdispLayoutInner $can 0 0 [expr ($width*3/4)] $folderSet $folder \
145		FdispBindPopupLabel skipSelf $tag
146
147    # compute bounding coords of subfolder display
148    #	wid = width, hei = height
149    #	lx = left x, rx = right x
150    # lx/rx are adjusted to fit within width of canvas (wid is not updated)
151
152    if [catch {
153	set bbox1 $bbox
154	set bbox [$canvas bbox $tag]
155	set hei [expr $fdisp(ygap)/2 + [lindex $bbox 3] - [lindex $bbox 1]]
156	set wid [expr $fdisp(xgap)/4 + [lindex $bbox 2] - [lindex $bbox 0]]
157	set wid [expr {$wid - $bx2 + $bx1}]
158
159	set lx [expr $bx1-$wid/2]
160	set rx [expr $bx2+4+$wid/2]
161    } err] {
162	global errorInfo ; set savedInfo $errorInfo
163	catch {set wid} w
164	error $err "Bbox1=($bbox1) Bbox2=($bbox) wid=$w bx1=$bx1 bx2=$bx2\n$savedInfo"
165    }
166    if {$lx < 3} {
167	set rx [expr {$rx - $lx + 3}]
168	set lx 3
169    }
170    if {$rx > $width - 4} {
171	set lx [expr {$width + $lx - $rx - 4}]
172	set rx [expr $width-4]
173    }
174
175    if {$style} {
176	set gap 4
177
178	# Add a square decoration around subfolder display
179	#
180	#    bx1,by1
181	#       +-----------+
182	#       |folder name|
183	#       +-----------+ bx2,by2         +
184	# rx1,ry1                             | gap
185	#    +-----------------+              +
186	#    |subfolder display|
187	#    +-----------------+ rx2,ry2
188
189	set rx1 $lx
190	set ry1 [expr $by2+$gap]
191	set rx2 $rx
192	set ry2 [expr {$ry1 + $fdisp(ygap)/4+$hei}]
193
194	set loweredge [expr {$ry2 + 4}]
195
196	set box [$canvas create rect $rx1 $ry1 $rx2 $ry2 -fill $fdisp(c_popup)]
197
198	$canvas move $tag [expr {$rx1 + $fdisp(xgap)*3/4}] \
199			[expr {$ry1 + $fdisp(ygap)/2}]
200	$canvas raise $tag $box
201
202	$canvas addtag $tag withtag $box
203    } else {
204	set gap 14
205
206	# Add a trapezoidal decoration around subfolder display
207	#
208	#    bx1,by1
209	#       +-----------+
210	#       |folder name|
211	#       +-----------+ bx2,by2         + +
212	# px1,py1                             | | 2 pixels
213	#       +-----------+ px2,py2         | +
214	#      /             \                |
215	#     /               \               | gap
216	#    +px6,py6          + px3,py3      +
217	#    |subfolder display|
218	#    +-----------------+ px4,py4
219	# px5,py5
220
221	set px1 $bx1
222	# +2 makes us overlap the lower black border
223	set py1 [expr $by2+2]
224	set px2 [expr $bx2+4]
225	set py2 $py1
226	set px3 $rx
227	set py3 [expr $by2+$gap]
228	set px4 $px3
229	set py4 [expr {$py3 + $fdisp(ygap)/4+$hei}]
230	set px5 $lx
231	set py5 $py4
232	set px6 $px5
233	set py6 $py3
234
235	set loweredge [expr {$py4 + 4}]
236
237	set border [$canvas create poly $px1 $py1 $px2 $py2 \
238			$px3 $py3 $px4 $py4 \
239			$px5 $py5 $px6 $py6 -fill $fdisp(c_fg)]
240
241	set box [$canvas create poly [expr $px1+1] [expr $py1+1] \
242			[expr $px2-1] [expr $py2+1] \
243			[expr $px3-1] [expr $py3+1] \
244			[expr $px4-1] [expr $py4-1] \
245			[expr $px5+1] [expr $py5-1] \
246			[expr $px6+1] [expr $py6+1] \
247			-fill $fdisp(c_popup)]
248
249	$canvas move $tag [expr {$px6 + $fdisp(xgap)*3/4}] \
250			[expr {$py6 + $fdisp(ygap)/2}]
251	$canvas raise $tag $box
252
253	# add a dividing line
254	# (should just change above poly to be a poly and a rect)
255	# set line [$canvas create line $px6 $py6 $px3 $py6]
256	# $canvas raise $line
257	# $canvas addtag $tag withtag $line
258
259	$canvas addtag $tag withtag $border
260	$canvas addtag $tag withtag $box
261    }
262    # Cannot bind to <Leave> because that triggers when you enter a label.
263    $canvas bind $box <Double-$fdisp(navbutton)> \
264	[list FdispDisplayPopdown {} remove]
265
266    FdispSetCanvasSize $can $loweredge 1
267
268    Exmh_Status ""
269    set fdisp(popdown,$fdisp(poptop)) $tag
270    FdispPopupView $canvas $tag
271    # Highlight newly created labels
272    Fdisp_HighlightCanvas canvas
273}
274proc FdispBindPopupLabel { can id ftype f } {
275    global fdisp
276    set canvas $fdisp($can)
277    if {[string compare $ftype hasNested] == 0} {
278	# This label has nested folders
279	case $fdisp(popdownAction) {
280	    redisplay {
281		$canvas bind $id <$fdisp(navbutton)> \
282		    [list FdispMain $f]
283	    }
284	    enter {
285		$canvas bind $id <Any-Enter> \
286		    [list FdispDisplayPopdown $f stack %x %y]
287	    }
288	    navbutton {
289		$canvas bind $id <$fdisp(navbutton)> \
290		    [list FdispDisplayPopdown $f stack %x %y]
291	    }
292	}
293    }
294    $canvas bind $id <$fdisp(curbutton)> [list Folder_Change $f]
295
296    if {$fdisp(tarbuttonAction) == "select+move"} {
297        $canvas bind $id <$fdisp(tarbutton)> \
298                [list Folder_TargetMove $f]
299    } elseif {$fdisp(tarbuttonAction) == "select+copy"} {
300        $canvas bind $id <Shift-$fdisp(tarbutton)> \
301                [list Folder_TargetCopy $f]
302    } elseif {$fdisp(tarbuttonAction) == "select only"} {
303        $canvas bind $id <$fdisp(tarbutton)> \
304                [list Folder_Target $f]
305    } else {
306        $canvas bind $id <$fdisp(tarbutton)> \
307                [list Folder_TargetMove $f]
308    }
309    $canvas bind $id <Shift-$fdisp(tarbutton)> 	[list Folder_TargetCopy $f]
310    $canvas bind $id <Control-$fdisp(tarbutton)> \
311		    [list Folder_TargetClear]
312}
313proc FdispPopupResetView { can } {
314    global fdisp
315    set canvas $fdisp($can)
316    if {$fdisp(popdownRemove) == "navbutton" || \
317        [$canvas canvasy 0] > $fdisp(maxy,$can)} {
318	    $canvas yview moveto 0.
319    }
320}
321proc FdispPopupView { canvas tag } {
322    $canvas raise $tag
323    set h [lindex [$canvas configure -height] 4]
324    if [catch {$canvas cget -yscrollincrement} inc] {
325	set inc [expr [$canvas cget -height]/10]
326    }
327    set ybot [$canvas canvasy $h]
328    set bbox [$canvas bbox $tag]
329    set popbot [lindex $bbox 3]
330    if {$popbot <= $ybot} {return}
331
332    # Bottom edge clipped
333    set moveup [expr $popbot-$ybot]
334
335    set ytop [$canvas canvasy 0]
336    set poptop [lindex $bbox 1]
337    set room [expr $poptop-$ytop]
338    set moveup [expr {($moveup > $room || $poptop == $inc+1) ? $room-2*$inc : $moveup}]
339    $canvas yview scroll [expr int($moveup/$inc)] units
340}
341