466 lines
9.5 KiB
Tcl
466 lines
9.5 KiB
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"
|
||
|
|
}
|
||
|
|
|