OK here is a complete test case. Note that shift right mouse will drag an item from the list box to the entry but will not drag the selected word to the entry from the text widget. The problem seems to be that I cannot grab back the binding to shift right mouse (i.e. <Shift-3>) from the text widget, so the event to DragDrop gets ignored or is never seen by DragDrop.

#!perl
use Tk;
use Tk::Text;
use Tk::DragDrop;
use Tk::DropSite;

$mw=MainWindow->new;
$entry=$mw->Entry()->pack(-expand=>1);
$f=$mw->Frame->pack();
$text=$f->Text()->pack(-anchor=>'e');
$text->bind('<Shift B3>');
$text->bind('<Shift B3-Motion>',sub {print "Moving\n"});
$list=$f->Listbox()->pack(-anchor=>'w');
foreach (qw(one two three four)) {$list->insert('end',$_)}
$text->insert('end',"now is the time for all good perl monks\nto drag 
+and drop.");
$dnd_token2 = $list->DragDrop
  (-event     => '<Shift B3-Motion>',
   -sitetypes => ['Local'],
   -startcommand => sub { $main::dnd_token=$dnd_token2;StartDrag($main
+::dnd_token,$text) },
  );
    $dnd_token1 = $text->DragDrop
    (-event     => '<Shift B3-Motion>',
     -sitetypes => ['Local'],
     -startcommand => sub { $main::dnd_token=$dnd_token1;StartDrag1($m
+ain::dnd_token,$text) },
     );
    # Define the target for drops.
    $entry->DropSite
    (-droptypes     => ['Local'],
     -dropcommand   => [ \&Drop, $entry, \$main::dnd_token ],
     );

sub StartDrag1 {

    my($token,$text) = @_;
    my $w = $token->parent; # $w is the source text widget
    my $e = $w->XEvent;
# then the search string is whatever is selected, if anything
    my(@sel,$txt);
    if (@sel=($text->tagRanges('sel'))[0..1]) {
    $txt=$text->get(@sel);
    }
    if (defined $txt) {
        # Configure the dnd token to show the listbox entry
        $token->configure(-text => $txt);
        # Show the token
        my($X, $Y) = ($e->X, $e->Y);
        $token->MoveToplevelWindow($X, $Y);
        $token->raise;
        $token->deiconify;
        $token->FindSite($X, $Y, $e);
    }
}

sub StartDrag{

    my($token,$text) = @_;
    my $w = $token->parent; # $w is the source listbox
    my $e = $w->XEvent;
    my $idx = $w->nearest($e->y); # get the listbox entry under cursor
    if (defined $idx) {
        # Configure the dnd token to show the listbox entry
        $token->configure(-text => $w->get($idx));
        # Show the token
        my($X, $Y) = ($e->X, $e->Y);
        $token->MoveToplevelWindow($X, $Y);
        $token->raise;
        $token->deiconify;
        $token->FindSite($X, $Y, $e);
    }
}

sub Drop {
# Accept a drop and insert a new item in the destination listbox.
    my($lb, $dnd_source) = @_;
    $dnd_source=$$dnd_source;
    $lb->insert("end"," ") if ($lb->get ne '');
    $lb->insert("end", $dnd_source->cget(-text));
}
MainLoop();
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.