AlkantarClanX12
Current Path : /lib64/tcl8.6/Tix8.4.3/ |
Current File : //lib64/tcl8.6/Tix8.4.3/Tree.tcl |
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*- # # $Id: Tree.tcl,v 1.7 2004/04/09 21:39:12 hobbs Exp $ # # Tree.tcl -- # # This file implements the TixTree widget. # # 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 tixTree { -classname TixTree -superclass tixVTree -method { autosetmode close getmode open setmode addchild anchor column delete entrycget entryconfigure header hide indicator info item nearest see selection show } -flag { -browsecmd -command -opencmd -closecmd } -configspec { {-browsecmd browseCmd BrowseCmd ""} {-command command Command ""} {-closecmd closeCmd CloseCmd ""} {-opencmd openCmd OpenCmd ""} } -default { {.scrollbar auto} {*Scrollbar.takeFocus 0} {*borderWidth 1} {*hlist.background #c3c3c3} {*hlist.drawBranch 1} {*hlist.height 10} {*hlist.highlightBackground #d9d9d9} {*hlist.indicator 1} {*hlist.indent 20} {*hlist.itemType imagetext} {*hlist.padX 2} {*hlist.padY 2} {*hlist.relief sunken} {*hlist.takeFocus 1} {*hlist.wideSelection 0} {*hlist.width 20} } } proc tixTree:InitWidgetRec {w} { upvar #0 $w data tixChainMethod $w InitWidgetRec } proc tixTree:ConstructWidget {w} { upvar #0 $w data tixChainMethod $w ConstructWidget } proc tixTree:SetBindings {w} { upvar #0 $w data tixChainMethod $w SetBindings } #---------------------------------------------------------------------- # # Widget commands # #---------------------------------------------------------------------- proc tixTree:autosetmode {w} { tixTree:SetModes $w "" } proc tixTree:close {w ent} { upvar #0 $w data set type [tixVTree:GetType $w $ent] if {$type == "close"} { tixCallMethod $w Activate $ent $type } } proc tixTree:open {w ent} { upvar #0 $w data set type [tixVTree:GetType $w $ent] if {$type == "open"} { tixCallMethod $w Activate $ent $type } } proc tixTree:getmode {w ent} { tixVTree:GetType $w $ent } proc tixTree:setmode {w ent mode} { tixVTree:SetMode $w $ent $mode } foreach cmd { addchild anchor column delete entrycget entryconfigure header hide indicator info item nearest see selection show } { proc tixTree:$cmd {w args} { # These are hlist passthrough methods to work around # Tix' ignorant inheritance model. upvar #0 $w data set cmd [lindex [split [lindex [info level 0] 0] :] end] uplevel 1 [linsert $args 0 $data(w:hlist) $cmd] } } unset cmd #---------------------------------------------------------------------- # # Private Methods # #---------------------------------------------------------------------- proc tixTree:SetModes {w ent} { upvar #0 $w data set mode none if {$ent == ""} { set children [$data(w:hlist) info children] } else { set children [$data(w:hlist) info children $ent] } if {$children != ""} { set mode close foreach c $children { if {[$data(w:hlist) info hidden $c]} { set mode open } tixTree:SetModes $w $c } } if {$ent != ""} { tixVTree:SetMode $w $ent $mode } } #---------------------------------------------------------------------- # # Virtual Methods # #---------------------------------------------------------------------- proc tixTree:OpenCmd {w ent} { upvar #0 $w data if {$data(-opencmd) != ""} { tixTree:CallSwitchCmd $w $data(-opencmd) $ent } else { tixChainMethod $w OpenCmd $ent } } proc tixTree:CloseCmd {w ent} { upvar #0 $w data if {$data(-closecmd) != ""} { tixTree:CallSwitchCmd $w $data(-closecmd) $ent } else { tixChainMethod $w CloseCmd $ent } } # Call the opencmd or closecmd, depending on the mode ($cmd argument) # proc tixTree:CallSwitchCmd {w cmd ent} { upvar #0 $w data set bind(specs) {%V} set bind(%V) $ent tixEvalCmdBinding $w $cmd bind $ent } proc tixTree:Command {w B} { upvar #0 $w data upvar $B bind tixChainMethod $w Command $B set ent [tixEvent flag V] if {$data(-command) != ""} { tixEvalCmdBinding $w $data(-command) bind $ent } } proc tixTree:BrowseCmd {w B} { upvar #0 $w data set ent [tixEvent flag V] if {$data(-browsecmd) != ""} { tixEvalCmdBinding $w $data(-browsecmd) "" $ent } }