D7net
Home
Console
Upload
information
Create File
Create Folder
About
Tools
:
/
proc
/
self
/
root
/
proc
/
self
/
root
/
lib64
/
tcl8.6
/
Tix8.4.3
/
Filename :
VStack.tcl
back
Copy
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*- # # $Id: VStack.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $ # # VStack.tcl -- # # Virtual base class, do not instantiate! This is the core # class for all NoteBook style widgets. Stack maintains a list # of windows. It provides methods to create, delete windows as # well as stepping through them. # # 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 tixVStack { -virtual true -classname TixVStack -superclass tixPrimitive -method { add delete pageconfigure pagecget pages raise raised } -flag { -dynamicgeometry -ipadx -ipady } -configspec { {-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean} {-ipadx ipadX Pad 0} {-ipady ipadY Pad 0} } } proc tixVStack:InitWidgetRec {w} { upvar #0 $w data tixChainMethod $w InitWidgetRec set data(pad-x1) 0 set data(pad-x2) 0 set data(pad-y1) 0 set data(pad-y2) 0 set data(windows) "" set data(nWindows) 0 set data(topchild) "" set data(minW) 1 set data(minH) 1 set data(w:top) $w set data(counter) 0 set data(repack) 0 } proc tixVStack:SetBindings {w} { upvar #0 $w data tixChainMethod $w SetBindings tixCallMethod $w InitGeometryManager } #---------------------------------------------------------------------- # Public methods #---------------------------------------------------------------------- proc tixVStack:add {w child args} { upvar #0 $w data set validOptions {-createcmd -raisecmd} set opt(-createcmd) "" set opt(-raisecmd) "" tixHandleOptions -nounknown opt $validOptions $args set data($child,raisecmd) $opt(-raisecmd) set data($child,createcmd) $opt(-createcmd) set data(w:$child) [tixCallMethod $w CreateChildFrame $child] lappend data(windows) $child incr data(nWindows) 1 return $data(w:$child) } proc tixVStack:delete {w child} { upvar #0 $w data if {[info exists data($child,createcmd)]} { if {[winfo exists $data(w:$child)]} { bind $data(w:$child) <Destroy> {;} destroy $data(w:$child) } catch {unset data($child,createcmd)} catch {unset data($child,raisecmd)} catch {unset data(w:$child)} set index [lsearch $data(windows) $child] if {$index >= 0} { set data(windows) [lreplace $data(windows) $index $index] incr data(nWindows) -1 } if {[string equal $data(topchild) $child]} { set data(topchild) "" foreach page $data(windows) { if {$page ne $child} { $w raise $page set data(topchild) $page break } } } } else { error "page $child does not exist" } } proc tixVStack:pagecget {w child option} { upvar #0 $w data if {![info exists data($child,createcmd)]} { error "page \"$child\" does not exist in $w" } case $option { -createcmd { return "$data($child,createcmd)" } -raisecmd { return "$data($child,raisecmd)" } default { if {$data(w:top) ne $w} { return [$data(w:top) pagecget $child $option] } else { error "unknown option \"$option\"" } } } } proc tixVStack:pageconfigure {w child args} { upvar #0 $w data if {![info exists data($child,createcmd)]} { error "page \"$child\" does not exist in $w" } set len [llength $args] if {$len == 0} { set value [$data(w:top) pageconfigure $child] lappend value [list -createcmd "" "" "" $data($child,createcmd)] lappend value [list -raisecmd "" "" "" $data($child,raisecmd)] return $value } if {$len == 1} { case [lindex $args 0] { -createcmd { return [list -createcmd "" "" "" $data($child,createcmd)] } -raisecmd { return [list -raisecmd "" "" "" $data($child,raisecmd)] } default { return [$data(w:top) pageconfigure $child [lindex $args 0]] } } } # By default handle each of the options # set opt(-createcmd) $data($child,createcmd) set opt(-raisecmd) $data($child,raisecmd) tixHandleOptions -nounknown opt {-createcmd -raisecmd} $args # # the widget options set new_args "" foreach {flag value} $args { if {$flag ne "-createcmd" && $flag ne "-raisecmd"} { lappend new_args $flag lappend new_args $value } } if {[llength $new_args] >= 2} { eval $data(w:top) pageconfig $child $new_args } # # The add-on options set data($child,raisecmd) $opt(-raisecmd) set data($child,createcmd) $opt(-createcmd) return "" } proc tixVStack:pages {w} { upvar #0 $w data return $data(windows) } proc tixVStack:raise {w child} { upvar #0 $w data if {![info exists data($child,createcmd)]} { error "page $child does not exist" } if {[llength $data($child,createcmd)]} { uplevel #0 $data($child,createcmd) set data($child,createcmd) "" } tixCallMethod $w RaiseChildFrame $child set oldTopChild $data(topchild) set data(topchild) $child if {$oldTopChild ne $child} { if {[llength $data($child,raisecmd)]} { uplevel #0 $data($child,raisecmd) } } } proc tixVStack:raised {w} { upvar #0 $w data return $data(topchild) } #---------------------------------------------------------------------- # Virtual Methods #---------------------------------------------------------------------- proc tixVStack:InitGeometryManager {w} { upvar #0 $w data bind $w <Configure> "tixVStack:MasterGeomProc $w" bind $data(w:top) <Destroy> "+tixVStack:DestroyTop $w" if {$data(repack) == 0} { set data(repack) 1 tixWidgetDoWhenIdle tixCallMethod $w Resize } } proc tixVStack:CreateChildFrame {w child} { upvar #0 $w data set f [frame $data(w:top).$child] tixManageGeometry $f "tixVStack:ClientGeomProc $w" bind $f <Configure> "tixVStack:ClientGeomProc $w -configure $f" bind $f <Destroy> "$w delete $child" return $f } proc tixVStack:RaiseChildFrame {w child} { upvar #0 $w data # Hide the original visible window if {$data(topchild) ne "" && $data(topchild) ne $child} { tixUnmapWindow $data(w:$data(topchild)) } set myW [winfo width $w] set myH [winfo height $w] set cW [expr {$myW - $data(pad-x1) - $data(pad-x2) - 2*$data(-ipadx)}] set cH [expr {$myH - $data(pad-y1) - $data(pad-y2) - 2*$data(-ipady)}] set cX [expr {$data(pad-x1) + $data(-ipadx)}] set cY [expr {$data(pad-y1) + $data(-ipady)}] if {$cW > 0 && $cH > 0} { tixMoveResizeWindow $data(w:$child) $cX $cY $cW $cH tixMapWindow $data(w:$child) raise $data(w:$child) } } #---------------------------------------------------------------------- # # G E O M E T R Y M A N A G E M E N T # #---------------------------------------------------------------------- proc tixVStack:DestroyTop {w} { catch { destroy $w } } proc tixVStack:MasterGeomProc {w args} { if {![winfo exists $w]} { return } upvar #0 $w data if {$data(repack) == 0} { set data(repack) 1 tixWidgetDoWhenIdle tixCallMethod $w Resize } } proc tixVStack:ClientGeomProc {w flag client} { if {![winfo exists $w]} { return } upvar #0 $w data if {$data(repack) == 0} { set data(repack) 1 tixWidgetDoWhenIdle tixCallMethod $w Resize } if {$flag eq "-lostslave"} { error "Geometry Management Error: \ Another geometry manager has taken control of $client.\ This error is usually caused because a widget has been created\ in the wrong frame: it should have been created inside $client instead\ of $w" } } proc tixVStack:Resize {w} { if {![winfo exists $w]} { return } upvar #0 $w data if {$data(nWindows) == 0} { set data(repack) 0 return } if {$data(-width) == 0 || $data(-height) == 0} { if {!$data(-dynamicgeometry)} { # Calculate my required width and height # set maxW 1 set maxH 1 foreach child $data(windows) { set cW [winfo reqwidth $data(w:$child)] set cH [winfo reqheight $data(w:$child)] if {$maxW < $cW} { set maxW $cW } if {$maxH < $cH} { set maxH $cH } } set reqW $maxW set reqH $maxH } else { if {$data(topchild) ne ""} { set reqW [winfo reqwidth $data(w:$data(topchild))] set reqH [winfo reqheight $data(w:$data(topchild))] } else { set reqW 1 set reqH 1 } } incr reqW [expr {$data(pad-x1) + $data(pad-x2) + 2*$data(-ipadx)}] incr reqH [expr {$data(pad-y1) + $data(pad-y2) + 2*$data(-ipady)}] if {$reqW < $data(minW)} { set reqW $data(minW) } if {$reqH < $data(minH)} { set reqH $data(minH) } } # These take higher precedence # if {$data(-width) != 0} { set reqW $data(-width) } if {$data(-height) != 0} { set reqH $data(-height) } if {[winfo reqwidth $w] != $reqW || [winfo reqheight $w] != $reqH} { if {![info exists data(counter)]} { set data(counter) 0 } if {$data(counter) < 50} { incr data(counter) tixGeometryRequest $w $reqW $reqH tixWidgetDoWhenIdle tixCallMethod $w Resize set data(repack) 1 return } } set data(counter) 0 if {$data(w:top) ne $w} { tixMoveResizeWindow $data(w:top) 0 0 [winfo width $w] [winfo height $w] tixMapWindow $data(w:top) } if {[string equal $data(topchild) ""]} { set top [lindex $data(windows) 0] } else { set top $data(topchild) } if {$top ne ""} { tixCallMethod $w raise $top } set data(repack) 0 }