Hi,

I suggest you start with the example from Perl is able to deal with Drag-n-Drop within Tk and another applications, copy/paste, and build on it

Thanks for the reply! Yes I did that. The code I have runs just fine DND is solid and I can copy a file from it's current location to my cwd. I just need help in getting all of the widgets and or additional ones in one window. Since I posted I made some progress and made the Tcl code I posted look more perl like so that could solve my problem -- if I can get all of the way there -- but I'm not there yet. I also made a Tkx version to see if that could help me. Still not there yet either. Any help anyone could provide on widgets from Tkx and Tcl:Tk in one window or an example of a working Tkx listbox would really help. Thanks! I understand the parent child relationship but am not an expert at that yet. I can make a mw and put widgets into in in Tcl::Tk but not Tkx or mix types. Maybe the later is not possible. Thanks.</p?

"or an example of a working Tkx listbox"

# a routine using perl and tkx to make it easy to collect lists of dir
+s and files
# for xp-sp3 (win32::clipboard) 
# it allows you to drag files and dirs out of windows explorer type th
+ings
# and drop them into a listbox where their names get recorded
# A small area called topdir can aso recieve dropped things seperatly 


# see http://code.activestate.com/lists/perl-tcltk/357/
#     http://code.activestate.com/lists/perl-tcltk/356/
#     http://www.perlmonks.org/index.pl/jacques?parent=824717;node_id=
+3333
#     http://coding.derkeiler.com/Archive/Tcl/comp.lang.tcl/2006-04/ms
+g00026.html
#     http://www.ellogon.org/petasis/tcltk-projects/tkdnd/tkdnd-man-pa
+ge

use strict;
use Win32::Clipboard;

use Tkx;

  if (-d 'd:/active') { $main::myactive='D:/active'; } 
  elsif (-d 'C:/active') { $main::myactive='C:/active'; } 
#  print "myactive=".$main::myactive."\n"; 


######################################################################
+#############
# because tkdnd is not in the activestate tkkit 
#   and i didnt want to install tcl/tk and tkdnd we need to do the fol
+lowing 
######################################################################
+#############
#Get tkdnd from http://sourceforge.net/projects/tkdnd/files/ 
#   (I used the Windows binary)
# unzip it and put  it somewhere and lappend that dir below 
######################################################################
+#############
# notes from guy whos questions helped so much in figureing this out 
#Note 1 on where to put tkdnd: ...@python.org/msg00448.html">http://ww
+w.mail-archive.com/tkin...@python.org/msg00448.html
#Write the script and add some lines to help PerlApp find the tkdnd pa
+ckage
#Note 2 on helping PerlApp to find tkdnd with Tkx::lappend: http://www
+.nntp.perl.org/group/perl.tcltk/2008/11/msg187.html
######################################################################
+#############
Tkx::lappend('::auto_path', $main::myactive.'\tkx_extra\tkdnd2.6');
Tkx::package_require('tkdnd');
######################################################################
+#############

my %elist;    # used to tell if item in list already and so a dup 
my %estate;   # used to keep disk state of item  
my @astate=();# used to keep display state of listbox array item  
my @aitem=(); # full name of an listbox array item

my $topdir='<no topdir>'; 
my $flagfiles='1'; 

my $item_colors={}; 
$item_colors->{'dup'}   ={background       =>'red'
                         ,selectbackground =>'pink'
                         ,selectforeground =>'black'
                         }; 
$item_colors->{'file'}  ={background       =>'#74BBFB' #blue ice    
                         ,selectbackground =>'#7F00FF' # medium slateb
+lue2
                         ,selectforeground =>'white'
                         }; 
$item_colors->{'dir'}   ={background       =>'white'
                         ,selectbackground =>'blue'
                         ,selectforeground =>'white'
                         }; 

$item_colors->{'err'}   ={background       =>'#DDA0DD' # plum 
                         ,selectbackground =>'blue'
                         ,selectforeground =>'white'
                         }; 


my $statustext='Status here'; 
my $status_good=0; 
my $status_dup =0; 
my $status_err =0; 
my $status_file=0; 
update_status(); 


####### start tkx 
my $mw = Tkx::widget->new(".");

$mw->g_wm_title("Drag/drop queuer");
$mw->g_wm_geometry("600x200-30+40");



########################## menu ###############
Tkx::option_add("*tearOff", 0); # http://www.tkdocs.com/tutorial/menus
+.html

my $m = $mw->new_menu;
$mw->configure(-menu => $m);

my $mfile = $m->new_menu;
$m->add_cascade(-menu => $mfile, -label => "File");
$mfile->add_command(-label => "Exit"     , -command => sub {exit;});
$mfile->add_command(-label => "Write"    , -command => sub {writelist(
+);});

