view release on metacpan or  search on metacpan

Pod/Tree.pm  view on Meta::CPAN

    (my $parent = $entry) =~ s|/[^/]+$||; # XXX SEP?
    return if $parent eq '' || $parent eq $entry;
    $w->_open_parents($parent);
    $w->open($parent);
}

=item I<$tree>-E<gt>B<SeePath>($path)

Move the anchor/selection and view to the given C<$path> and open
subtrees to make the C<$path> visible, if necessary.

=cut

sub SeePath {
    my($w,$path) = @_;
    my $fs_case_tolerant =
	($^O eq 'MSWin32' ||
	 $^O eq 'darwin' || # case_tolerant=0 here!
	 (File::Spec->can("case_tolerant") && File::Spec->case_tolerant)
	);
    if ($^O eq 'MSWin32') {
	$path =~ s/\\/\//g;
    }
    if ($fs_case_tolerant) {
	$path = lc $path;
    }
    DEBUG and warn "Call SeePath with $path\n";
    return if !$w->Filled; # not yet filled
    my $pods = $w->{Pods};
    return if !$pods;

    my $see_treepath = sub {
	my $treepath = shift;
	$w->open($treepath);
	$w->_open_parents($treepath);
	$w->anchorSet($treepath);
	$w->selectionClear;
	$w->selectionSet($treepath);
	$w->see($treepath);
    };

    foreach my $category (keys %$pods) {
	foreach my $pod (keys %{ $pods->{$category} }) {
	    my $podpath = $pods->{$category}->{$pod};
	    $podpath = lc $podpath if $fs_case_tolerant;
	    if ($path eq $podpath) {
		my $treepath = $category . SEP . $pod;
		$see_treepath->($treepath);
		return 1;
	    }
	}
    }
    DEBUG and warn "SeePath: cannot find $path in tree\n";
    0;
}

sub GetCurrentPodPath {
    my $w = shift;
    my $sel_entry = ($w->selectionGet)[0];
    if (defined $sel_entry) {
	my @c = split m{/}, $sel_entry;
	shift @c;
	my $pod = join "::", @c;
	return $pod;
    }
}

sub search_dialog {
    my($w) = @_;
    my $t = $w->Toplevel(-title => "Search");
    $t->transient($w);
    $t->Label(-text => "Search module:")->pack(-side => "left");
    my $term;

    my $Entry = 'Entry';
    eval {
	require Tk::HistEntry;
	Tk::HistEntry->VERSION(0.40);
	$Entry = "HistEntry";
    };

    my $e = $t->$Entry(-textvariable => \$term)->pack(-side => "left");
    if ($e->can('history') && $search_history) {
	$e->history($search_history);
    }
    $e->focus;
    $e->bind("<Escape>" => sub { $t->destroy });

    my $do_search = sub {
	if ($e->can('historyAdd')) {
	    $e->historyAdd($term);
	    $search_history = [ $e->history ];
	}
	$w->search($term);
    };

    $e->bind("<Return>" => $do_search);

    {
	my $f = $t->Frame->pack(-fill => "x");
	Tk::grid($f->Button(-text => "Search",
			    -command => $do_search,
			   ),
		 $f->Button(-text => "Close",
			    -command => sub { $t->destroy },
			   ),
		 -sticky => "ew");
    }
}

sub search {
    my($w, $rx) = @_;
    return if $rx eq '';
    my($entry) = ($w->info('selection'))[0];
    if (!defined $entry) {
	$entry = ($w->info('children'))[0];
	return if (!defined $entry);
    }
    my $wrapped = 0;
    while(1) {
	$entry = $w->info('next', $entry);