Netrunner 2004 October/NETRUNNER0410.ISO/regular/ActivePerl-5.8.4.810-MSWin32-x86.msi/_3931055eb36d7d7e2599914b473b8b02

Text File | 2004-06-01 | 26.8 KB | 986 lines

# Copyright (c) 1999 Greg London. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

# code for bindings taken from Listbox.pm

# comments specifying method functionality taken from
# "Perl/Tk Pocket Reference" by Stephen Lidie.

#######################################################################
# this module uses a text module as its base class to create a list box.
# this will allow list box functionality to also have all the functionality
# of the Text widget.
#
# note that most methods use an element number to indicate which
# element in the list to work on.
# the exception to this is the tag and mark methods which
# are dual natured. These methods may accept either the
# normal element number, or they will also take a element.char index,
# which would be useful for applying tags to part of a line in the list.
#
#######################################################################

package Tk::TextList;

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

#XXXdel: use Tk::Reindex qw(Tk::ROText); #XXXdel: ReindexedROText);

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

use Tk qw (Ev);

#XXX del: use base qw(Tk::ReindexedROText);

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.
   #########################################################################
   if (defined($selection_list[-1]) and ($first == $selection_list[-1]))
    {
     $first++; # count this selection starting from the next line.
    }

   if ($lastcol==0)
    {
    $last-=1;
    }

   #########################################################################
   # if incrementing $first causes it to be greater than $last,
   # then do nothing,
   # else add (first .. last) to list
   #########################################################################
   unless ($first>$last)
    {
    push(@selection_list, $first .. $last);
    }
  }
 return @selection_list;
}


#######################################################################
# deletes range of elements from element1 to element2
# defaults to element1
#######################################################################
sub delete
{
 my ($w, $element1, $element2)=@_;
 $element1=$w->index($element1);
 $element2=$element1 unless(defined($element2));
 $element2=$w->index($element2);
 $w->SUPER::delete($element1.'.0' , $element2.'.0 lineend');
}

#######################################################################
# deletes range of characters from index1 to index2
# defaults to index1+1c
# index is line.char notation.
#######################################################################
sub deleteChar
{
 my ($w, $index1, $index2)=@_;
 $index1=$w->index($index1);
 $index2=$index1.' +1c' unless(defined($index2));
 $index2=$w->index($index2);
 $w->SUPER::delete($index1, $index2);
}

#######################################################################
# returns as a list contents of elements from $element1 to $element2
# defaults to element1.
#######################################################################
sub get
{
 my ($w, $element1, $element2)=@_;
 $element1=$w->index($element1);
 $element2=$element1 unless(defined($element2));
 $element2=$w->index($element2);
 my @getlist;
 for(my $i=$element1; $i<=$element2; $i++)
  {
  push(@getlist, $w->SUPER::get($i.'.0 linestart', $i.'.0 lineend'));
  }

 return @getlist;
}

#######################################################################
# return text between index1 and index2 which are line.char notation.
# return value is a single string. index2 defaults to index1+1c
# index is line.char notation.
######################################################################
sub getChar
{
 my $w=shift;
 return $w->SUPER::get(@_);
}

#######################################################################
# returns index in number notation
# this method returns an element number, ie the 5th element.
#######################################################################
sub index
{
 my ($w,$element)=@_;
 return undef unless(defined($element));
 $element .= '.0' unless $element=~/\D/;
 $element = $w->SUPER::index($element);
 my($line,$col)=split(/\./,$element);
 return $line;
}

#######################################################################
# returns index in line.char notation
# this method returns an index specific to a character within an element
#######################################################################
sub indexChar
{
 my $w=shift;
 return $w->SUPER::index(@_);
}


#######################################################################
# inserts specified elements just before element at index
#######################################################################
sub insert
{
 my $w=shift;
 my $element=shift;
 $element=$w->index($element);
 my $item;
 while (@_)
  {
  $item = shift(@_);
  $item .= "\n";
  $w->SUPER::insert($element++.'.0', $item);
  }
}

#######################################################################
# inserts string just before character at index.
# index is line.char notation.
#######################################################################
sub insertChar
{
 my $w=shift;
 $w->SUPER::insert(@_);
}



#######################################################################
# returns index of element nearest to y-coordinate
#
# currently not defined
#######################################################################
#sub nearest
#{
# return undef;
#}

#######################################################################
# Sets the selection anchor to element at index
#######################################################################
sub selectionAnchor
{
 my ($w, $element)=@_;
 $element=$w->index($element);
 $w->SUPER::mark('set', 'anchor', $element.'.0');
}

#######################################################################
#  deselects elements between index1 and index2, inclusive
#######################################################################
sub selectionClear
{
 my ($w, $element1, $element2)=@_;
 $element1=$w->index($element1);
 $element2=$element1 unless(defined($element2));
 $element2=$w->index($element2);
 $w->SUPER::tag('remove', 'sel', $element1.'.0', $element2.'.0 lineend +1c');
}

