1# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*- 2# 3# $Id: SWidget.tcl,v 1.5 2002/01/24 09:13:58 idiscovery Exp $ 4# 5# SWidget.tcl -- 6# 7# tixScrolledWidget: virtual base class. Do not instantiate 8# This is the core class for all scrolled widgets. 9# 10# Copyright (c) 1993-1999 Ioi Kim Lam. 11# Copyright (c) 2000-2001 Tix Project Group. 12# 13# See the file "license.terms" for information on usage and redistribution 14# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 15# 16 17 18tixWidgetClass tixScrolledWidget { 19 -virtual true 20 -classname TixScrolledWidget 21 -superclass tixPrimitive 22 -method { 23 } 24 -flag { 25 -scrollbar -scrollbarspace 26 } 27 -configspec { 28 {-scrollbar scrollbar Scrollbar both} 29 {-scrollbarspace scrollbarSpace ScrollbarSpace {both}} 30 {-sizebox sizeBox SizeBox 0} 31 } 32} 33 34proc tixScrolledWidget:InitWidgetRec {w} { 35 upvar #0 $w data 36 37 tixChainMethod $w InitWidgetRec 38 39 set data(x,first) 0 40 set data(x,last) 0 41 42 set data(y,first) 0 43 set data(y,last) 0 44 45 set data(lastSpec) "" 46 set data(lastMW) "" 47 set data(lastMH) "" 48 set data(lastScbW) "" 49 set data(lastScbH) "" 50 51 set data(repack) 0 52 set data(counter) 0 53 54 set data(vsbPadY) 0 55 set data(hsbPadX) 0 56} 57 58proc tixScrolledWidget:SetBindings {w} { 59 upvar #0 $w data 60 61 tixChainMethod $w SetBindings 62 63 tixManageGeometry $data(pw:client) "tixScrolledWidget:ClientGeomProc $w" 64 bind $data(pw:client) <Configure> \ 65 [list tixScrolledWidget:ClientGeomProc $w "" $data(pw:client)] 66 67 tixManageGeometry $data(w:hsb) "tixScrolledWidget:ClientGeomProc $w" 68 bind $data(w:hsb) <Configure> \ 69 [list tixScrolledWidget:ClientGeomProc $w "" $data(w:hsb)] 70 71 tixManageGeometry $data(w:vsb) "tixScrolledWidget:ClientGeomProc $w" 72 bind $data(w:vsb) <Configure> \ 73 [list tixScrolledWidget:ClientGeomProc $w "" $data(w:vsb)] 74 75 bind $w <Configure> "tixScrolledWidget:MasterGeomProc $w" 76 77 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w 78 set data(repack) 1 79} 80 81proc tixScrolledWidget:config-scrollbar {w value} { 82 upvar #0 $w data 83 global tcl_platform 84 85 if {[lindex $value 0] == "auto"} { 86 foreach xspec [lrange $value 1 end] { 87 case $xspec { 88 {+x -x +y -y} {} 89 default { 90 error "bad -scrollbar value \"$value\"" 91 } 92 } 93 } 94 } else { 95 case $value in { 96 {none x y both} {} 97 default { 98 error "bad -scrollbar value \"$value\"" 99 } 100 } 101 } 102 103 if {$data(-sizebox) && $tcl_platform(platform) == "windows"} { 104 set data(-scrollbar) both 105 } 106 107 if {$data(repack) == 0} { 108 set data(repack) 1 109 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w 110 } 111} 112 113proc tixScrolledWidget:config-scrollbarspace {w value} { 114 upvar #0 $w data 115 116 if {$data(repack) == 0} { 117 set data(repack) 1 118 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w 119 } 120} 121 122proc tixScrolledWidget:config-sizebox {w value} { 123 error "unimplemented" 124} 125 126 127#---------------------------------------------------------------------- 128# 129# Scrollbar calculations 130# 131#---------------------------------------------------------------------- 132proc tixScrolledWidget:ClientGeomProc {w type client} { 133 upvar #0 $w data 134 135 if {$data(repack) == 0} { 136 set data(repack) 1 137 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w 138 } 139} 140 141proc tixScrolledWidget:MasterGeomProc {w} { 142 upvar #0 $w data 143 144 if {$data(repack) == 0} { 145 set data(repack) 1 146 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w 147 } 148} 149 150proc tixScrolledWidget:Configure {w} { 151 if {![winfo exists $w]} { 152 return 153 } 154 155 upvar #0 $w data 156 157 if {$data(repack) == 0} { 158 set data(repack) 1 159 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w 160 } 161} 162 163proc tixScrolledWidget:ScrollCmd {w scrollbar axis first last} { 164 upvar #0 $w data 165 166 $scrollbar set $first $last 167} 168 169# Show or hide the scrollbars as required. 170# 171# spec: 00 = need none 172# spec: 01 = need y 173# spec: 10 = need x 174# spec: 11 = need xy 175# 176proc tixScrolledWidget:Repack {w} { 177 tixCallMethod $w RepackHook 178} 179 180proc tixScrolledWidget:RepackHook {w} { 181 upvar #0 $w data 182 global tcl_platform 183 184 if {![winfo exists $w]} { 185 # This was generated by the <Destroy> event 186 # 187 return 188 } 189 190 set client $data(pw:client) 191 192 # Calculate the size of the master 193 # 194 set mreqw [winfo reqwidth $w] 195 set mreqh [winfo reqheight $w] 196 set creqw [winfo reqwidth $client] 197 set creqh [winfo reqheight $client] 198 199 set scbW [winfo reqwidth $w.vsb] 200 set scbH [winfo reqheight $w.hsb] 201 202 case $data(-scrollbarspace) { 203 "x" { 204 incr creqh $scbH 205 } 206 "y" { 207 incr creqw $scbW 208 } 209 "both" { 210 incr creqw $scbW 211 incr creqh $scbH 212 } 213 } 214 215 if {$data(-width) != 0} { 216 set creqw $data(-width) 217 } 218 if {$data(-height) != 0} { 219 set creqh $data(-height) 220 } 221 222 if {$mreqw != $creqw || $mreqh != $creqh } { 223 if {![info exists data(counter)]} { 224 set data(counter) 0 225 } 226 if {$data(counter) < 50} { 227 incr data(counter) 228 tixGeometryRequest $w $creqw $creqh 229 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w 230 set data(repack) 1 231 return 232 } 233 } 234 235 set data(counter) 0 236 set mw [winfo width $w] 237 set mh [winfo height $w] 238 239 set cw [expr $mw - $scbW] 240 set ch [expr $mh - $scbH] 241 242 set scbx [expr $mw - $scbW] 243 set scby [expr $mh - $scbH] 244 245 # Check the validity of the sizes: if window was not mapped then 246 # sizes will be below 1x1 247 if {$cw < 1} { 248 set cw 1 249 } 250 if {$ch < 1} { 251 set ch 1 252 } 253 if {$scbx < 1} { 254 set scbx 1 255 } 256 if {$scby < 1} { 257 set scby 1 258 } 259 260 if {[lindex $data(-scrollbar) 0] == "auto"} { 261 # Find out how we are going to pack the scrollbars 262 # 263 set spec [tixScrolledWidget:CheckScrollbars $w $scbW $scbH] 264 265 foreach xspec [lrange $data(-scrollbar) 1 end] { 266 case $xspec { 267 +x { 268 set spec [expr $spec | 10] 269 } 270 -x { 271 set spec [expr $spec & 01] 272 } 273 +y { 274 set spec [expr $spec | 01] 275 } 276 -y { 277 set spec [expr $spec & 10] 278 } 279 } 280 } 281 if {$spec == 0} { 282 set spec 00 283 } 284 if {$spec == 1} { 285 set spec 01 286 } 287 } else { 288 case $data(-scrollbar) in { 289 none { 290 set spec 00 291 } 292 x { 293 set spec 10 294 } 295 y { 296 set spec 01 297 } 298 both { 299 set spec 11 300 } 301 } 302 } 303 304 305 if {$data(lastSpec)==$spec && $data(lastMW)==$mw && $data(lastMH)==$mh} { 306 if {$data(lastScbW) == $scbW && $data(lastScbH) == $scbH} { 307 tixCallMethod $w PlaceWindow 308 set data(repack) 0 309 return 310 } 311 } 312 313 set vsbH [expr $mh - $data(vsbPadY)] 314 set hsbW [expr $mw - $data(hsbPadX)] 315 316 if {$vsbH < 1} { 317 set vsbH 1 318 } 319 if {$hsbW < 1} { 320 set hsbW 1 321 } 322 323 case $spec in { 324 "00" { 325 tixMoveResizeWindow $client 0 0 $mw $mh 326 327 tixMapWindow $client 328 tixUnmapWindow $data(w:hsb) 329 tixUnmapWindow $data(w:vsb) 330 } 331 "01" { 332 tixMoveResizeWindow $client 0 0 $cw $mh 333 tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH 334 335 tixMapWindow $client 336 tixUnmapWindow $data(w:hsb) 337 tixMapWindow $data(w:vsb) 338 } 339 "10" { 340 tixMoveResizeWindow $client 0 0 $mw $ch 341 tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH 342 343 tixMapWindow $client 344 tixMapWindow $data(w:hsb) 345 tixUnmapWindow $data(w:vsb) 346 } 347 "11" { 348 set vsbH [expr $ch - $data(vsbPadY)] 349 set hsbW [expr $cw - $data(hsbPadX)] 350 if {$vsbH < 1} { 351 set vsbH 1 352 } 353 if {$hsbW < 1} { 354 set hsbW 1 355 } 356 357 tixMoveResizeWindow $client 0 0 $cw $ch 358 tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH 359 tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH 360 if {$data(-sizebox) && $tcl_platform(platform) == "windows"} { 361 tixMoveResizeWindow $data(w:sizebox) $scbx $scby $scbW $scbH 362 } 363 364 tixMapWindow $client 365 tixMapWindow $data(w:hsb) 366 tixMapWindow $data(w:vsb) 367 if {$data(-sizebox) && $tcl_platform(platform) == "windows"} { 368 tixMapWindow $data(w:sizebox) 369 } 370 } 371 } 372 373 set data(lastSpec) $spec 374 set data(lastMW) $mw 375 set data(lastMH) $mh 376 set data(lastScbW) $scbW 377 set data(lastScbH) $scbH 378 379 tixCallMethod $w PlaceWindow 380 set data(repack) 0 381} 382 383proc tixScrolledWidget:PlaceWindow {w} { 384 # virtual base function 385} 386 387# 388# Helper function 389# 390proc tixScrolledWidget:NeedScrollbar {w axis} { 391 upvar #0 $w data 392 393 if {$data($axis,first) > 0.0} { 394 return 1 395 } 396 397 if {$data($axis,last) < 1.0} { 398 return 1 399 } 400 401 return 0 402} 403 404# Return whether H and V needs scrollbars in a list of two booleans 405# 406# 407proc tixScrolledWidget:CheckScrollbars {w scbW scbH} { 408 upvar #0 $w data 409 410 set mW [winfo width $w] 411 set mH [winfo height $w] 412 413 set info [tixCallMethod $w GeometryInfo $mW $mH] 414 415 if {$info != ""} { 416 set xSpec [lindex $info 0] 417 set ySpec [lindex $info 1] 418 419 set data(x,first) [lindex $xSpec 0] 420 set data(x,last) [lindex $xSpec 1] 421 422 set data(y,first) [lindex $ySpec 0] 423 set data(y,last) [lindex $ySpec 1] 424 } 425 426 set needX [tixScrolledWidget:NeedScrollbar $w x] 427 set needY [tixScrolledWidget:NeedScrollbar $w y] 428 429 if {[winfo ismapped $w]==0} { 430 return "$needX$needY" 431 } 432 433 if {$needX && $needY} { 434 return 11 435 } 436 437 if {$needX == 0 && $needY == 0} { 438 return 00 439 } 440 441 if {$needX} { 442 set mH [expr $mH - $scbH] 443 } 444 if {$needY} { 445 set mW [expr $mW - $scbW] 446 } 447 448 set info [tixCallMethod $w GeometryInfo $mW $mH] 449 if {$info != ""} { 450 set xSpec [lindex $info 0] 451 set ySpec [lindex $info 1] 452 453 set data(x,first) [lindex $xSpec 0] 454 set data(x,last) [lindex $xSpec 1] 455 456 set data(y,first) [lindex $ySpec 0] 457 set data(y,last) [lindex $ySpec 1] 458 } 459 460 set needX [tixScrolledWidget:NeedScrollbar $w x] 461 set needY [tixScrolledWidget:NeedScrollbar $w y] 462 463 return "$needX$needY" 464} 465 466