#!/usr/bin/perl

use strict;
use Tk;

my $after_id;

my $mw = MainWindow->new();
$mw->Label(-text => "Type a phrase in the entry box below")->pack();
$mw->Label(-text => "Then click once to print all of it")->pack();
$mw->Label(-text => "Or double-click to print just one word")->pack();
my $ent = $mw->Entry(-width => 25)->pack();

$ent->bind( "<Double-Button-1>", [\&print_me, "word"] );
$ent->bind( "<Button-1>", 
            sub {
              $after_id = $ent->after( 500, [\&print_me, $ent] )
            }
          );

MainLoop;


sub print_me
{
    my ( $widget, $mode ) = @_;
    my $content = $widget->get();
    if ( $mode eq "word" ) {
        $widget->afterCancel( $after_id );
        my $start = $widget->index( 'sel.first' );
        my $length = $widget->index( 'sel.last' ) - $start;
        print "you double-clicked the word: " .
            substr( $content, $start, $length), $/;
    } else {
        print $content,$/;
    }
}
[download]

I confess that it seems a bit unappealing. For one thing, I haven't figured out how to do this without, in effect, declaring a global $after_id variable (so that I can cancel the "after" object from a callback); for another, I dislike the idea of making the user wait at all for a response to a single-click, even just half a second. (Maybe the delay could be "optimized" if you can figure out or control the maximum interval that defines the double-click.)

The only other choice I can think of would be to abandon hope for the "intuitive" use of single- versus double-click, and adapt to using two truly distinct events, like "button-1" versus "shift-button-1" or "button-3" or something like that.

update: I fixed and rearranged the alternative event choices in the last paragraph, to make more sense. Also, in case the syntax of the two bind calls seems odd, I wanted to explain that, in the first case, bind will automatically provide the widget handle that receives the event as the first parameter to the referenced callback, so any other parameters provided in the bind call ("word", in this case) will be placed in "@_" after the widget handle. In the second "bind", I'm calling "print_me" from within an anonymous sub, so I have to pass the widget handle explicitly myself.

another update: (making multiple updates is one of my characteristic sins...) If you do decide to use "button-3" instead of double-click for your second event, you can have both events bind to the same callback sub, and include Ev('b') as one of the paramaters passed to it -- this will tell the callback which button was pressed. (I'm not sure how to tell it about a modified event like "shift-button-1" vs. an unmodified "button-1".)

... for another, I dislike the idea of making the user wait at all for a response to a single-click, even just half a second. (Maybe the delay could be "optimized" if you can figure out or control the maximum interval that defines the double-click.)

It seems that the interval is defined in pTk/tkBind.c as the NEARBY_MS macro. This macro is set to 500 milliseconds and not changeable in the API, so half a second is a good guess.

However, according to the Perl Cookbook 1st edition, recipe 15.19, you can bind a subroutine to a <Double-Button> like this:

# permit viewing by binding double-click
$l->bind( '<Double-Button>'     => \&view );
[download]

- - arden.

Since Perl is not (usualy) multi-threading (and when it is Tk is not thread safe), sleeping will delay TK's processing of events, meaning that you still can't see that there is a double click from inside a sub called from the single click event.
Now that I think of it though, $mw->update() should let Tk notice the double click, but I don't know how you would catch that from inside the sub, and I would think it would beg for odd timing issues to crop up.

#!/usr/bin/perl
use strict;
use Tk;

my ( $clickedon, $released, $double );

my $mw = tkinit;

my $lb = $mw->Scrolled( 'Listbox', -scrollbars => 'osoe' )->pack;
$lb->insert( 0, 'A' .. 'Z' );
$lb->bind( '<ButtonPress-1>',
    sub { $clickedon = $lb->get( $lb->curselection ); } );
$lb->bind( '<ButtonRelease-1>',
    sub { $released = $lb->get( $lb->curselection ); } );
$lb->bind( '<Double-1>', sub { $double = $lb->get( $lb->curselection )
+; } );

my $f1 = $mw->Frame->pack( -anchor => 'w' );
$f1->Label( -text         => 'Clicked on: ' )->pack( -side => 'left' )
+;
$f1->Label( -textvariable => \$clickedon )->pack( -side    => 'left' )
+;
my $f2 = $mw->Frame->pack( -anchor => 'w' );
$f2->Label( -text         => 'Released on: ' )->pack( -side => 'left' 
+);
$f2->Label( -textvariable => \$released )->pack( -side      => 'left' 
+);
my $f3 = $mw->Frame->pack( -anchor => 'w' );
$f3->Label( -text         => 'Double Clicked: ' )->pack( -side => 'lef
+t' );
$f3->Label( -textvariable => \$double )->pack( -side           => 'lef
+t' );

MainLoop;
[download]