File: selection

package info (click to toggle)
perl-tk 1%3A800.024-1
  • links: PTS
  • area: main
  • in suites: woody
  • size: 18,528 kB
  • ctags: 19,152
  • sloc: ansic: 206,767; perl: 40,255; makefile: 4,370; sh: 2,290; yacc: 762
file content (65 lines) | stat: -rwxr-xr-x 1,526 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
#!/usr/local/bin/perl -w
use Tk;
use strict;

my $mw = MainWindow->new();
my $seln;

my $tb = $mw->Frame->pack(-fill => 'x');

my $lb = $mw->Scrolled('Listbox',-width => 40, -exportselection => 0);


$tb->Button('-text' => "Primary Targets", '-command' => [\&ShowTargets,$lb,'PRIMARY'])->pack('-side'=>'left');
$tb->Button('-text' => "Clipboard Targets", '-command' => [\&ShowTargets,$lb,'CLIPBOARD'])->pack('-side'=>'left');
$tb->Label('-textvariable' => \$seln)->pack('-side'=>'left');
$tb->Button('-text' => "Quit", '-command' => ['destroy',$mw])->pack('-side'=>'right');

$lb->packAdjust(-expand => 1, -fill => 'both');
my $tx = $mw->Scrolled('Text',-width => 40, -exportselection => 0, -wrap => 'none')->pack(-expand => 1, -fill => 'both');

$lb->bind('<ButtonRelease-1>',[\&GetSelected,$tx]);

ShowTargets($lb,'PRIMARY');

MainLoop;

sub GetSelected
{
 my ($lb,$tx) = @_;
 my $name = $lb->getSelected;
 if (defined $name)
  {
   my @targ = $lb->SelectionGet('-selection'=>$seln,$name);
   foreach (@targ)
    {
     $tx->insert('end',"$_\n");
    }
   $tx->see('end');
  }
}

sub ShowTargets
{
 my $lb = shift;
 $seln = shift;
 my $own =  $lb->SelectionExists('-selection'=>$seln);
 if ($own)
  {
   printf "owner of $seln is %x\n",$own;
   $lb->delete(0,'end');
   eval { 
   my @targ = $lb->SelectionGet('-selection'=>$seln,'TARGETS');
   $lb->insert('end',@targ);
   foreach (@targ)
    {
     if (/FILE_NAME/)
      {
       print $lb->SelectionGet('-selection'=>$seln,'FILE_NAME'),"\n";
      }
    }
   };
  }
}