view release on metacpan or  search on metacpan

lib/GSM/Gnokii/Tk/GSMTree.pm  view on Meta::CPAN

package GSM::Gnokii::Tk::GSMTree;

# Derived from DirTree.pm

use strict;
use warnings;

our $VERSION = "0.02";

use Carp;

use GSM::Gnokii;
use Tk;
use Tk::Widget;
use Tk::Derived;
use Tk::Tree;

use vars qw( @ISA );
@ISA = qw( Tk::Derived Tk::Tree );

Construct Tk::Widget "GSMTree";

use List::Util qw( first );
use Data::Peek;

my %def_conf = (
    root	=> undef,
    gsm		=> undef,
    memtype	=> "ME",
    );

sub Populate
{
    my ($w, $args) = @_;

    # print STDERR "Populate ...\n";
    my $data = $w->privateData;
    %$data = %def_conf;

    if (ref $args eq "HASH") {
	my %args = %$args;
	foreach my $arg (keys %args) {
	    (my $attr = $arg) =~ s/^-//;
	    exists $data->{$attr} and $data->{$attr} = delete $args{$arg};
	    }
	$args = { %args };
	}
    # DDumper { Data => $data, Args => $args };

    $w->SUPER::Populate ($args);
    $w->ConfigSpecs (
	-dircmd     => [qw( CALLBACK  dirCmd     DirCmd     DirCmd	)],
	-showhidden => [qw( PASSIVE   showHidden ShowHidden 0		)],
	-image      => [qw( PASSIVE   image      Image      folder	)],
	-directory  => [qw( SETMETHOD directory  Directory  .		)],
	-value      => "-directory"
	);

    $w->configure (
	-separator => "/",
	-itemtype  => "imagetext",
	);

    $data->{root} //= $w->add_to_tree ("/", $data->{memtype} // "ME");
    } # Populate

sub configure
{
    my ($w, %cnf) = @_;
    # print STDERR "configure ...\n";
    delete @cnf{map { ( $_, "-$_" ) } keys %{$w->privateData}};
    $w->SUPER::configure (%cnf);
    } # configure

my %mt = ( A => "ME", B => "SM" );
my %dt;
my %fi;

sub _cleanpath