#######################################################################
# returns 1 if element at index is selected, 0 otherwise.
#######################################################################
sub selectionIncludes
{
 my ($w, $element)=@_;
 $element=$w->index($element);
 my @list = $w->curselection;
 my $line;
 foreach $line (@list)
  {
  if ($line == $element) {return 1;}
  }
 return 0;
}

#######################################################################
# adds all elements between element1 and element2 inclusive to selection
#######################################################################
sub selectionSet
{
 my ($w, $element1, $element2)=@_;
 $element1=$w->index($element1);
 $element2=$element1 unless(defined($element2));
 $element2=$w->index($element2);
 $w->SUPER::tag('add', 'sel', $element1.'.0', $element2.'.0 lineend +1c');
}

#######################################################################
# for ->selection(option,args) calling convention
#######################################################################
sub selection
{
# my ($w,$sub)=(shift,"selection".ucfirst(shift));
# no strict 'refs';
# # can't use $w->$sub, since it might call overridden method-- bleh
# &($sub)($w,@_);
}


#######################################################################
# adjusts the view in window so element at index is completely visible
#######################################################################
sub see
{
 my ($w, $element)=@_;
 $element=$w->index($element);
 $w->SUPER::see($element.'.0');
}

#######################################################################
# returns number of elements in listbox
#######################################################################
sub size
{
 my ($w)=@_;
 my $element = $w->index('end');
 # theres a weird thing with the 'end' mark sometimes being on a line
 # with text, and sometimes being on a line all by itself
 my ($text) = $w->get($element);
 if (length($text) == 0)
  {$element -= 1;}
 return $element;
}



#######################################################################
# add a tag based on element numbers
#######################################################################
sub tagAdd
{
 my ($w, $tagName, $element1, $element2)=@_;
 $element1=$w->index($element1);
 $element1.='.0';

 $element2=$element1.' lineend' unless(defined($element2));
 $element2=$w->index($element2);
 $element2.='.0 lineend +1c';

 $w->SUPER::tag('add', $tagName, $element1, $element2);
}

#######################################################################
# add a tag based on line.char indexes
#######################################################################
sub tagAddChar
{
 my $w=shift;
 $w->SUPER::tag('add',@_);
}


#######################################################################
# remove a tag based on element numbers
#######################################################################
sub tagRemove
{
 my ($w, $tagName, $element1, $element2)=@_;
 $element1=$w->index($element1);
 $element1.='.0';

 $element2=$element1.' lineend' unless(defined($element2));
 $element2=$w->index($element2);
 $element2.='.0 lineend +1c';

 $w->SUPER::tag('remove', 'sel', $element1, $element2);
}

#######################################################################
# remove a tag based on line.char indexes
#######################################################################
sub tagRemoveChar
{
 my $w=shift;
 $w->SUPER::tag('remove', @_);
}




#######################################################################
# perform tagNextRange based on element numbers
#######################################################################
sub tagNextRange
{
 my ($w, $tagName, $element1, $element2)=@_;
 $element1=$w->index($element1);
 $element1.='.0';

 $element2=$element1 unless(defined($element2));
 $element2=$w->index($element2);
 $element2.='.0 lineend +1c';

 my $index = $w->SUPER::tag('nextrange', 'sel', $element1, $element2);
 my ($line,$col)=split(/\./,$index);
 return $line;
}

#######################################################################
# perform tagNextRange based on line.char indexes
#######################################################################
sub tagNextRangeChar
{
 my $w=shift;
 $w->SUPER::tag('nextrange', @_);
}

#######################################################################
# perform tagPrevRange based on element numbers
#######################################################################
sub tagPrevRange
{
 my ($w, $tagName, $element1, $element2)=@_;
 $element1=$w->index($element1);
 $element1.='.0';

 $element2=$element1 unless(defined($element2));
 $element2=$w->index($element2);
 $element2.='.0 lineend +1c';

 my $index = $w->SUPER::tag('prevrange', 'sel', $element1, $element2);
 my ($line,$col)=split(/\./,$index);
 return $line;
}

#######################################################################
# perform tagPrevRange based on line.char indexes
#######################################################################
sub tagPrevRangeChar
{
 my $w=shift;
 $w->SUPER::tag('prevrange', @_);
}



#######################################################################
# perform markSet based on element numbers
#######################################################################
sub markSet
{
 my ($w,$mark,$element1)=@_;
 $element1=$w->index($element1);
 $element1.='.0';
 $w->SUPER::mark('set', $element1,$mark);
}

#######################################################################
# perform markSet based on line.char indexes
#######################################################################
sub markSetChar
{
 my $w=shift;
 $w->SUPER::mark('set', @_);
}

