home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / TList.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  6.9 KB  |  392 lines
  1. package Tk::TList; 
  2. use Tk qw(Ev);
  3.  
  4. @ISA = qw(Tk::Widget);
  5.  
  6. use strict;
  7.  
  8. Construct Tk::Widget 'TList';
  9.  
  10. bootstrap Tk::TList $Tk::VERSION; 
  11.  
  12. sub Tk_cmd { \&Tk::tlist }
  13.  
  14.  
  15. EnterMethods Tk::TList __FILE__,qw(insert anchor 
  16.                                    delete dragsite dropsite entrycget
  17.                                    entryconfigure info
  18.                                    nearest see selection xview yview);
  19.  
  20. use Tk::Submethods ( 'delete' => [qw(all entry offsprings siblings)],
  21.                      'info' => [qw(anchor dragsite dropsite selection)],
  22.                      'selection' => [qw(clear get includes set)],
  23.                      'anchor' => [qw(clear set)],
  24.                      'dragsite' => [qw(clear set)],
  25.                      'dropsite' => [qw(clear set)],
  26.                    );
  27.  
  28.  
  29. sub ClassInit
  30. {
  31.  my ($class,$mw) = @_;
  32.  
  33.  $mw->bind($class,'<ButtonPress-1>',[ 'Button1' ] );
  34.  $mw->bind($class,'<Shift-ButtonPress-1>',[ 'ShiftButton1' ] );
  35.  $mw->bind($class,'<Control-ButtonRelease-1>', sub {} );
  36.  $mw->bind($class,'<ButtonRelease-1>',
  37.         sub
  38.          {
  39.           my $w = shift;
  40.           my $Ev = $w->XEvent;
  41.           $w->CancelRepeat
  42.               if($w->cget('-selectmode') ne "dragdrop");
  43.           $w->ButtonRelease1($Ev);
  44.          });
  45.  $mw->bind($class,'<B1-Motion>',[ 'Button1Motion' ] );
  46.  $mw->bind($class,'<B1-Leave>',[ 'AutoScan' ] );
  47.  
  48.  $mw->bind($class,'<Double-ButtonPress-1>',['Double1']);
  49.  
  50.  $mw->bind($class,'<Control-B1-Motion>', sub {} );
  51.  $mw->bind($class,'<Control-ButtonPress-1>',['CtrlButton1']);
  52.  $mw->bind($class,'<Control-Double-ButtonPress-1>',['CtrlButton1']);
  53.  
  54.  $mw->bind($class,'<B1-Enter>',
  55.         sub
  56.          {
  57.           my $w = shift;
  58.           my $Ev = $w->XEvent;
  59.           $w->CancelRepeat
  60.               if($w->cget('-selectmode') ne "dragdrop");
  61.          });
  62.  
  63.  $mw->bind($class,'<Up>',  ['DirKey', 'up']);
  64.  $mw->bind($class,'<Down>',['DirKey', 'down']);
  65.  
  66.  $mw->bind($class,'<Left>', ['DirKey', 'left']);
  67.  $mw->bind($class,'<Right>',['DirKey', 'right']);
  68.  
  69.  $mw->bind($class,'<Prior>', sub {shift->yview('scroll', -1, 'pages') } );
  70.  $mw->bind($class,'<Next>',  sub {shift->yview('scroll',  1, 'pages') } );
  71.  
  72.  $mw->bind($class,'<Return>', ['KeyboardActivate']);
  73.  $mw->bind($class,'<space>',  ['KeyboardBrowse']);
  74.  
  75.  return $class;
  76. }
  77.  
  78. sub Button1
  79. {
  80.  my $w = shift;
  81.  my $Ev = $w->XEvent;
  82.  
  83.  delete $w->{'shiftanchor'}; 
  84.  
  85.  $w->focus()
  86.     if($w->cget("-takefocus"));
  87.  
  88.  my $mode = $w->cget("-selectmode");
  89.  
  90.  if ($mode eq "dragdrop")
  91.   {
  92.    # $w->Send_WaitDrag($Ev->y);
  93.    return;
  94.   }
  95.  
  96.  my $ent = $w->GetNearest($Ev->x, $Ev->y);
  97.  
  98.  return unless( $ent );
  99.  
  100.  my $browse = 0;
  101.    
  102.  if($mode eq "single")
  103.   {
  104.    $w->anchor('set', $ent);
  105.   }
  106.  elsif($mode eq "browse")
  107.   {
  108.    $w->anchor('set', $ent);
  109.    $w->selection('clear' );
  110.    $w->selection('set', $ent);
  111.    $browse = 1;
  112.   }
  113.  elsif($mode eq "multiple")
  114.   {
  115.    $w->selection('clear');
  116.    $w->anchor('set', $ent);
  117.    $w->selection('set', $ent);
  118.    $browse = 1;
  119.   }
  120.  elsif($mode eq "extended")
  121.   {
  122.    $w->anchor('set', $ent);
  123.    $w->selection('clear');
  124.    $w->selection('set', $ent);
  125.    $browse = 1;
  126.   }
  127.    
  128.  $w->Callback(-browsecmd => $ent) if ($browse);
  129. }
  130.  
  131. sub ShiftButton1
  132. {
  133.  my $w = shift;
  134.  my $Ev = $w->XEvent;
  135.  
  136.  my $to = $w->GetNearest($Ev->x,$Ev->y);
  137.  
  138.  delete $w->{'shiftanchor'}; 
  139.  
  140.  return unless($to);
  141.  
  142.  my $mode = $w->cget('-selectmode');
  143.  
  144.  if($mode eq "extended")
  145.   {
  146.    my $from = $w->info('anchor');
  147.    if($from)
  148.     {
  149.      $w->selection('clear');
  150.      $w->selection('set', $from, $to);
  151.     }
  152.    else
  153.     {
  154.      $w->anchor('set', $to);
  155.      $w->selection('clear');
  156.      $w->selection('set', $to);
  157.     }
  158.   }
  159. }
  160.  
  161. sub GetNearest
  162. {
  163.  my ($w,$x,$y) = @_;
  164.  my $ent = $w->nearest($x,$y);
  165.  if (defined $ent)
  166.   {
  167.    my $state = $w->entrycget($ent, '-state');
  168.    return $ent if (!defined($state) || $state ne 'disabled');
  169.   }
  170.  return undef;
  171. }
  172.  
  173. sub ButtonRelease1
  174. {
  175.  my ($w, $Ev) = @_;
  176.  
  177.  delete $w->{'shiftanchor'}; 
  178.  
  179.  my $mode = $w->cget('-selectmode');
  180.  
  181.  if($mode eq "dragdrop")
  182.   {
  183. #   $w->Send_DoneDrag();
  184.    return;
  185.   }
  186.  
  187.  my ($x, $y) = ($Ev->x, $Ev->y);
  188.  my $ent = $w->GetNearest($x,$y);
  189.  
  190.  return unless($ent);
  191.  
  192.  if($x < 0 || $y < 0 || $x > $w->width || $y > $w->height)
  193.   {
  194.    $w->selection('clear');
  195.  
  196.    return if($mode eq "single" || $mode eq "browse")
  197.  
  198.   }
  199.  else
  200.   {
  201.    if($mode eq "single" || $mode eq "browse")
  202.     {
  203.      $w->anchor('set', $ent);
  204.      $w->selection('clear');
  205.      $w->selection('set', $ent);
  206.  
  207.     }
  208.    elsif($mode eq "multiple")
  209.     {
  210.      $w->selection('set', $ent);
  211.     }
  212.    elsif($mode eq "extended")
  213.     {
  214.      $w->selection('set', $ent);
  215.     }
  216.   }
  217.  
  218.  $w->Callback(-browsecmd =>$ent);
  219. }
  220.  
  221. sub Button1Motion
  222. {
  223.  my $w = shift;
  224.  my $Ev = $w->XEvent;
  225.  
  226.  delete $w->{'shiftanchor'}; 
  227.  
  228.  my $mode = $w->cget('-selectmode');
  229.  
  230.  if ($mode eq "dragdrop")
  231.   {
  232. #   $w->Send_StartDrag();
  233.    return;
  234.   }
  235.  
  236.  my $ent = $w->GetNearest($Ev->x,$Ev->y);
  237.  
  238.  return unless($ent);
  239.  
  240.  if($mode eq "single")
  241.   {
  242.    $w->anchor('set', $ent);
  243.   }
  244.  elsif($mode eq "multiple" || $mode eq "extended")
  245.   {
  246.    my $from = $w->info('anchor');
  247.    if($from)
  248.     {
  249.      $w->selection('clear');
  250.      $w->selection('set', $from, $ent);
  251.     }
  252.    else
  253.     {
  254.      $w->anchor('set', $ent);
  255.      $w->selection('clear');
  256.      $w->selection('set', $ent);
  257.     }
  258.   }
  259.  
  260.  if($mode ne "single")
  261.   {
  262.    $w->Callback(-browsecmd =>$ent);
  263.   }
  264. }
  265.  
  266. sub Double1
  267. {
  268.  my $w = shift;
  269.  my $Ev = $w->XEvent;
  270.  
  271.  delete $w->{'shiftanchor'}; 
  272.  
  273.  my $ent = $w->GetNearest($Ev->x,$Ev->y);
  274.  
  275.  return unless($ent);
  276.  
  277.  $w->anchor('set', $ent)
  278.     unless($w->info('anchor'));
  279.  
  280.  $w->selection('set', $ent);
  281.  $w->Callback(-command => $ent);
  282. }
  283.  
  284. sub CtrlButton1
  285. {
  286.  my $w = shift;
  287.  my $Ev = $w->XEvent;
  288.  
  289.  delete $w->{'shiftanchor'}; 
  290.  
  291.  my $ent = $w->GetNearest($Ev->x,$Ev->y);
  292.  
  293.  return unless( $ent );
  294.  
  295.  my $mode = $w->cget('-selectmode');
  296.  
  297.  if($mode eq "extended")
  298.   {
  299.    $w->anchor('set', $ent) unless( $w->info('anchor') );
  300.  
  301.    if($w->selection('includes', $ent))
  302.     {
  303.      $w->selection('clear', $ent);
  304.     }
  305.    else
  306.     {
  307.      $w->selection('set', $ent);
  308.     }
  309.    $w->Callback(-browsecmd =>$ent);
  310.   }
  311. }
  312.  
  313. sub DirKey
  314. {
  315.  my ($w,$dir) = @_;
  316.  my $anchor = $w->info('anchor');
  317.  
  318.  my $new = (defined $anchor) ? $w->info($dir,$anchor) : 0;
  319.  
  320.  $w->anchorSet($new);
  321.  $w->see($new);
  322. }
  323.  
  324. sub KeyboardActivate
  325. {
  326.  my $w = shift;
  327.  
  328.  my $anchor = $w->info('anchor');
  329.  
  330.  return unless( $anchor );
  331.  
  332.  if($w->cget('-selectmode'))
  333.   {
  334.    $w->selection('clear');
  335.    $w->selection('set', $anchor);
  336.   }
  337.  $w->Callback(-command => $anchor);
  338. }
  339.  
  340. sub KeyboardBrowse
  341. {
  342.  my $w = shift;
  343.  
  344.  my $anchor = $w->info('anchor');
  345.  
  346.  return unless( $anchor );
  347.  
  348.  if($w->cget('-selectmode'))
  349.   {
  350.    $w->selection('clear');
  351.    $w->selection('set', $anchor);
  352.   }
  353.  $w->Callback(-browsecmd =>$anchor);
  354. }
  355.  
  356. sub AutoScan
  357. {
  358.  my $w = shift;
  359.  
  360.  return if($w->cget('-selectmode') eq "dragdrop");
  361.  
  362.  my $Ev = $w->XEvent;
  363.  my $y = $Ev->y;
  364.  my $x = $Ev->x;
  365.  
  366.  if($y >= $w->height)
  367.   {
  368.    $w->yview('scroll', 1, 'units');
  369.   }
  370.  elsif($y < 0)
  371.   {
  372.    $w->yview('scroll', -1, 'units');
  373.   }
  374.  elsif($x >= $w->width)
  375.   {
  376.    $w->xview('scroll', 2, 'units');
  377.   }
  378.  elsif($x < 0)
  379.   {
  380.    $w->xview('scroll', -2, 'units');
  381.   }
  382.  else
  383.   {
  384.    return;
  385.   }
  386.  $w->RepeatId($w->after(50,"AutoScan",$w));
  387.  $w->Button1Motion;
  388. }
  389.  
  390. 1;
  391.  
  392.