How do I close all Tk::Tree

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

I'm using the following code snippet:

#!/usr/bin/perl

use warnings;
use Tk;
use Tk::Tree;

Create_Items();    
Configure_Items(); 
TreeConfigure(); 
Add_Dirs(); 
MainLoop();

sub Create_Items
{
    $Toplevel = new MainWindow;
    $Frame    = $Toplevel->Frame();
    $BFrame = $Toplevel->Frame();
    $Label = $Frame->Label();
    $Tree = $Frame->Scrolled('Tree', -scrollbars => 'ose');
    $Ok = $BFrame->Button(-text => 'Okay');
}

sub Configure_Items
{
    $Toplevel->configure
    (
        -title          => 'Dir. Listing',
        -relief      =>    'ridge',
        -borderwidth =>    5,
    );        
        
    $Label->configure
    (
        -text    => 'Dir. Listing',
        -padx    => 50,
        -relief    => 'ridge',
    );
        
    $Ok->configure
    (
        -relief    => 'raised',
        -padx    => 5,
        -pady    => 5,
        -width    => 10,
        -highlightcolor    => 'OrangeRed2',
        -command => sub { $Toplevel->destroy(); },
    );

    $Frame->configure(-relief => 'ridge', -bd => 1);    
    $Frame->pack(-padx => 10, -pady    => 20);
    $BFrame->pack(-padx => 10, -pady => 20);
    $Label->pack(-side => 'top');
    $Tree->pack
    (
        -side   => 'left',
        -ipadx  => 10,
        -ipady  => 30,
        -padx   => 10,
        -pady   => 10,
        -expand => 'yes',
        -fill   => 'both'
    );

    $Ok->pack(-side    => 'left', -padx => 5, -pady =>    5, -fill => 
+'both');
}

sub TreeConfigure
{
    $Tree->configure
    (
        -separator => "/",
        -height       => '20',
        -width       => '55',

        -drawbranch => 'true',
        -indent        => '20',
        -indicator  => 'true',

        -selectborderwidth => '1',
        -selectmode => 'single',
        -bg =>  'white',

        -highlightcolor    => 'black',
        -borderwidth =>    2,
    );
    $Tree->focus();
}

# Here we simply add static data. However the entire data can be dynam
+ic
# too. ie. Get Dir. name & recursively get all contents.
sub Add_Dirs
{
    my $tree = '/home';
    my ($File, $Temp, @Dir_List);
    @Dir_List =
    (
        '/',
        '/one',
        '/one/two',
        '/two',
        '/two/three',
        '/three',
        '/three/four',
        '/three/four/five',
        '/three/four/five/six',
    );

    $Col = 0;
    
    foreach $File (@Dir_List)
    {
        $Temp = (split('/', $File))[-1];
        $Temp = $File if ($Temp eq '');
        $Tree->add($File);
        $Tree->itemCreate 
        (
            $File, $Col,
            -text => $Temp,
            -itemtype => 'text',
        );
    }

#    $Tree->autosetmode;
    $Tree->setmode($Dir_List[0]);
#    $Tree->close($Dir_List[0]);
#    $Tree->close($Dir_List[1]);
}
[download]

Does anyone know if it's possible to close every branch of the tree, so there is a plus sign beside each branch?

Comment on How do I close all Tk::Tree Download Code

Replies are listed 'Best First'.
Re: How do I close all Tk::Tree by hiseldl (Priest) on Mar 31, 2003 at 18:07 UTC
Basically you have to hide every node except the root node, and then call autosetmode(). `sub Add_Dirs { my $tree = '/home'; my ($File, $Temp, @Dir_List); @Dir_List = ( '/', '/one', '/one/two', '/two', '/two/three', '/three', '/three/four', '/three/four/five', '/three/four/five/six', ); foreach $File (@Dir_List) { $Temp = (split('/', $File))[-1]; $Temp = $File unless defined $Temp; $Tree->add($File, -text => "$Temp"); $Tree->hide(entry=>$File); } $Tree->show(entry=>$Dir_List[0]); $Tree->autosetmode(); }` [download] This starts out with a (+) beside the root node, then when you expand the root node shows the next level in the tree each with a (+), then when you expand each node, it will show its children with a (+), etc. -- hiseldl What time is it? It's Camel Time!	[reply] [d/l]
Re: Re: How do I close all Tk::Tree by Anonymous Monk on Mar 31, 2003 at 18:22 UTC
Excellent, Thats what I was looking for. Thanks again!	[reply]


Perl-Sensitive Sunglasses
	PerlMonks