Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

comment on

( [id://3333] : superdoc . print w/replies, xml ) Need Help??
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.

--
hiseldl

#! 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{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= +>'left'); $tk{right_frame} = $tk{mw}->Frame; $tk{entry_box} = $tk{top_frame}->Entry(-textvariable=>\$dr{PATH}); $tk{dir_tree} = $tk{left_frame}->Scrolled('DirTree', -height=>'0', -width=>'0', -scrollbars=>'e', ); $tk{output_list} = $tk{right_frame}->Scrolled('TList', -height=>'1', -width=>'1', -scrollbars=>'osoe',); $tk{user_list} = $tk{right_frame}->Scrolled('TList', -height=>'1', -width=>'1', -scrollbars=>'osoe',); $tk{group_list} = $tk{right_frame}->Scrolled('TList', -height=>'1', -width=>'1', -scrollbars=>'osoe',); $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 +s}); $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 +e # 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. $tk{group_list}->DropSite (-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', -itemtype=>'imagetext', -text=>"$_", -image=>$im{ONE}) } @users; @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; # $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->raise; $token->deiconify; $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); $lb->see($nearest); } } sub get_perms { # my ($indx) = $tk{dir_tree}->curselection(); my $path = $tk{dir_tree}->selectionGet(); &ShowPathInfo($path); } # 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"; $tk{output_list}->delete('0.1','end'); $tk{output_list}->insert('end', -itemtype=>'text', -text=>"$path"); foreach my $item (@list) { while (@_ = each %$item) { next unless $_[0] =~ /account|access/i; $tk{output_list}->insert('end', -itemtype=>'imagetext', -text=> $_[0].":". $_[1], -image=>$im{ONE}); } } } 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"; }

In reply to Tk Drag and Drop between TList widgets by hiseldl

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.