view release on metacpan or  search on metacpan

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

    $path =~ s{/\.(/|$)}{/};	# /. & /./ => /
    $path =~ s{/+\*?$}{};	# /foo/ & /foo/* => /foo
    $path =~ s{^$}{/};
    $path;
    } # _cleanpath

sub DirCmd
{
    my ($w, $dir, $showhidden) = @_;
    my $pd = $w->privateData;
    my $mt = ($dir =~ s{^([AB]):}{}) ? $mt{$1} : $pd->{memtype} // "ME";
    $dir = _cleanpath ($dir);
    # print STDERR "DirCmd ($mt, $dir, 1)\n";
    my $dt;
    if ($dt{$mt}{$dir}) {
	# print STDERR "Get from cache\n";
	$dt = $dt{$mt}{$dir};
	}
    else {
	(my $gdir = $dir) =~ s{/+$}{};
	$gdir =~ s{/}{\\}g;
	$dt = $pd->{gsm}->GetDir ($mt, $gdir, 1) or return;
	ref $dt eq "HASH"                        or return;
	# Clean up
	if ($dt->{tree} && ref $dt->{tree} eq "ARRAY") {
	    my @tree = grep { $_->{id} } @{$dt->{tree}};
	    if (@tree) {
		$dt->{tree} = \@tree;
		}
	    else {
		delete $dt->{tree};
		}
	    }
	$dt{$mt}{$dir} = $dt;	# Cache!
	}
    my @names = map { $_->{name} } @{$dt{$mt}{$dir}{tree}//[]} or return;
    # print STDERR "Names: (@names)\n";
    $showhidden or @names = grep !m/^[.]/ => @names;
    return @names;
    } # DirCmd
*dircmd = \&DirCmd;

sub directory
{
    my ($w, $key, $val) = @_;
    # print STDERR "directory ...\n";
    # We need a value for -image, so its being undefined is probably caused
    # by order of handling config defaults so defer it.
    #$w->afterIdle ([$w, "set_dir" => $val]);
    } # directory

sub set_dir
{
    my ($w, $val) = @_;
    # print STDERR "set_dir ($val)\n";
    my $fulldir = _cleanpath ($val);


    my $parent = "/";
    my @dirs = ("");#$parent);
    for (split m{/+} => $fulldir) {
	length or next;
	push @dirs, $_;
	my $dir = _cleanpath (join "/" => @dirs);
	$dir eq "/" and next;
	$w->infoExists ($dir) or $w->add_to_tree ($dir, $_, $parent);
	$parent = $dir;
	}

    $w->OpenCmd ($parent);
    $w->setmode ($parent, "close");
    } # set_dir
*chdir = \&set_dir;

sub OpenCmd
{
    my ($w, $dir) = @_;

    # print STDERR "OpenCmd ($dir)\n";
    my $parent = $dir;
    foreach my $name ($w->dirnames ($parent)) {
	$name eq "." || $name eq ".." || $name eq "/" and next;
	my $subdir = _cleanpath ("$dir/$name");
	# print STDERR "> OpenCmd ($subdir)\n";
	# $dt{$mt}{$dir} or $w->DirCmd ($subdir, 0);
	if ($w->infoExists ($subdir)) {
	    $w->show (-entry => $subdir);
	    }
	else {
	    $w->add_to_tree ($subdir, $name, $parent);
	    }
	}
    } # OpenCmd
*opencmd = \&OpenCmd;

sub add_to_tree
{
    my ($w, $dir, $name, $parent) = @_;

    # printf STDERR "Add (%-20s  %-20s %s\n", $dir, $name, $parent // "--undef--";
    my $image;# = $w->cget ("-image");
#   UNIVERSAL::isa ($image, "Tk::Image") or
#	$image = $w->Getimage ($image);

    my $mode = "none";
    $w->has_subdir ($dir) and $mode = "open";

    my @args = (-image => $image, -text => $name);
    if ($parent) {    # Add in alphabetical order.
	foreach my $sib ($w->infoChildren ($parent)) {
	    if ($sib gt $dir) {
		push @args, (-before => $sib);
		last;
		}
	    }
	}

    $w->add ($dir, @args);
    $w->setmode ($dir, $mode);
    } # add_to_tree