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