Mini Shell

# -*- 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]
}