python-2.5.2/win32/tcl/tix8.4/VTree.tcl
changeset 0 ae805ac0140d
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tix8.4/VTree.tcl	Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,195 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: VTree.tcl,v 1.6 2004/03/28 02:44:57 hobbs Exp $
+#
+# VTree.tcl --
+#
+#	Virtual base class for Tree widgets.
+#
+#
+# Copyright (c) 1993-1999 Ioi Kim Lam.
+# Copyright (c) 2000-2001 Tix Project Group.
+# Copyright (c) 2004 ActiveState
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixVTree {
+    -virtual true
+    -classname TixVTree
+    -superclass tixScrolledHList
+    -method {
+    }
+    -flag {
+	-ignoreinvoke
+    }
+    -configspec {
+	{-ignoreinvoke ignoreInvoke IgnoreInvoke false tixVerifyBoolean}
+    }
+    -default {
+    }
+}
+
+proc tixVTree:InitWidgetRec {w} {
+    upvar #0 $w data
+
+    tixChainMethod $w InitWidgetRec
+}
+
+proc tixVTree:ConstructWidget {w} {
+    upvar #0 $w data
+
+    tixChainMethod $w ConstructWidget
+
+    set data(indStyle) \
+	[tixDisplayStyle image -refwindow $data(w:hlist) -padx 0 -pady 0]
+}
+
+proc tixVTree:SetBindings {w} {
+    upvar #0 $w data
+
+    tixChainMethod $w SetBindings
+
+    $data(w:hlist) config \
+	-indicatorcmd [list tixVTree:IndicatorCmd $w] \
+	-browsecmd [list tixVTree:BrowseCmdHook $w] \
+	-command [list tixVTree:CommandHook $w]
+}
+
+proc tixVTree:IndicatorCmd {w args} {
+    upvar #0 $w data
+
+    set event [tixEvent type]
+    set ent   [tixEvent flag V]
+
+    set type     [tixVTree:GetType $w $ent]
+    set plus	 [tix getimage plus]
+    set plusarm	 [tix getimage plusarm]
+    set minus	 [tix getimage minus]
+    set minusarm [tix getimage minusarm]
+
+    if {![$data(w:hlist) info exists $ent]} {return}
+    switch -exact -- $event {
+	<Arm> {
+	    if {![$data(w:hlist) indicator exists $ent]} {return}
+	    $data(w:hlist) indicator config $ent \
+		-image [expr {$type eq "open" ? $plusarm : $minusarm}]
+	}
+	<Disarm> {
+	    if {![$data(w:hlist) indicator exists $ent]} {return}
+	    $data(w:hlist) indicator config $ent \
+		-image [expr {$type eq "open" ? $plus : $minus}]
+	}
+	<Activate> {
+	    upvar bind bind
+	    tixCallMethod $w Activate $ent $type
+	    set bind(%V) $ent
+	    tixVTree:BrowseCmdHook $w
+	}
+    }
+}
+
+proc tixVTree:GetType {w ent} {
+    upvar #0 $w data
+
+    if {![$data(w:hlist) indicator exists $ent]} {
+	return none
+    }
+
+    set img [$data(w:hlist) indicator cget $ent -image]
+    if {$img eq [tix getimage plus] || $img eq [tix getimage plusarm]} {
+	return open
+    }
+    return close
+}
+
+proc tixVTree:Activate {w ent type} {
+    upvar #0 $w data
+
+    if {$type eq "open"} {
+	tixCallMethod $w OpenCmd $ent
+	$data(w:hlist) indicator config $ent -image [tix getimage minus]
+    } else {
+	tixCallMethod $w CloseCmd $ent
+	$data(w:hlist) indicator config $ent -image [tix getimage plus]
+    }
+}
+
+proc tixVTree:CommandHook {w args} {
+    upvar #0 $w data
+    upvar bind bind
+
+    tixCallMethod $w Command bind
+}
+
+proc tixVTree:BrowseCmdHook {w args} {
+    upvar #0 $w data
+    upvar bind bind
+
+    tixCallMethod $w BrowseCmd bind
+}
+
+proc tixVTree:SetMode {w ent mode} {
+    upvar #0 $w data
+
+    switch -exact -- $mode {
+	open {
+	    $data(w:hlist) indicator create $ent -itemtype image \
+		-image [tix getimage plus]  -style $data(indStyle)
+	}
+	close {
+	    $data(w:hlist) indicator create $ent -itemtype image \
+		-image [tix getimage minus] -style $data(indStyle)
+	}
+	none {
+	    if {[$data(w:hlist) indicator exist $ent]} {
+		$data(w:hlist) indicator delete $ent 
+	    }
+	}
+    }
+}
+
+#----------------------------------------------------------------------
+#
+#			Virtual Methods
+#
+#----------------------------------------------------------------------
+proc tixVTree:OpenCmd {w ent} {
+    upvar #0 $w data
+
+    # The default action
+    foreach kid [$data(w:hlist) info children $ent] {
+	$data(w:hlist) show entry $kid
+    }
+}
+
+proc tixVTree:CloseCmd {w ent} {
+    upvar #0 $w data
+
+    # The default action
+    foreach kid [$data(w:hlist) info children $ent] {
+	$data(w:hlist) hide entry $kid
+    }
+}
+
+proc tixVTree:Command {w B} {
+    upvar #0 $w data
+    upvar $B bind
+
+    if {$data(-ignoreinvoke)} {
+	return
+    }
+    set ent [tixEvent flag V]
+    if {[$data(w:hlist) indicator exist $ent]} {
+	tixVTree:Activate $w $ent [tixVTree:GetType $w $ent]
+    }
+}
+
+proc tixVTree:BrowseCmd {w B} {
+}
+#----------------------------------------------------------------------
+#
+#			Widget commands
+#
+#----------------------------------------------------------------------