# Save this code to a file called MyTkUtils.pm.
# Then from your main script, add "use MyTkUtils".

package Tk::Widget;

use strict;

sub full_name {
    my($w) = @_;
    my @name = ( );

    while (ref $w) {
	unshift @name, $w->name;
	$w = $w->parent;
    }

    join('.', @name);
}

sub direct_descendant {
    my ($w, $path) = @_;

    return unless ($w && defined $path);

    my @path = split(/[,.]/, $path);
    my @children = $w->children;

    if (@path) {
	while (@children) {
	    my $child = pop @children;

	    if ($child->name eq $path[0]) {
		shift @path;

		return $child if (!@path);

		$w = $child;
		@children = $w->children;
	    }
	}
    }
}

sub _r_list_descendant_names {
    my ($w, $w_name, $separator, $descendants) = @_;

    foreach my $child ($w->children) {
	my $child_name = $w_name . $separator . $child->name;
	push @{$descendants}, $child_name;
	_r_list_descendant_names($child, $child_name, $separator, $descendants);
    }
}

sub list_descendant_names {
    my ($w, $separator) = @_;

    $separator ||= '.';
    my @descendants = ( );

    foreach my $child ($w->children) {
	my $child_name = $child->name;
	push @descendants, $child_name;
	_r_list_descendant_names($child, $child_name, $separator, \@descendants);
    }

    @descendants;
}

sub descendant {
    my ($w, $path) = @_;

    my @names = ( );

    $path =~ s|\.|,|g;

    if ($path =~ m|\*|) {
	$path =~ s|\*+|,(\\w+,)*|g;
	$path =~ s|-|_|g;
	$path =~ s|,+|,|g;
	$path =~ s|^,||;
	$path =~ s|,$||;

	@names = grep(/^$path$/, list_descendant_names($w, ','));
    }
    else {
	$path =~ s|-|_|g;
	$path =~ s|,+|,|g;
	$path =~ s|^,||;
	$path =~ s|,$||;

	@names = ( $path );
    }

    if (!wantarray) {
	return direct_descendant($w, $names[0]);
    }
    else {
	my @widgets = ( );
	foreach (@names) {
	    my $widget = direct_descendant($w, $_);
	    push @widgets, $widget if (ref $widget);
	}
	return @widgets;
    }
}

sub ancestor {
    my ($w, $name) = @_;

    while (ref $w) {
	return $w if ($w->name eq $name);
	$w = $w->parent;
    }
}

1;