summaryrefslogtreecommitdiff
path: root/tix/library/SWindow.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tix/library/SWindow.tcl')
-rw-r--r--tix/library/SWindow.tcl277
1 files changed, 277 insertions, 0 deletions
diff --git a/tix/library/SWindow.tcl b/tix/library/SWindow.tcl
new file mode 100644
index 00000000000..728341a71b2
--- /dev/null
+++ b/tix/library/SWindow.tcl
@@ -0,0 +1,277 @@
+# SWindow.tcl --
+#
+# This file implements Scrolled Window widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# 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.background #d9d9d9}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.width 15}
+ }
+}
+
+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]
+
+ if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
+ set data(w:sizebox) [ide_sizebox $w.sizebox]
+ }
+
+ $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]
+}
View Lorry Controller Status