#######################################################################
# perform markNext based on element numbers
#######################################################################
sub markNext
{
 my ($w,$element1)=@_;
 $element1=$w->index($element1);
 $element1.='.0';
 return $w->SUPER::mark('next', $element1);
}

#######################################################################
# perform markNext based on line.char indexes
#######################################################################
sub markNextChar
{
 my $w=shift;
 $w->SUPER::mark('next', @_);
}


#######################################################################
# perform markPrevious based on element numbers
#######################################################################
sub markPrevious
{
 my ($w,$element1)=@_;
 $element1=$w->index($element1);
 $element1.='.0';
 return $w->SUPER::mark('previous', $element1);
}

#######################################################################
# perform markPrevious based on line.char indexes
#######################################################################
sub markPreviousChar
{
 my $w=shift;
 $w->SUPER::mark('previous', @_);
}




sub ButtonRelease_1
{
 my $w = shift;
 my $Ev = $w->XEvent;
 $w->CancelRepeat;
 $w->activate($Ev->xy);
}


sub Cntrl_Home
{
 my $w = shift;
 my $Ev = $w->XEvent;
 $w->activate(0);
 $w->see(0);
 $w->selectionClear(0,'end');
 $w->selectionSet(0)
}


sub Cntrl_End
{
 my $w = shift;
 my $Ev = $w->XEvent;
 $w->activate('end');
 $w->see('end');
 $w->selectionClear(0,'end');
 $w->selectionSet('end')
}


sub Cntrl_backslash
{
 my $w = shift;
 my $Ev = $w->XEvent;
 if ($w->cget('-selectmode') ne 'browse')
 {
 $w->selectionClear(0,'end');
 }
}