my $medit = $m->new_menu;
$m->add_cascade(-menu => $medit, -label => "Edit");
$medit->add_command(-label => "Clean Dup" ,   -command => sub {cleanli
+st('dup')});
$medit->add_command(-label => "Clean File",   -command => sub {cleanfi
+les()});
$medit->add_command(-label => "Clean Sel" ,   -command => sub {cleanse
+lection()});
$medit->add_command(-label => "Clean Errors", -command => sub {cleanli
+st('err')});
$medit->add_separator;
$medit->add_command(-label => "Paste",        -command => sub {paste()
+});

my $mhelp = $m->new_menu;
$m->add_cascade(-menu => $mhelp, -label => "Help");
$mhelp->add_command(-label => "About", -command => sub {about()});


############### top frame ###################

my $w_tfrm = $mw->new_ttk__frame();
$w_tfrm->configure(-borderwidth => 2, -relief => "sunken");

my $w_tnam = $w_tfrm->new_label(-text         =>"Topdir"
                               ,-justify      =>'left'
                               ,-anchor       =>'nw'
                               ,-background   =>'#CDCDCD'
                               );
$w_tnam->g_grid(-column => 0, -row => 0, -sticky => "w");            
#$w_tnam->g_pack(qw '-fill none -expand no -anchor nw');

my $w_tdir = $w_tfrm->new_label(-textvariable =>\$topdir
                               ,-justify      =>'left'
                               ,-anchor       =>'nw'
                               ,-background   =>'#CDCDCD'
                               );
$w_tdir->g_grid(-column => 1, -row => 0, -sticky => "e");            

# drag and trop to anywhere in frame 
Tkx::tkdnd__drop___target_register($w_tfrm,'*');
Tkx::bind ($w_tfrm, '<<Drop:DND_Files>>', 
   [ sub {topdir_dnd(@_);} , Tkx::Ev("%D") ] 
   );

$w_tfrm->g_pack(qw '-fill x -expand no');


################# bot frame ############### 

my $w_bfrm = $mw->new_ttk__frame();
$w_bfrm->configure(-borderwidth => 2, -relief => "groove");

my $w_elab = $w_bfrm->new_label(-text=>"Entrys:"
                               ,-justify=>'left'
                               ,-anchor=>'nw'
                               );
$w_elab->g_grid(-column => 0, -row => 0, -sticky => "we");


