/usr/lib64/tcl8.5/Tix8.4.3
Edit: /usr/lib64/tcl8.5/Tix8.4.3/SWindow.tcl (6908B)
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SWindow.tcl,v 1.4 2001/12/09 05:04:02 idiscovery Exp $
#
# SWindow.tcl --
#
# This file implements Scrolled Window 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.
#
#
#
# Example:
#
# tixScrolledWindow .w
# set window [.w subwidget window]
# # Now you can put a whole widget hierachy inside $window.
# #
# button $window.b
# pack $window.b
#
# Author's note
#
# Note, the current implementation does not allow the child window
# to be outside of the parent window when the parent's size is larger
# than the child's size. This is fine for normal operations. However,
# it is not suitable for an MDI master window. Therefore, you will notice
# that the MDI master window is not a subclass of ScrolledWidget at all.
#
#
tixWidgetClass tixScrolledWindow {
-classname TixScrolledWindow
-superclass tixScrolledWidget
-method {
}
-flag {
-expandmode -shrink -xscrollincrement -yscrollincrement
}
-static {
}
-configspec {
{-expandmode expandMode ExpandMode expand}
{-shrink shrink Shrink ""}
{-xscrollincrement xScrollIncrement ScrollIncrement ""}
{-yscrollincrement yScrollIncrement ScrollIncrement ""}
{-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
}
-default {
{.scrollbar auto}
{*window.borderWidth 1}
{*f1.borderWidth 1}
{*Scrollbar.borderWidth 1}
{*Scrollbar.takeFocus 0}
}
}
proc tixScrolledWindow:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(dx) 0
set data(dy) 0
}
proc tixScrolledWindow:ConstructWidget {w} {
upvar #0 $w data
global tcl_platform
tixChainMethod $w ConstructWidget
set data(pw:f1) \
[frame $w.f1 -relief sunken]
set data(pw:f2) \
[frame $w.f2 -bd 0]
set data(w:window) \
[frame $w.f2.window -bd 0]
pack $data(pw:f2) -in $data(pw:f1) -expand yes -fill both
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal -takefocus 0]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical -takefocus 0]
# set data(w:pann) \
# [frame $w.pann -bd 2 -relief groove]
$data(pw:f1) config -highlightthickness \
[$data(w:hsb) cget -highlightthickness]
set data(pw:client) $data(pw:f1)
}
proc tixScrolledWindow:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:hsb) config -command "tixScrolledWindow:ScrollBarCB $w x"
$data(w:vsb) config -command "tixScrolledWindow:ScrollBarCB $w y"
tixManageGeometry $data(w:window) "tixScrolledWindow:WindowGeomProc $w"
}
# This guy just keeps asking for a same size as the w:window
#
proc tixScrolledWindow:WindowGeomProc {w args} {
upvar #0 $w data
set rw [winfo reqwidth $data(w:window)]
set rh [winfo reqheight $data(w:window)]
if {$rw != [winfo reqwidth $data(pw:f2)] ||
$rh != [winfo reqheight $data(pw:f2)]} {
tixGeometryRequest $data(pw:f2) $rw $rh
}
}
proc tixScrolledWindow:Scroll {w axis total window first args} {
upvar #0 $w data
case [lindex $args 0] {
"scroll" {
set amt [lindex $args 1]
set unit [lindex $args 2]
case $unit {
"units" {
set incr $axis\scrollincrement
if {$data(-$incr) != ""} {
set by $data(-$incr)
} else {
set by [expr $window / 16]
}
set first [expr $first + $amt * $by]
}
"pages" {
set first [expr $first + $amt * $window]
}
}
}
"moveto" {
set to [lindex $args 1]
set first [expr int($to * $total)]
}
}
if {[expr $first + $window] > $total} {
set first [expr $total - $window]
}
if {$first < 0} {
set first 0
}
return $first
}
proc tixScrolledWindow:ScrollBarCB {w axis args} {
upvar #0 $w data
set bd \
[expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
set fw [expr [winfo width $data(pw:f1)] - 2*$bd]
set fh [expr [winfo height $data(pw:f1)] - 2*$bd]
set ww [winfo reqwidth $data(w:window)]
set wh [winfo reqheight $data(w:window)]
if {$axis == "x"} {
set data(dx) \
[eval tixScrolledWindow:Scroll $w $axis $ww $fw $data(dx) $args]
} else {
set data(dy) \
[eval tixScrolledWindow:Scroll $w $axis $wh $fh $data(dy) $args]
}
tixWidgetDoWhenIdle tixScrolledWindow:PlaceWindow $w
}
proc tixScrolledWindow:PlaceWindow {w} {
upvar #0 $w data
set bd \
[expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
set fw [expr [winfo width $data(pw:f1)] - 2*$bd]
set fh [expr [winfo height $data(pw:f1)] - 2*$bd]
set ww [winfo reqwidth $data(w:window)]
set wh [winfo reqheight $data(w:window)]
tixMapWindow $data(w:window)
if {$data(-expandmode) == "expand"} {
if {$ww < $fw} {
set ww $fw
}
if {$wh < $fh} {
set wh $fh
}
}
if {$data(-shrink) == "x"} {
if {$fw < $ww} {
set ww $fw
}
}
tixMoveResizeWindow $data(w:window) -$data(dx) -$data(dy) $ww $wh
set first [expr $data(dx).0 / $ww.0]
set last [expr $first + ($fw.0 / $ww.0)]
$data(w:hsb) set $first $last
set first [expr $data(dy).0 / $wh.0]
set last [expr $first + ($fh.0 / $wh.0)]
$data(w:vsb) set $first $last
}
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#
# When this function is called, the scrolled window is going to be
# mapped, if it is still unmapped. Also, it is going to change its
# size. Therefore, it is a good time to check whether the w:window needs
# to be re-positioned due to the new parent window size.
#----------------------------------------------------------------------
proc tixScrolledWindow:GeometryInfo {w mW mH} {
upvar #0 $w data
set bd \
[expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
set fw [expr $mW -2*$bd]
set fh [expr $mH -2*$bd]
set ww [winfo reqwidth $data(w:window)]
set wh [winfo reqheight $data(w:window)]
# Calculate the X info
#
if {$fw >= $ww} {
if {$data(dx) > 0} {
set data(dx) 0
}
set xinfo [list 0.0 1.0]
} else {
set maxdx [expr $ww - $fw]
if {$data(dx) > $maxdx} {
set data(dx) $maxdx
}
set first [expr $data(dx).0 / $ww.0]
set last [expr $first + ($fw.0 / $ww.0)]
set xinfo [list $first $last]
}
# Calculate the Y info
#
if {$fh >= $wh} {
if {$data(dy) > 0} {
set data(dy) 0
}
set yinfo [list 0.0 1.0]
} else {
set maxdy [expr $wh - $fh]
if {$data(dy) > $maxdy} {
set data(dy) $maxdy
}
set first [expr $data(dy).0 / $wh.0]
set last [expr $first + ($fh.0 / $wh.0)]
set yinfo [list $first $last]
}
return [list $xinfo $yinfo]
}