%PDF- %PDF-
Direktori : /usr/lib64/tcl8.6/Tix8.4.3/ |
Current File : //usr/lib64/tcl8.6/Tix8.4.3/SWidget.tcl |
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*- # # $Id: SWidget.tcl,v 1.5 2002/01/24 09:13:58 idiscovery Exp $ # # SWidget.tcl -- # # tixScrolledWidget: virtual base class. Do not instantiate # This is the core class for all scrolled widgets. # # Copyright (c) 1993-1999 Ioi Kim Lam. # Copyright (c) 2000-2001 Tix Project Group. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # tixWidgetClass tixScrolledWidget { -virtual true -classname TixScrolledWidget -superclass tixPrimitive -method { } -flag { -scrollbar -scrollbarspace } -configspec { {-scrollbar scrollbar Scrollbar both} {-scrollbarspace scrollbarSpace ScrollbarSpace {both}} {-sizebox sizeBox SizeBox 0} } } proc tixScrolledWidget:InitWidgetRec {w} { upvar #0 $w data tixChainMethod $w InitWidgetRec set data(x,first) 0 set data(x,last) 0 set data(y,first) 0 set data(y,last) 0 set data(lastSpec) "" set data(lastMW) "" set data(lastMH) "" set data(lastScbW) "" set data(lastScbH) "" set data(repack) 0 set data(counter) 0 set data(vsbPadY) 0 set data(hsbPadX) 0 } proc tixScrolledWidget:SetBindings {w} { upvar #0 $w data tixChainMethod $w SetBindings tixManageGeometry $data(pw:client) "tixScrolledWidget:ClientGeomProc $w" bind $data(pw:client) <Configure> \ [list tixScrolledWidget:ClientGeomProc $w "" $data(pw:client)] tixManageGeometry $data(w:hsb) "tixScrolledWidget:ClientGeomProc $w" bind $data(w:hsb) <Configure> \ [list tixScrolledWidget:ClientGeomProc $w "" $data(w:hsb)] tixManageGeometry $data(w:vsb) "tixScrolledWidget:ClientGeomProc $w" bind $data(w:vsb) <Configure> \ [list tixScrolledWidget:ClientGeomProc $w "" $data(w:vsb)] bind $w <Configure> "tixScrolledWidget:MasterGeomProc $w" tixWidgetDoWhenIdle tixScrolledWidget:Repack $w set data(repack) 1 } proc tixScrolledWidget:config-scrollbar {w value} { upvar #0 $w data global tcl_platform if {[lindex $value 0] == "auto"} { foreach xspec [lrange $value 1 end] { case $xspec { {+x -x +y -y} {} default { error "bad -scrollbar value \"$value\"" } } } } else { case $value in { {none x y both} {} default { error "bad -scrollbar value \"$value\"" } } } if {$data(-sizebox) && $tcl_platform(platform) == "windows"} { set data(-scrollbar) both } if {$data(repack) == 0} { set data(repack) 1 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w } } proc tixScrolledWidget:config-scrollbarspace {w value} { upvar #0 $w data if {$data(repack) == 0} { set data(repack) 1 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w } } proc tixScrolledWidget:config-sizebox {w value} { error "unimplemented" } #---------------------------------------------------------------------- # # Scrollbar calculations # #---------------------------------------------------------------------- proc tixScrolledWidget:ClientGeomProc {w type client} { upvar #0 $w data if {$data(repack) == 0} { set data(repack) 1 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w } } proc tixScrolledWidget:MasterGeomProc {w} { upvar #0 $w data if {$data(repack) == 0} { set data(repack) 1 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w } } proc tixScrolledWidget:Configure {w} { if {![winfo exists $w]} { return } upvar #0 $w data if {$data(repack) == 0} { set data(repack) 1 tixWidgetDoWhenIdle tixScrolledWidget:Repack $w } } proc tixScrolledWidget:ScrollCmd {w scrollbar axis first last} { upvar #0 $w data $scrollbar set $first $last } # Show or hide the scrollbars as required. # # spec: 00 = need none # spec: 01 = need y # spec: 10 = need x # spec: 11 = need xy # proc tixScrolledWidget:Repack {w} { tixCallMethod $w RepackHook } proc tixScrolledWidget:RepackHook {w} { upvar #0 $w data global tcl_platform if {![winfo exists $w]} { # This was generated by the <Destroy> event # return } set client $data(pw:client) # Calculate the size of the master # set mreqw [winfo reqwidth $w] set mreqh [winfo reqheight $w] set creqw [winfo reqwidth $client] set creqh [winfo reqheight $client] set scbW [winfo reqwidth $w.vsb] set scbH [winfo reqheight $w.hsb] case $data(-scrollbarspace) { "x" { incr creqh $scbH } "y" { incr creqw $scbW } "both" { incr creqw $scbW incr creqh $scbH } } if {$data(-width) != 0} { set creqw $data(-width) } if {$data(-height) != 0} { set creqh $data(-height) } if {$mreqw != $creqw || $mreqh != $creqh } { if {![info exists data(counter)]} { set data(counter) 0 } if {$data(counter) < 50} { incr data(counter) tixGeometryRequest $w $creqw $creqh tixWidgetDoWhenIdle tixScrolledWidget:Repack $w set data(repack) 1 return } } set data(counter) 0 set mw [winfo width $w] set mh [winfo height $w] set cw [expr $mw - $scbW] set ch [expr $mh - $scbH] set scbx [expr $mw - $scbW] set scby [expr $mh - $scbH] # Check the validity of the sizes: if window was not mapped then # sizes will be below 1x1 if {$cw < 1} { set cw 1 } if {$ch < 1} { set ch 1 } if {$scbx < 1} { set scbx 1 } if {$scby < 1} { set scby 1 } if {[lindex $data(-scrollbar) 0] == "auto"} { # Find out how we are going to pack the scrollbars # set spec [tixScrolledWidget:CheckScrollbars $w $scbW $scbH] foreach xspec [lrange $data(-scrollbar) 1 end] { case $xspec { +x { set spec [expr $spec | 10] } -x { set spec [expr $spec & 01] } +y { set spec [expr $spec | 01] } -y { set spec [expr $spec & 10] } } } if {$spec == 0} { set spec 00 } if {$spec == 1} { set spec 01 } } else { case $data(-scrollbar) in { none { set spec 00 } x { set spec 10 } y { set spec 01 } both { set spec 11 } } } if {$data(lastSpec)==$spec && $data(lastMW)==$mw && $data(lastMH)==$mh} { if {$data(lastScbW) == $scbW && $data(lastScbH) == $scbH} { tixCallMethod $w PlaceWindow set data(repack) 0 return } } set vsbH [expr $mh - $data(vsbPadY)] set hsbW [expr $mw - $data(hsbPadX)] if {$vsbH < 1} { set vsbH 1 } if {$hsbW < 1} { set hsbW 1 } case $spec in { "00" { tixMoveResizeWindow $client 0 0 $mw $mh tixMapWindow $client tixUnmapWindow $data(w:hsb) tixUnmapWindow $data(w:vsb) } "01" { tixMoveResizeWindow $client 0 0 $cw $mh tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH tixMapWindow $client tixUnmapWindow $data(w:hsb) tixMapWindow $data(w:vsb) } "10" { tixMoveResizeWindow $client 0 0 $mw $ch tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH tixMapWindow $client tixMapWindow $data(w:hsb) tixUnmapWindow $data(w:vsb) } "11" { set vsbH [expr $ch - $data(vsbPadY)] set hsbW [expr $cw - $data(hsbPadX)] if {$vsbH < 1} { set vsbH 1 } if {$hsbW < 1} { set hsbW 1 } tixMoveResizeWindow $client 0 0 $cw $ch tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH if {$data(-sizebox) && $tcl_platform(platform) == "windows"} { tixMoveResizeWindow $data(w:sizebox) $scbx $scby $scbW $scbH } tixMapWindow $client tixMapWindow $data(w:hsb) tixMapWindow $data(w:vsb) if {$data(-sizebox) && $tcl_platform(platform) == "windows"} { tixMapWindow $data(w:sizebox) } } } set data(lastSpec) $spec set data(lastMW) $mw set data(lastMH) $mh set data(lastScbW) $scbW set data(lastScbH) $scbH tixCallMethod $w PlaceWindow set data(repack) 0 } proc tixScrolledWidget:PlaceWindow {w} { # virtual base function } # # Helper function # proc tixScrolledWidget:NeedScrollbar {w axis} { upvar #0 $w data if {$data($axis,first) > 0.0} { return 1 } if {$data($axis,last) < 1.0} { return 1 } return 0 } # Return whether H and V needs scrollbars in a list of two booleans # # proc tixScrolledWidget:CheckScrollbars {w scbW scbH} { upvar #0 $w data set mW [winfo width $w] set mH [winfo height $w] set info [tixCallMethod $w GeometryInfo $mW $mH] if {$info != ""} { set xSpec [lindex $info 0] set ySpec [lindex $info 1] set data(x,first) [lindex $xSpec 0] set data(x,last) [lindex $xSpec 1] set data(y,first) [lindex $ySpec 0] set data(y,last) [lindex $ySpec 1] } set needX [tixScrolledWidget:NeedScrollbar $w x] set needY [tixScrolledWidget:NeedScrollbar $w y] if {[winfo ismapped $w]==0} { return "$needX$needY" } if {$needX && $needY} { return 11 } if {$needX == 0 && $needY == 0} { return 00 } if {$needX} { set mH [expr $mH - $scbH] } if {$needY} { set mW [expr $mW - $scbW] } set info [tixCallMethod $w GeometryInfo $mW $mH] if {$info != ""} { set xSpec [lindex $info 0] set ySpec [lindex $info 1] set data(x,first) [lindex $xSpec 0] set data(x,last) [lindex $xSpec 1] set data(y,first) [lindex $ySpec 0] set data(y,last) [lindex $ySpec 1] } set needX [tixScrolledWidget:NeedScrollbar $w x] set needY [tixScrolledWidget:NeedScrollbar $w y] return "$needX$needY" }