my $lb = $w_bfrm->new_tk__listbox(-height => 3, -selectmode=>'extended
+');
$lb->g_grid(-column => 0, -row => 1, -sticky => "nwes");

my $sv = $w_bfrm->new_ttk__scrollbar(-command => [$lb, "yview"], 
        -orient => "vertical"); 
$sv->g_grid(-column =>1, -row => 1, -sticky => "ns");

my $sh = $w_bfrm->new_ttk__scrollbar(-command => [$lb, "xview"], 
        -orient => "horizontal"); 
$sh->g_grid(-column =>0, -row => 2, -sticky => "ew");

$lb->configure(-yscrollcommand => [$sv, "set"]);
$lb->configure(-xscrollcommand => [$sh, "set"]);

($w_bfrm->new_ttk__label(-textvariable => \$statustext, 
                        -anchor => "w"))
        ->g_grid(-column => 0, -row => 3, -sticky => "we");

$w_bfrm->g_grid_columnconfigure(0, -weight => 1); 
$w_bfrm->g_grid_rowconfigure   (1, -weight => 1);


$w_bfrm->g_pack(qw '-fill both -expand true');

# drop anywhere in the frame 
Tkx::tkdnd__drop___target_register($w_bfrm,'*');
Tkx::bind ($w_bfrm
          , '<<Drop:DND_Files>>'
          , [ sub{ drop_to_list(@_) } , Tkx::Ev("%D")] 
          );
Tkx::bind ('all' # $w_bfrm
          , '<Control-a>'
          ,  sub{ ctrl_a() }  
          );
Tkx::bind ('all' # $w_bfrm
          , '<Control-v>'
          ,  sub{ paste() }  
          );

################# button/cmd frame ############### 

my $w_cfrm = $mw->new_ttk__frame();

my $c_dirs = $w_cfrm->new_ttk__checkbutton(-text => "Flag Files"
                                          , -command  => sub {flagfile
+schanged()}
                                          , -variable => \$flagfiles
                                          , -onvalue  => "1"
                                          , -offvalue => "0"
                                          );
$c_dirs->g_grid(-column =>0, -row => 0, -sticky => "ew");


#my $b_cleand = $w_cfrm->new_ttk__button(-text => "CleanDup" 
#                                       , -command => sub {cleanlist('
+dup');}
#                                       , 
#                                       );
#$b_cleand->g_grid(-column=>91,-row => 0, -sticky => "ew");
#my $conf=$b_cleand->configure(); print $conf."\n";
#$b_cleand->configure();

sub makecolorbutton{ 
# ttk button with a colored label wrapped in a frame 
  my $in=shift; 
  my $text=shift; 
  my $textlab=shift; 
  my $col=shift; 
  my $row=shift; 
  my $color=shift; 
  my $sub=shift; 

  my $w_cfrm = $in->new_ttk__frame();

  my $w_tdir = $w_cfrm->new_label(-text          =>$textlab
                                 ,-justify      =>'left'
                                 ,-anchor       =>'nw'
                                 ,-background   =>$color
                               );
  $w_tdir->g_grid(-column => 1, -row => 0, -sticky => "ew");          
+  

  my $b_cleand = $w_cfrm->new_ttk__button(-text => $text , -command =>
+ $sub );
  $b_cleand->g_grid(-column=>1,-row =>2, -sticky => "ew");

#  my $w_tdir2 = $w_cfrm->new_label(-text        =>$text
#                                 ,-justify      =>'left'
#                                 ,-anchor       =>'nw'
#                                 ,-background   =>$color
#                               );
#  $w_tdir2->g_grid(-column => 1, -row => 3, -sticky => "ew");        
+    

  $w_cfrm->g_grid(-column=>$col,-row => $row, -sticky => "ew");

  } # makebutton 
makecolorbutton($w_cfrm
               ,"CleanDup"
               ,"Duplicate"
               ,92,0
               ,$item_colors->{dup}{background}
               ,sub {cleanlist('dup');}
               ); 



  makecolorbutton($w_cfrm
                 ,"CleanFile"
                 ,"File"
                 ,91,0
                 ,$item_colors->{file}{background}
                 ,sub {cleanfiles();}
                 ); 
  makecolorbutton($w_cfrm
                 ,"CleanErr"
                 ,"Errors"
                 ,93,0
                 ,$item_colors->{err}{background}
                 ,sub {cleanlist('err');}
                 ); 
  makecolorbutton($w_cfrm
                 ,"CleanSel"
                 ," "
                 ,94,0
                 ,'White'
                 ,sub {cleanselection();}
                 ); 
  makecolorbutton($w_cfrm
                 ,"Paste"
                 ,"  Clipboard "
                 ,111,0
                 ,'White'
                 ,sub {paste();}
                 ); 
  makecolorbutton($w_cfrm
                 ,"Write"
                 ,"         File "
                 ,199,0
                 ,'White'
                 ,sub {writelist();}
                 ); 


  $w_cfrm->g_pack(qw '-fill both -expand false');




  Tkx::MainLoop;
  exit; 
########################################################
sub cleanselection {
# remove selected items from list 
  my $sel0=$lb->curselection(); 
  for my $row (split(' ',$sel0)) {$astate[$row]='sel';} 
  cleanlist('sel');  
  } #cleanselection 

sub cleanfiles {
# remove file items from list 
  my $row=0; 
  for my $item (@aitem) { 
    if ($estate{$item} eq 'file' ){ $astate[$row]='file';} 
    $row++;
    }
  cleanlist('file');  
  } #cleanfiles 

sub cleanlist{ 
  # clean the list of a astate type 
  my $test=shift; 
  $test='dup' unless ($test); 
  my @good; 

# exclude the ones of the type 
  my $row=0; 
  for my $type (@astate) { 
          if ($type ne $test) { 
              my $item=$aitem[$row]; 
              push @good,$item;
              }
    $row++;
    }

# clear stuff 
  %elist={}; 
  @astate=(); 
  @aitem=(); 
  $status_dup =0; 
  $status_good=0; 
  $status_file=0; 
  $status_err =0; 

  $lb->delete(0,'end'); 

  if (1 eq 1 ) { # new way 
    %estate={}; 
    add_list(@good); 
    } 
  else { # oldway 

# put them back in the list 
  $row=0; 
  for my $item (@good) {
      my $type=$estate{$item}; 
      if ($elist{$item}) {$type='dup';$status_dup++;}
        else {
          $elist{$item}=1; 
          if ($type eq 'dir') {    $status_good++; }
          elsif ($type eq 'dir') {    $status_good++; }
            else {$status_file++};
          } 
      $lb->insert("end", $item);
      set_item($lb,$row,$type); 
      $astate[$row]=$type; 
      $aitem[$row]=$item; 
      $row++;
      } # item good 

  update_status(); 
  } #old way 

  }#cleanlist 

sub update_status{ 

  $statustext='Status Dirs:'.$status_good
             .' Files:'.$status_file
             .' Dups:' .$status_dup
             .' Err:'  .$status_err
             ; 

  } # update_status 

sub drop_to_list { 

      my $droplist = shift;
      my @list = Tkx::SplitList($droplist); # can be a tcl array 
      add_list(@list); 
  } #drop_to_list 

sub add_list{ 
      my @list=@_; 
      my $row=$lb->index('end'); 
      for my $item (@list) {
        my $type;
        $lb->insert("end", $item);
        if ($elist{$item}){ 
            $type='dup'; 
            $status_dup++;
            }
          else { 
# an err is probably a file/dir that disapeared since it was dropped i
+n 
            $elist{$item}=1; 
            if(    -d $item ) { $type='dir';  $status_good++; } 
            elsif( -f $item ) { $type='file'; $status_file++; } 
            else              { $type='err';  $status_err++; } 
            $estate{$item}=$type; 
            };
        $astate[$row]=$type;  
        $aitem [$row]=$item;  
        set_item($lb,$row,$type); 
        $row++; 
#        $lb->see('end');
        } # item list 

  update_status(); 
} # addlist 


sub set_item { 
  # set the display attrs of an item 
  my $lb=shift; 
  my $row=shift; 
  my $type=shift; 
  if ((!$flagfiles) && $type eq 'file') { $type='dir';} 

  $lb->itemconfigure($row
                    ,-background       => $item_colors->{$type}{'backg
+round'}
                    ,-selectbackground => $item_colors->{$type}{'selec
+tbackground'}
                    ,-selectforeground => $item_colors->{$type}{'selec
+tforeground'}
                    );

  }#set item 


sub about {
# need to geom this to a good place 
# and  get it in focus 

# -parent => $mw

  my $tl = $mw->new_toplevel();

  my $w_tfrm = $tl->new_ttk__frame();
  $w_tfrm->configure(-borderwidth => 2, -relief => "sunken");
  my $abouttext="About:\n\nBy:Huck\n\nClose with X"; 

  my $w_tnam = $w_tfrm->new_label(-textvariable=>\$abouttext
                                 ,-justify=>'left'
                                 ,-anchor=>'nw'
                                 );
  
  $w_tnam->g_pack(qw '-fill both -expand true -anchor nw');
  $w_tfrm->g_pack(qw '-fill both -expand true -anchor nw');

  } #about 

sub flagfileschanged {
  my $row=0; 
  for my $type (@astate) { 
    set_item($lb,$row,$type); 
    $row++;
    } # type astate 

 } # flagfiles 

sub writelist {
#  my $file=\*STDOUT;
  my $filename = Tkx::tk___getSaveFile(-parent => $mw
                                      ,-defaultextension => 'txt'
                                      );
 
  if ($filename) { 
      open (LIST,'>'.$filename) || die 'cant open for write:'.$filenam
+e; 
      my $file=\*LIST; 
      print $file '-topdir '.$topdir."\n"; 
      my $row=0; 
      for my $item (@aitem) { 
        print $file '-'.$astate[$row].' '.$item."\n"; 
        $row++; 
        }
    close LIST; 
    } # filename 
  } #writelist 

sub ctrl_a {
  $lb->selection_set(0,'end');
}

sub topdir_dnd{
          $topdir = shift;
#          print "topdir have '$topdir'\n";
          my @list = Tkx::SplitList($topdir); # can have more than one
+ 
                                              # only take last 
          my $e1=''; 
          for my $item (@list) { $e1=$item; }
          # should insure its a dir before accepting it 
          $topdir=$e1; 
        }


sub paste { 

  if (Win32::Clipboard::IsFiles()  ) { 
      my @files = Win32::Clipboard::GetFiles();
      my @dosfiles; 
      for my $f(@files){ $f=~s.\\./.g; push @dosfiles,$f} 
      add_list(@files); 
      } # isfiles 
  } # paste
[download]

"with a chainsaw", but it does work, you can drag and drop dirs of files from an explorer window into either the Topdir:($w_tfrm) or entries($w_bfrm) area.

does what i want, probably does more than you want, YMMV

...I just need help in getting all of the widgets and or additional ones in one window....

Hi,

Its real simple, if you're using the no-tcl-Eval version, well there is nothing mysterious there, just "pack" whatever extra widgets you want in the mainwindow ( $mw->Label... $mw->Listbox... ->pack )

If you're using the tcl-eval version, pay attention to this part

# Tcl inclusion for GUI finished here; you can work with widgets here 
+like:
my $lab = $mw->interp->widget('.status');
$lab->configure(-text=>'new text here...');
[download]

Do you get it now? All you have to do is

my $mw = $int->widget( ... ,'MainWindow');
$mw->Button(-text => 'freedom' )->pack;
[download]

The ... part is a secret, you have to read tcl tk docs to find out what it is