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

I am having problems with dragging an item and dropping it on top of another using Perl/Tk.
Let me explain:
I have a form with 2 windows, on the left, a directory tree is displayed and on the right, I have a list of local groups. I would like to drag a group and drop it on a directory, so that I can add ACE permission for that group on the directory where it dropped. The problem is in the dragging and dropping on top of the DirTree. I am not sure why it’s not working (the code is not all mine, Saint .dave. helped me with it, so I am not certain on what I need to change).
The problems occure on subs DragStart and Drop.
Please your Enlightenment is required
use strict; use Tk 800.005; use Tk::TList; use Tk::Frame; use Tk::DirTree; use Tk::Scrollbar; use Tk::Adjuster; use Tk::DragDrop; use Tk::DropSite; use Win32::Perms; use Win32::AdminMisc; use Win32::NetResource; use vars qw /%tk %dr %im @groups $dnd_token/; $tk{mw} = MainWindow->new (-background=>'white'); $tk{mw}->geometry('500x400'); $tk{top_frame} = $tk{mw}->Frame; $tk{left_frame} = $tk{mw}->Frame; $tk{adjuster} = $tk{mw}-> Adjuster(-widget=>$tk{left_frame},-side=>'le +ft'); $tk{right_frame}=$tk{mw}->Frame; $tk{dir_tree}= $tk{left_frame}->Scrolled('DirTree', -height=>'0', -wid +th=>'0',-scrollbars=>'e',); $tk{group_label}=$tk{right_frame}->Label(-text=>"Group List:"); $tk{group_list}= $tk{right_frame}->Scrolled('TList', -height=>'1', -wi +dth=>'1', -scrollbars=>'osoe',); $im{ONE}= $tk{mw}->Photo(-file=>'c:/perl/one.gif'); $im{GROUP}=$tk{mw}->Photo(-file=>'c:/perl/group.gif'); $dr{PATH}=shift @ARGV ; $tk{dir_tree}-> chdir($dr{PATH}); $tk{dir_tree}->bind('<ButtonRelease-1>', sub{GetPerms();}); $tk{top_frame}->pack(qw/-side top -fill x/); $tk{left_frame}->pack(qw/-side left -fill y/); $tk{adjuster}->pack(qw/-side left -fill y/); $tk{right_frame}->pack(qw/-side right -fill both -expand 1/); $tk{group_label}->pack(qw/-side top -fill both/); $tk{group_list}->pack (qw/-side top -fill both -expand 1/); $tk{dir_tree}->pack(qw/-side left -fill both -expand 1/); $dnd_token = $tk{group_list}->DragDrop (-event =>'<B1-Motion>', -sitet +ypes=>[qw/Local/], -startcommand=>\ &DragStart,); $tk{dir_tree}->DropSite (-droptypes=>[qw/Local/], -dropcommand=>[\ &Dr +op, $tk{dir_tree}, $dnd_token],); @groups = @{&GetGroups()}; map {$tk{group_list}->insert('end', -itemtype=>'imagetext', -text=>"$_ +", -image=>$im{GROUP})} @groups; MainLoop; exit(0); sub DragStart{ my ($token) = @_; my $w = $token->parent; my $e = $w->XEvent; my $idx = $w->GetNearst($e->x, $e->y); if (defined $idx){ $token->configure(-text=>$w->entrycget($idx,'-text')); my ($X, $Y) = ($e->X, $e->Y); $token->MoveToplevelWindow($X, $Y); $token->raise; $token->deiconify; $token->FindSite($X, $Y, $e);}} sub Drop{ my ($lb, $dnd_source) = @_; my $group_item = $dnd_source->cget('-text'); my $y = $lb->pointery - $lb->rooty; my $x = $lb->pointerx - $lb->rootx; my $nearest = $lb->nearest($x,$y); if (defined $nearest){ my $dir_item = $lb->entrycget($nearest, '-text'); &AddGroupToDir($group_item, $dir_item); $lb->see($nearest);}} sub GetPerms{ my $path = $tk{dir_tree}->selectionGet(); &ShowPathInfo($path);} sub ShowPathInfo{ my ($path)=@_; my $perms = new Win32::Perms($path)||die"\n$^E\n"; print "\nPath: " . $perms->Path(); my $counter = $perms->Get(\my @list);} sub GetGroups{ my ($srv); my (@local_groups); if (Win32::NetResource::GetUNCName(my $unc, $dr{PATH})){ $unc =~ s/^\\\\(\w)+//; $srv = $&; print "\n Path is $dr{PATH} and server is: $srv\n";} else{ $srv = Win32::NodeName(); print "\nPath is $dr{PATH} and server is: $srv\n";} if (Win32::AdminMisc::GetGroups("$srv", GROUP_TYPE_LOCAL, \ @local +_groups)){ print "\n\nThis is the list of groups\n"; foreach my $item (@local_groups){ print "$item\n";}} return \ @local_groups;} sub AddGroupToDir{ my ($group,$dir)=@_;}

Replies are listed 'Best First'.
Re: A Drag and Drop (perl/Tk) question.
by RollyGuy (Chaplain) on Jul 29, 2002 at 14:31 UTC
    I don't know if this is a problem for you or not, but in your function DragStart, you have a typo. I think the line:
    my $idx = $w->GetNearst($e->x, $e->y);

    should be:
    my $idx = $w->GetNearest($e->x, $e->y);

    HTH
      AHHHH, so it was a typo, F@~&!|>? S(*& Me

      ...oh thanks brother (very much)...

      I had a terrible day today.

      I have completely panicked and ruined few good scripts.

Re: A Drag and Drop (perl/Tk) question.
by grummerX (Pilgrim) on Jul 29, 2002 at 15:16 UTC
    In your DragStart function, the following line:
    my $idx = $w->GetNearst($e->x, $e->y);
    Should read:
    my $idx = $w->GetNearest($e->x, $e->y);

    Your Drop function needs some changes as well. Instead of grabbing the x and y values through the properties of the directory tree, you should use the values that the Drop event sends through:

    sub Drop{ my ($lb, $dnd_source, $c_dest, $sel, $dest_x, $dest_y) = @_; my $group_item = $dnd_source->cget('-text'); my $nearest = $lb->GetNearest($dest_x, $dest_y); if (defined $nearest){ my $dir_item = $lb->entrycget($nearest, '-text'); print "*** $dir_item ***\n"; ### DEBUG: Show target value &AddGroupToDir($group_item, $dir_item); $lb->see($nearest); } }
    O'Reilly has a good Drag-and-Drop Primer available; you should check it out.

    -- grummerX

    Update: Removed HTML tags in code. (stupid, stupid...)
      grummerX is correct with his new Drop method, you need to grab X and Y from the source event in order to get the correct list item using GetNearest.

      Also, the example given at Drag-and-Drop Primer binds a mouse event, for the drag start, to all widgets that are DND capable. This approach works better for canvas to canvas image or shape dropping than list to list dropping. A better example would be Drag and drop with Perl/Tk as this covers DND from list to list.

      --
      hiseldl

      I do not know now what’s really is going on?

      I've started with amending this line :

      my $idx = $w->GetNearst($e->x, $e->y);<br><br>
      To this (as it was suggested ) :

      my $idx = $w-><b>GetNearest</b>($e->x, $e->y);


      And I got loads of errors because of the "b" and "/b". So I am back to 1^2.

      Recently I have read an article on PM about a guy who has given up programming. It was very interesting read, and I couldn’t really see why he did this….Now I can.
Re: A Drag and Drop (perl/Tk) question.
by Ay_Bee (Monk) on Jul 29, 2002 at 13:41 UTC
    Unfortunately I cannot run your script to debug it as I do not have all the required modules installed. Also I cannot profess to have a great deal of knowledge in this area. However IMHO I cannot see how this sub actually adds anything.
    sub AddGroupToDir{ my ($group,$dir)=@_;}
    I wish I knew enough to suggest a fix
    <A HREF="/index.pl?lastnode_id=1072&node_id=24885">Ay_Bee</A> -_-_-_-_-_-_-_-_-_-_-_- My memory concerns me - but I forget why !!!
      The AddGroupToDir is not the issue , my problem is the drag and drop action (the subs Drop and DragStart).
      Initially, I was helped by a monk called .dave. and I assumed that the help from him will continue so I committed my self to this script at work and I can't get out of it now, unless I change my job. Unfortunately, the monk ‘.dave.’ who helped me in the beginning did not get back to me at all, and I am stuck BIG TIME. If I know that I was going to get abandoned as the script develops, I wouldn't have pursued this option, now it’s too late to revert back to where ever I was.
      OHHH What a predicament.