# -*- 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 { { if {![$data(w:hlist) indicator exists $ent]} {return} $data(w:hlist) indicator config $ent \ -image [expr {$type eq "open" ? $plusarm : $minusarm}] } { if {![$data(w:hlist) indicator exists $ent]} {return} $data(w:hlist) indicator config $ent \ -image [expr {$type eq "open" ? $plus : $minus}] } { 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 # #----------------------------------------------------------------------