home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Text / SelectTo.al < prev    next >
Encoding:
Text File  |  1997-08-10  |  2.0 KB  |  82 lines
  1. # NOTE: Derived from ..\blib\lib\Tk\Text.pm.  Changes made here will be lost.
  2. package Tk::Text;
  3.  
  4. # SelectTo --
  5. # This procedure is invoked to extend the selection, typically when
  6. # dragging it with the mouse. Depending on the selection mode (character,
  7. # word, line) it selects in different-sized units. This procedure
  8. # ignores mouse motions initially until the mouse has moved from
  9. # one character to another or until there have been multiple clicks.
  10. #
  11. # Arguments:
  12. # w - The text window in which the button was pressed.
  13. # index - Index of character at which the mouse button was pressed.
  14. sub SelectTo
  15. {
  16.  my $w = shift;
  17.  my $index = shift;
  18.  $Tk::selectMode = shift if (@_);
  19.  my $cur = $w->index($index);
  20.  my $anchor = Tk::catch { $w->index("anchor") };
  21.  if (!defined $anchor)
  22.   {
  23.    $w->mark("set","anchor",$anchor = $cur);
  24.    $Tk::mouseMoved = 0;
  25.   }
  26.  elsif ($w->compare($cur,"!=",$anchor))
  27.   {
  28.    $Tk::mouseMoved = 1;
  29.   }
  30.  $Tk::selectMode = 'char' unless (defined $Tk::selectMode);
  31.  my $mode = $Tk::selectMode;
  32.  my ($first,$last);
  33.  if ($mode eq "char")
  34.   {
  35.    if ($w->compare($cur,"<","anchor"))
  36.     {
  37.      $first = $cur;
  38.      $last = "anchor";
  39.     }
  40.    else
  41.     {
  42.      $first = "anchor";
  43.      $last = $cur
  44.     }
  45.   }
  46.  elsif ($mode eq "word")
  47.   {
  48.    if ($w->compare($cur,"<","anchor"))
  49.     {
  50.      $first = $w->index("$cur wordstart");
  51.      $last = $w->index("anchor - 1c wordend")
  52.     }
  53.    else
  54.     {
  55.      $first = $w->index("anchor wordstart");
  56.      $last = $w->index("$cur wordend")
  57.     }
  58.   }
  59.  elsif ($mode eq "line")
  60.   {
  61.    if ($w->compare($cur,"<","anchor"))
  62.     {
  63.      $first = $w->index("$cur linestart");
  64.      $last = $w->index("anchor - 1c lineend + 1c")
  65.     }
  66.    else
  67.     {
  68.      $first = $w->index("anchor linestart");
  69.      $last = $w->index("$cur lineend + 1c")
  70.     }
  71.   }
  72.  if ($Tk::mouseMoved || $Tk::selectMode ne "char")
  73.   {
  74.    $w->tag("remove","sel","0.0",$first);
  75.    $w->tag("add","sel",$first,$last);
  76.    $w->tag("remove","sel",$last,"end");
  77.    $w->idletasks;
  78.   }
  79. }
  80.  
  81. 1;
  82.