# NOTE: Derived from blib/lib/Tk/Widget.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Tk::Widget;

#line 1383 "blib/lib/Tk/Widget.pm (autosplit into blib/lib/auto/Tk/Widget/bindDump.al)"
1;
__END__

sub bindDump {

    # Dump lots of good binding information.  This pretty-print subroutine
    # is, essentially, the following code in disguise:
    #
    # print "Binding information for $w\n";
    # foreach my $tag ($w->bindtags) {
    #     printf "\n Binding tag '$tag' has these bindings:\n";
    #     foreach my $binding ($w->bind($tag)) {
    #         printf "  $binding\n";
    #     }
    # }

    my ($w) = @_;

    my (@bindtags) = $w->bindtags;
    my $digits = length( scalar @bindtags );
    my ($spc1, $spc2) = ($digits + 33, $digits + 35);
    my $format1 = "%${digits}d.";
    my $format2 = ' ' x ($digits + 2);
    my $n = 0;

    print "\n## Binding information for '", $w->PathName, "', $w ##\n";

    foreach my $tag (@bindtags) {
        my (@bindings) = $w->bind($tag);
        $n++;                   # count this bindtag

        if ($#bindings == -1) {
            printf "\n$format1 Binding tag '$tag' has no bindings.\n", $n;
        } else {
            printf "\n$format1 Binding tag '$tag' has these bindings:\n", $n;

            foreach my $binding ( @bindings ) {
                my $callback = $w->bind($tag, $binding);
                printf "$format2%27s : %-40s\n", $binding, $callback;

                if ($callback =~ /SCALAR/) {
                    if (ref $$callback) {
                        printf "%s %s\n", ' ' x $spc1, $$callback;
                    } else {
                        printf "%s '%s'\n", ' ' x $spc1, $$callback;
                    }
                } elsif ($callback =~ /ARRAY/) {
                    if (ref $callback->[0]) {
                        printf "%s %s\n", ' ' x $spc1, $callback->[0], "\n";
                    } else {
                        printf "%s '%s'\n", ' ' x $spc1, $callback->[0], "\n";
                    }
                    foreach my $arg (@$callback[1 .. $#{@$callback}]) {
                        if (ref $arg) {
                            printf "%s %-40s", ' ' x $spc2, $arg;
                        } else {
                            printf "%s '%s'", ' ' x $spc2, $arg;
                        }
			
                        if (ref $arg eq 'Tk::Ev') {
                            if ($arg =~ /SCALAR/) {
                                print ": '$$arg'";
                            } else {
                                print ": '", join("' '", @$arg), "'";
                            }
                        }

                        print "\n";
                    } # forend callback arguments
                } # ifend callback

            } # forend all bindings for one tag

        } # ifend have bindings

    } # forend all tags
    print "\n";

} # end bindDump

# end of Tk::Widget::bindDump
1;
