rdsmithaz has asked for the wisdom of the Perl Monks concerning the following question:

I have a text widget and am trying to make dragdrop work. What I want to do is be able to select words using the normal <Double-1> binding, but <Shift-3> will invoke a drag of the selected word.

I have an application where this "used to" work, but then a new version of Tk or Tk::Text broke it.

The problem is that <3> is bound to a menu. The real problem is that all combinations of <3> are bound to the menu, so no matter what combination of key modifiers (Shift, Alt, Ctrl, etc.) I press, the text widget "does me the favor" of mapping that to the menu invocation. What I wanted was for Tk::Text to invoke the menu on <3> and *only* on <3>, not on <Shift-3> or <Meta-3> and so on.

My favorite slander of microsoft applies here: "Do me a favor, don't do me any favors". I cannot seem to figure out how to bind the dragdrop motion event to some mouse/key combination.

For grins, I tried to delete the <Shift-3> binding like this: 
$text->bind('<Shift-3>');

[download]
but this did nothing.

How can I wrest a mouse/key binding back from Tk::Text?

Thanks

P.S. Again, long ago in a galaxy far away this *used* to work. I have a listbox dragdrop example working just fine in the same application so its not like I can't get dragdrop to work at all.

Replies are listed 'Best First'.
Re: make drag drop work in text widget
by zentara (Cardinal) on Jul 16, 2008 at 13:42 UTC
    How can I wrest a mouse/key binding back from Tk::Text?

    The usual way to do this is to subclass the Text widget, then redefine the subs to your liking. See Making a derived Tk::Text object for an example. BTW, if you get it working, please post it; I've yet to see a drag text example on a Text widget.

    I'm not really a human, but I play one on earth CandyGram for Mongo
[reply]
Re: make drag drop work in text widget
by Anonymous Monk on Jul 16, 2008 at 06:51 UTC
    I suggest you try <Shift-ButtonPress-3>, more in Tk::bind.

    Its easier to get help when you include a minimal example that demonstrates your problem.

[reply]
[d/l]
Re: make drag drop work in text widget
by rdsmithaz (Initiate) on Jul 16, 2008 at 16:02 UTC
    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]
[reply]
[d/l]

Back to Seekers of Perl Wisdom