# BeginSelect --
#
# This procedure is typically invoked on button-1 presses. It begins
# the process of making a selection in the listbox. Its exact behavior
# depends on the selection mode currently in effect for the listbox;
# see the Motif documentation for details.
#
# Arguments:
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
sub BeginSelect
{
 my $w = shift;
 my $el = shift;
 if ($w->cget('-selectmode') eq 'multiple')
  {
   if ($w->selectionIncludes($el))
    {
     $w->selectionClear($el)
    }
   else
    {
     $w->selectionSet($el)
    }
  }
 else
  {
   $w->selectionClear(0,'end');
   $w->selectionSet($el);
   $w->selectionAnchor($el);
   my @list = ();
   $w->{'SELECTION_LIST_REF'} = \@list;
   $w->{'PREVIOUS_ELEMENT'} = $el
  }
 $w->focus if ($w->cget('-takefocus'));
}
# Motion --
#
# This procedure is called to process mouse motion events while
# button 1 is down. It may move or extend the selection, depending
# on the listbox's selection mode.
#
# Arguments:
# w - The listbox widget.
# el - The element under the pointer (must be a number).
sub Motion
{
 my $w = shift;
 my $el = shift;
 if (defined($w->{'PREVIOUS_ELEMENT'}) && $el == $w->{'PREVIOUS_ELEMENT'})
  {
   return;
  }

 # if no selections, select current
 if($w->curselection==0)
  {
  $w->activate($el);
  $w->selectionSet($el);
  $w->selectionAnchor($el);
  $w->{'PREVIOUS_ELEMENT'}=$el;
  return;
  }

 my $anchor = $w->index('anchor');
 my $mode = $w->cget('-selectmode');
 if ($mode eq 'browse')
  {
   $w->selectionClear(0,'end');
   $w->selectionSet($el);
   $w->{'PREVIOUS_ELEMENT'} = $el;
  }
 elsif ($mode eq 'extended')
  {
   my $i = $w->{'PREVIOUS_ELEMENT'};
   if ($w->selectionIncludes('anchor'))
    {
     $w->selectionClear($i,$el);
     $w->selectionSet('anchor',$el)
    }
   else
    {
     $w->selectionClear($i,$el);
     $w->selectionClear('anchor',$el)
    }
   while ($i < $el && $i < $anchor)
    {
     if (Tk::lsearch($w->{'SELECTION_LIST_REF'},$i) >= 0)
      {
       $w->selectionSet($i)
      }
     $i += 1
    }
   while ($i > $el && $i > $anchor)
    {
     if (Tk::lsearch($w->{'SELECTION_LIST_REF'},$i) >= 0)
      {
       $w->selectionSet($i)
      }
     $i += -1
    }
   $w->{'PREVIOUS_ELEMENT'} = $el
  }
}
# BeginExtend --
#
# This procedure is typically invoked on shift-button-1 presses. It
# begins the process of extending a selection in the listbox. Its
# exact behavior depends on the selection mode currently in effect
# for the listbox; see the Motif documentation for details.
#
# Arguments:
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
sub BeginExtend
{
 my $w = shift;
 my $el = shift;

 # if no selections, select current
 if($w->curselection==0)
  {
  $w->activate($el);
  $w->selectionSet($el);
  $w->selectionAnchor($el);
  $w->{'PREVIOUS_ELEMENT'}=$el;
  return;
  }

 if ($w->cget('-selectmode') eq 'extended' && $w->selectionIncludes('anchor'))
  {
   $w->Motion($el)
  }
}
# BeginToggle --
#
# This procedure is typically invoked on control-button-1 presses. It
# begins the process of toggling a selection in the listbox. Its
# exact behavior depends on the selection mode currently in effect
# for the listbox; see the Motif documentation for details.
#
# Arguments:
# w - The listbox widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
sub BeginToggle
{
 my $w = shift;
 my $el = shift;
 if ($w->cget('-selectmode') eq 'extended')
  {
   my @list = $w->curselection();
   $w->{'SELECTION_LIST_REF'} = \@list;
   $w->{'PREVIOUS_ELEMENT'} = $el;
   $w->selectionAnchor($el);
   if ($w->selectionIncludes($el))
    {
     $w->selectionClear($el)
    }
   else
    {
     $w->selectionSet($el)
    }
  }
}
# AutoScan --
# This procedure is invoked when the mouse leaves an entry window
# with button 1 down. It scrolls the window up, down, left, or
# right, depending on where the mouse left the window, and reschedules
# itself as an "after" command so that the window continues to scroll until
# the mouse moves back into the window or the mouse button is released.
#
# Arguments:
# w - The entry window.
# x - The x-coordinate of the mouse when it left the window.
# y - The y-coordinate of the mouse when it left the window.
sub AutoScan
{
 my $w = shift;
 my $x = shift;
 my $y = shift;
 if ($y >= $w->height)
  {
   $w->yview('scroll',1,'units')
  }
 elsif ($y < 0)
  {
   $w->yview('scroll',-1,'units')
  }
 elsif ($x >= $w->width)
  {
   $w->xview('scroll',2,'units')
  }
 elsif ($x < 0)
  {
   $w->xview('scroll',-2,'units')
  }
 else
  {
   return;
  }
 $w->Motion($w->index("@" . $x . ',' . $y));
 $w->RepeatId($w->after(50,'AutoScan',$w,$x,$y));
}
# UpDown --
#
# Moves the location cursor (active element) up or down by one element,
# and changes the selection if we're in browse or extended selection
# mode.
#
# Arguments:
# w - The listbox widget.
# amount - +1 to move down one item, -1 to move back one item.
sub UpDown
{
 my $w = shift;
 my $amount = shift;
 $w->activate($w->index('active')+$amount);
 $w->see('active');
 my $selectmode = $w->cget('-selectmode');
 if ($selectmode eq 'browse')
  {
   $w->selectionClear(0,'end');
   $w->selectionSet('active')
  }
 elsif ($selectmode eq 'extended')
  {
   $w->selectionClear(0,'end');
   $w->selectionSet('active');
   $w->selectionAnchor('active');
   $w->{'PREVIOUS_ELEMENT'} = $w->index('active');
   my @list = ();
   $w->{'SELECTION_LIST_REF'}=\@list;
  }
}
# ExtendUpDown --
#
# Does nothing unless we're in extended selection mode; in this
# case it moves the location cursor (active element) up or down by
# one element, and extends the selection to that point.
#
# Arguments:
# w - The listbox widget.
# amount - +1 to move down one item, -1 to move back one item.
sub ExtendUpDown
{
 my $w = shift;
 my $amount = shift;
 if ($w->cget('-selectmode') ne 'extended')
  {
   return;
  }
 $w->activate($w->index('active')+$amount);
 $w->see('active');
 $w->Motion($w->index('active'))
}
# DataExtend
#
# This procedure is called for key-presses such as Shift-KEndData.
# If the selection mode isn't multiple or extend then it does nothing.
# Otherwise it moves the active element to el and, if we're in
# extended mode, extends the selection to that point.
#
# Arguments:
# w - The listbox widget.
# el - An integer element number.
sub DataExtend
{
 my $w = shift;
 my $el = shift;
 my $mode = $w->cget('-selectmode');
 if ($mode eq 'extended')
  {
   $w->activate($el);
   $w->see($el);
   if ($w->selectionIncludes('anchor'))
    {
     $w->Motion($el)
    }
  }
 elsif ($mode eq 'multiple')
  {
   $w->activate($el);
   $w->see($el)
  }
}
# Cancel
#
# This procedure is invoked to cancel an extended selection in
# progress. If there is an extended selection in progress, it
# restores all of the items between the active one and the anchor
# to their previous selection state.
#
# Arguments:
# w - The listbox widget.
sub Cancel
{
 my $w = shift;
 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;