Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

Tk Drag and Drop between TList widgets

by hiseldl (Priest)
on Jul 21, 2002 at 01:56 UTC ( #183718=snippet: print w/replies, xml ) Need Help??
Description: I wrote this for another monk, but everyone should be able to use it. I've factored out the list generation methods that are used to populate the lists, so it should be easy to change it.

It's not a fully functional application, so I'm putting it in snippets. It is also an example of how to use DND between to TList widgets.


#! perl -w

# This script will create two windows, the one on 
# the left is where all the directories will be 
# displayed and on the right is where the users
# or groups that have access to the directory will 
# be displayed.

# 1-On the right windows, displaying users and 
# groups as Icons (like an icon with a drawing 
# of face for a users and two faces for a group
# similar to what you get in User Manager) instead 
# of displaying them in text.

# 2- Clicking on a user icon and dragging it 
# then dropping it on an icon representing a 
# group will move the user to that group.

# 3- On the left Window, where the directory 
# structures are displayed, I would like to have 
# a display similar to what you get if you had 
# used Tk::DirTree -if I can. Also a single click 
# on a directory will display the user permissions 
# on the right window (which the script does that
# anyway) and double click will assign a variable 
# to the selected path, so I can do other things 
# with that path.

# 4- Instead of passing the path as @ARGV, it 
# would be better if I could have an entry field 
# (in the top left hand corner of the window) where
# I can pass the path in there and bind the Enter
# (or Return) key to that field.

use strict;

use Tk 800.005;
use Tk::TList;
use Tk::DirTree;
use Tk::Frame;
use Tk::Scrollbar;
use Tk::Adjuster;

# These are required for drag-n-drop operations
use Tk::DragDrop;
use Tk::DropSite;

use File::Find;
use Win32::Perms;

# $tk{widget_refs}, $dr{data_refs}, $im{image_refs}
use vars qw/%tk %dr %im @users @groups $dnd_token/;

$dr{PATH} = shift @ARGV || ".";
$dr{perms} = "Permissions: ".$dr{PATH};

$tk{mw} = MainWindow->new(-background => 'white');


$tk{top_frame}   = $tk{mw}->Frame;
$tk{left_frame}  = $tk{mw}->Frame;
$tk{adjuster}    = $tk{mw}->Adjuster(-widget=> $tk{left_frame}, -side=
$tk{right_frame} = $tk{mw}->Frame;

$tk{entry_box}   = $tk{top_frame}->Entry(-textvariable=>\$dr{PATH});
$tk{dir_tree}    = $tk{left_frame}->Scrolled('DirTree',
                         -scrollbars=>'e', );

$tk{output_list} = $tk{right_frame}->Scrolled('TList',

$tk{user_list} = $tk{right_frame}->Scrolled('TList',
$tk{group_list} = $tk{right_frame}->Scrolled('TList',
$tk{user_label}   = $tk{right_frame}->Label(-text => "User List:");
$tk{group_label}  = $tk{right_frame}->Label(-text => "Group List:");
$tk{output_label} = $tk{right_frame}->Label(-textvariable => \$dr{perm

$im{ONE}    = $tk{mw}->Photo(-file => 'one.gif');
$im{GROUP}  = $tk{mw}->Photo(-file => 'group.gif');

$tk{dir_tree}->chdir( $dr{PATH} );
$tk{dir_tree}->bind('<ButtonRelease-1>',sub {get_perms();});
$tk{entry_box}->bind('<Key-Return>',sub {OnNewPath();});

$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{entry_box}   ->pack(qw/-side top -fill both -expand 1/);
$tk{dir_tree}    ->pack(qw/-side left -fill both -expand 1/);
$tk{output_label}->pack(qw/-side top -fill both/);
$tk{output_list} ->pack(qw/-side top -fill both -expand 1/);
$tk{user_label}  ->pack(qw/-side top -fill both/);
$tk{user_list}   ->pack(qw/-side top -fill both -expand 1/);
$tk{group_label} ->pack(qw/-side top -fill both/);
$tk{group_list}  ->pack(qw/-side top -fill both -expand 1/);

# Define the source for drags.
# Drags are started while pressing the left mouse button and moving th
# mouse. Then the StartDrag callback is executed.
# The DragDrop method returns a "token", which is a Label widget for
# the text or image displayed during the drag action.
$dnd_token = $tk{user_list}->DragDrop
    (-event     => '<B1-Motion>',
     -sitetypes => [qw/Local/],
     -startcommand => \&DragStart,

# Define the target for drops.
    (-droptypes     => [qw/Local/],
     -dropcommand   => [\&Drop, $tk{group_list}, $dnd_token ],

# Add the users to the user list and the groups to the group list
@users = @{&GetUsers()};
map { $tk{user_list}->insert('end',
                 -image=>$im{ONE}) } 

@groups = @{&GetGroups()};
map { $tk{group_list}->insert('end',
                  -image=>$im{GROUP}) }

exit 0;

sub DragStart {
    my($token) = @_;
    my $w = $token->parent; # $w is the source listbox
    my $e = $w->XEvent;
    my $idx = $w->GetNearest($e->x, $e->y); # get the listbox entry un
+der cursor
    if (defined $idx) {
    # Configure the dnd token to show the listbox entry
    $token->configure(-text => $w->entrycget($idx, '-text') );
    # Show the token
    my($X, $Y) = ($e->X, $e->Y);
    $token->MoveToplevelWindow($X, $Y);
    $token->FindSite($X, $Y, $e);

# Accept a drop and insert a new item in the destination 
sub Drop {
    my($lb, $dnd_source) = @_;
    my $user_item = $dnd_source->cget('-text');

    # figure out where in the group listbox the drop occurred
    my $y = $lb->pointery - $lb->rooty;
    my $x = $lb->pointerx - $lb->rootx;
    my $nearest = $lb->nearest($x,$y);
    if (defined $nearest) {
    my $group_item = $lb->entrycget($nearest, '-text');

    &AddUserToGroup($user_item, $group_item);

sub get_perms
#    my ($indx) = $tk{dir_tree}->curselection();
    my $path = $tk{dir_tree}->selectionGet();    

# This method is bound to the 'enter' key so that we can update
# the path information from the entry widget.
sub OnNewPath
    $tk{dir_tree}->chdir( $dr{PATH} );
    &ShowPathInfo( $dr{PATH} );

sub ShowPathInfo
    my ($path) = @_;
    my $perms = new Win32::Perms($path) || die "\n$^E\n";
    print "Path: " . $perms->Path();
    my $counter = $perms->Get(\ my @list);

    $dr{perms} = "Permisssions: $path";


    foreach my $item (@list)
     while (@_ = each %$item)
             next unless $_[0] =~ /account|access/i;
                          -text=> $_[0].":". $_[1],

sub GetUsers
    return [qw/One Two Three/];

sub GetGroups
    return [qw/Blue Green Red/];
sub AddUserToGroup
    my ($user, $group) = @_;
    # Do something with $user_item and with $group_item
    $dr{perms} = "User $user added to $group";

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://183718]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (6)
As of 2017-05-29 16:53 GMT
Find Nodes?
    Voting Booth?