view release on metacpan or  search on metacpan

TextList/TextList.pm  view on Meta::CPAN

package Tk::TextList;

use strict;
use vars qw($VERSION);
$VERSION = '4.006'; # $Id: //depot/Tkutf8/TextList/TextList.pm#5 $

use base qw(Tk::Derived Tk::ReindexedROText );

use Tk qw (Ev);

Construct Tk::Widget 'TextList';

#######################################################################
# the following line causes Populate to get called
# @ISA = qw(Tk::Derived ... );
#######################################################################
sub Populate
{
 my ($w,$args)=@_;
 my $option=delete $args->{'-selectmode'};
 $w->SUPER::Populate($args);
 $w->ConfigSpecs( -selectmode  => ['PASSIVE','selectMode','SelectMode','browse'],
		  -takefocus   => ['PASSIVE','takeFocus','TakeFocus',1],
		  -spacing3    => ['SELF', undef, undef, 3],
		  -insertwidth => ['SELF', undef, undef, 0],
		);

}

#######################################################################
#######################################################################
sub ClassInit
{
 my ($class,$mw) = @_;

 # Standard Motif bindings:
 $mw->bind($class,'<1>',['BeginSelect',Ev('index',Ev('@'))]);
 $mw->bind($class,'<B1-Motion>',['Motion',Ev('index',Ev('@'))]);
 $mw->bind($class,'<ButtonRelease-1>','ButtonRelease_1');

 $mw->bind($class,'<Shift-1>',['BeginExtend',Ev('index',Ev('@'))]);
 $mw->bind($class,'<Control-1>',['BeginToggle',Ev('index',Ev('@'))]);

 $mw->bind($class,'<B1-Leave>',['AutoScan',Ev('x'),Ev('y')]);
 $mw->bind($class,'<B1-Enter>','CancelRepeat');
 $mw->bind($class,'<Up>',['UpDown',-1]);
 $mw->bind($class,'<Shift-Up>',['ExtendUpDown',-1]);
 $mw->bind($class,'<Down>',['UpDown',1]);
 $mw->bind($class,'<Shift-Down>',['ExtendUpDown',1]);

 $mw->XscrollBind($class);
 $mw->PriorNextBind($class);

 $mw->bind($class,'<Control-Home>','Cntrl_Home');

 $mw->bind($class,'<Shift-Control-Home>',['DataExtend',0]);
 $mw->bind($class,'<Control-End>','Cntrl_End');

 $mw->bind($class,'<Shift-Control-End>',['DataExtend','end']);
 $class->clipboardOperations($mw,'Copy');
 $mw->bind($class,'<space>',['BeginSelect',Ev('index','active')]);
 $mw->bind($class,'<Select>',['BeginSelect',Ev('index','active')]);
 $mw->bind($class,'<Control-Shift-space>',['BeginExtend',Ev('index','active')]);
 $mw->bind($class,'<Shift-Select>',['BeginExtend',Ev('index','active')]);
 $mw->bind($class,'<Escape>','Cancel');
 $mw->bind($class,'<Control-slash>','SelectAll');
 $mw->bind($class,'<Control-backslash>','Cntrl_backslash');
 ;
 # Additional Tk bindings that aren't part of the Motif look and feel:
 $mw->bind($class,'<2>',['scan','mark',Ev('x'),Ev('y')]);
 $mw->bind($class,'<B2-Motion>',['scan','dragto',Ev('x'),Ev('y')]);

 $mw->bind($class,'<FocusIn>' , ['tagConfigure','_ACTIVE_TAG', -underline=>1]);
 $mw->bind($class,'<FocusOut>', ['tagConfigure','_ACTIVE_TAG', -underline=>0]);

 return $class;
}

#######################################################################
# set the active element to index
# "active" is a text "mark" which underlines the marked text.
#######################################################################
sub activate
{
 my($w,$element)=@_;
 $element= $w->index($element).'.0';
 $w->SUPER::tag('remove', '_ACTIVE_TAG', '1.0','end');
 $w->SUPER::tag('add', '_ACTIVE_TAG',
   $element.' linestart', $element.' lineend');
 $w->SUPER::mark('set', 'active', $element);
}


#######################################################################
# bbox returns a list (x,y,width,height) giving an approximate
# bounding box of character given by index
#######################################################################
sub bbox
{
 my($w,$element)=@_;
 $element=$w->index($element).'.0' unless ($element=~/\./);
 return $w->SUPER::bbox($element);
}

#######################################################################
# returns a list of indices of all elements currently selected
#######################################################################
sub curselection
{
 my ($w)=@_;
 my @ranges = $w->SUPER::tag('ranges', 'sel');
 my @selection_list;
 while (@ranges)
  {
   my ($first,$firstcol) = split(/\./,shift(@ranges));
   my ($last,$lastcol) = split(/\./,shift(@ranges));

   #########################################################################
   # if previous selection ended on the same line that this selection starts,
   # then fiddle the numbers so that this line number isnt included twice.

TextList/TextList.pm  view on Meta::CPAN

 if ($w->cget('-selectmode') ne 'extended' || !defined $w->{'PREVIOUS_ELEMENT'})
  {
   return;
  }
 my $first = $w->index('anchor');
 my $last = $w->{'PREVIOUS_ELEMENT'};
 if ($first > $last)
  {
  ($first,$last)=($last,$first);
  }
 $w->selectionClear($first,$last);
 while ($first <= $last)
  {
   if (Tk::lsearch($w->{'SELECTION_LIST_REF'},$first) >= 0)
    {
     $w->selectionSet($first)
    }
   $first += 1
  }
}
# SelectAll
#
# This procedure is invoked to handle the "select all" operation.
# For single and browse mode, it just selects the active element.
# Otherwise it selects everything in the widget.
#
# Arguments:
# w - The listbox widget.
sub SelectAll
{
 my $w = shift;
 my $mode = $w->cget('-selectmode');
 if ($mode eq 'single' || $mode eq 'browse')
  {
   $w->selectionClear(0,'end');
   $w->selectionSet('active')
  }
 else
  {
   $w->selectionSet(0,'end')
  }
}

sub SetList
{
 my $w = shift;
 $w->delete(0,'end');
 $w->insert('end',@_);
}

sub deleteSelected
{
 my $w = shift;
 my $i;
 foreach $i (reverse $w->curselection)
  {
   $w->delete($i);
  }
}

sub clipboardPaste
{
 my $w = shift;
 my $element = $w->index('active') || $w->index($w->XEvent->xy);
 my $str;
 eval {local $SIG{__DIE__}; $str = $w->clipboardGet };
 return if $@;
 foreach (split("\n",$str))
  {
   $w->insert($element++,$_);
  }
}

sub getSelected
{
 my ($w) = @_;
 my $i;
 my (@result) = ();
 foreach $i ($w->curselection)
  {
   push(@result,$w->get($i));
  }
 return (wantarray) ? @result : $result[0];
}



1;