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