diff options
Diffstat (limited to 'Master/tlpkg/tlperl.old/lib/Tk/Listbox.pm')
-rw-r--r-- | Master/tlpkg/tlperl.old/lib/Tk/Listbox.pm | 910 |
1 files changed, 910 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.old/lib/Tk/Listbox.pm b/Master/tlpkg/tlperl.old/lib/Tk/Listbox.pm new file mode 100644 index 00000000000..249a8eed7f4 --- /dev/null +++ b/Master/tlpkg/tlperl.old/lib/Tk/Listbox.pm @@ -0,0 +1,910 @@ +# Converted from listbox.tcl -- +# +# This file defines the default bindings for Tk listbox widgets. +# +# @(#) listbox.tcl 1.7 94/12/17 16:05:18 +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# Modifications from standard Listbox.pm +# -------------------------------------- +# 27-JAN-2001 Alasdair Allan +# Modified for local use by adding tied scalar and arrays +# Implemented TIESCALAR, TIEARRAY, FETCH, FETCHSIZE, STORE, CLEAR & EXTEND +# 31-JAN-2001 Alasdair Allan +# Made changes suggested by Tim Jenness +# 03-FEB-2001 Alasdair Allan +# Modified STORE for tied scalars to clear and select elements +# 06-FEB-2001 Alasdair Allan +# Added POD documentation for tied listbox +# 13-FEB-2001 Alasdair Allan +# Implemented EXISTS, DELETE, PUSH, POP, SHIFT & UNSHIFT for tied arrays +# 14-FEB-2001 Alasdair Allan +# Implemented SPLICE for tied arrays, all tied functionality in place +# 16-FEB-2001 Alasdair Allan +# Tweak to STORE interface for tied scalars +# 23-FEB-2001 Alasdair Allan +# Added flag to FETCH for tied scalars, modified to return hashes +# 24-FEB-2001 Alasdair Allan +# Updated Pod documentation +# + +package Tk::Listbox; + +use vars qw($VERSION @Selection $Prev); +use strict; +$VERSION = sprintf '4.%03d', q$Revision: #14 $ =~ /\D(\d+)\s*$/; + +use Tk qw(Ev $XS_VERSION); +use Tk::Clipboard (); +use AutoLoader; + +use base qw(Tk::Clipboard Tk::Widget); + +Construct Tk::Widget 'Listbox'; + +bootstrap Tk::Listbox; + +sub Tk_cmd { \&Tk::listbox } + +Tk::Methods('activate','bbox','curselection','delete','get','index', + 'insert','itemcget','itemconfigure','nearest','scan','see', + 'selection','size','xview','yview'); + +use Tk::Submethods ( 'selection' => [qw(anchor clear includes set)], + 'scan' => [qw(mark dragto)], + 'xview' => [qw(moveto scroll)], + 'yview' => [qw(moveto scroll)], + ); + +*Getselected = \&getSelected; + +sub clipEvents +{ + return qw[Copy]; +} + +sub BalloonInfo +{ + my ($listbox,$balloon,$X,$Y,@opt) = @_; + my $e = $listbox->XEvent; + return if !$e; + my $index = $listbox->index('@' . $e->x . ',' . $e->y); + foreach my $opt (@opt) + { + my $info = $balloon->GetOption($opt,$listbox); + if ($opt =~ /^-(statusmsg|balloonmsg)$/ && UNIVERSAL::isa($info,'ARRAY')) + { + $balloon->Subclient($index); + if (defined $info->[$index]) + { + return $info->[$index]; + } + return ''; + } + return $info; + } +} + +sub ClassInit +{ + my ($class,$mw) = @_; + $class->SUPER::ClassInit($mw); + # Standard Motif bindings: + $mw->bind($class,'<1>',[sub { + my $w = shift; + if (Tk::Exists($w)) { + $w->BeginSelect(@_); + } + }, Ev('index',Ev('@'))]); + $mw->bind($class, '<Double-1>' => \&Tk::NoOp); + $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->bind($class,'<Prior>', sub { + my $w = shift; + $w->yview('scroll',-1,'pages'); + $w->activate('@0,0'); + }); + $mw->bind($class,'<Next>', sub { + my $w = shift; + $w->yview('scroll',1,'pages'); + $w->activate('@0,0'); + }); + $mw->bind($class,'<Control-Prior>', ['xview', 'scroll', -1, 'pages']); + $mw->bind($class,'<Control-Next>', ['xview', 'scroll', 1, 'pages']); + # <Home> and <End> defined in XscrollBind + $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']); + # XXX What about <<Copy>>? Already handled in Tk::Clipboard? + # $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->MouseWheelBind($class); # XXX Both needed? + $mw->YMouseWheelBind($class); + return $class; +} + +1; +__END__ + +sub TIEARRAY { + my ( $class, $obj, %options ) = @_; + return bless { + OBJECT => \$obj, + OPTION => \%options }, $class; +} + + + +sub TIESCALAR { + my ( $class, $obj, %options ) = @_; + return bless { + OBJECT => \$obj, + OPTION => \%options }, $class; +} + +# FETCH +# ----- +# Return either the full contents or only the selected items in the +# box depending on whether we tied it to an array or scalar respectively +sub FETCH { + my $class = shift; + + my $self = ${$class->{OBJECT}}; + my %options = %{$class->{OPTION}} if defined $class->{OPTION};; + + # Define the return variable + my $result; + + # Check whether we are have a tied array or scalar quantity + if ( @_ ) { + my $i = shift; + # The Tk:: Listbox has been tied to an array, we are returning + # an array list of the current items in the Listbox + $result = $self->get($i); + } else { + # The Tk::Listbox has been tied to a scalar, we are returning a + # reference to an array or hash containing the currently selected items + my ( @array, %hash ); + + if ( defined $options{ReturnType} ) { + + # THREE-WAY SWITCH + if ( $options{ReturnType} eq "index" ) { + $result = [$self->curselection]; + } elsif ( $options{ReturnType} eq "element" ) { + foreach my $selection ( $self->curselection ) { + push(@array,$self->get($selection)); } + $result = \@array; + } elsif ( $options{ReturnType} eq "both" ) { + foreach my $selection ( $self->curselection ) { + %hash = ( %hash, $selection => $self->get($selection)); } + $result = \%hash; + } + } else { + # return elements (default) + foreach my $selection ( $self->curselection ) { + push(@array,$self->get($selection)); } + $result = \@array; + } + } + return $result; +} + +# FETCHSIZE +# --------- +# Return the number of elements in the Listbox when tied to an array +sub FETCHSIZE { + my $class = shift; + return ${$class->{OBJECT}}->size(); +} + +# STORE +# ----- +# If tied to an array we will modify the Listbox contents, while if tied +# to a scalar we will select and clear elements. +sub STORE { + + if ( scalar(@_) == 2 ) { + # we have a tied scalar + my ( $class, $selected ) = @_; + my $self = ${$class->{OBJECT}}; + my %options = %{$class->{OPTION}} if defined $class->{OPTION};; + + # clear currently selected elements + $self->selectionClear(0,'end'); + + # set selected elements + if ( defined $options{ReturnType} ) { + + # THREE-WAY SWITCH + if ( $options{ReturnType} eq "index" ) { + for ( my $i=0; $i < scalar(@$selected) ; $i++ ) { + for ( my $j=0; $j < $self->size() ; $j++ ) { + if( $j == $$selected[$i] ) { + $self->selectionSet($j); last; } + } + } + } elsif ( $options{ReturnType} eq "element" ) { + for ( my $k=0; $k < scalar(@$selected) ; $k++ ) { + for ( my $l=0; $l < $self->size() ; $l++ ) { + if( $self->get($l) eq $$selected[$k] ) { + $self->selectionSet($l); last; } + } + } + } elsif ( $options{ReturnType} eq "both" ) { + foreach my $key ( keys %$selected ) { + $self->selectionSet($key) + if $$selected{$key} eq $self->get($key); + } + } + } else { + # return elements (default) + for ( my $k=0; $k < scalar(@$selected) ; $k++ ) { + for ( my $l=0; $l < $self->size() ; $l++ ) { + if( $self->get($l) eq $$selected[$k] ) { + $self->selectionSet($l); last; } + } + } + } + + } else { + # we have a tied array + my ( $class, $index, $value ) = @_; + my $self = ${$class->{OBJECT}}; + + # check size of current contents list + my $sizeof = $self->size(); + + if ( $index <= $sizeof ) { + # Change a current listbox entry + $self->delete($index); + $self->insert($index, $value); + } else { + # Add a new value + if ( defined $index ) { + $self->insert($index, $value); + } else { + $self->insert("end", $value); + } + } + } +} + +# CLEAR +# ----- +# Empty the Listbox of contents if tied to an array +sub CLEAR { + my $class = shift; + ${$class->{OBJECT}}->delete(0, 'end'); +} + +# EXTEND +# ------ +# Do nothing and be happy about it +sub EXTEND { } + +# PUSH +# ---- +# Append elements onto the Listbox contents +sub PUSH { + my ( $class, @list ) = @_; + ${$class->{OBJECT}}->insert('end', @list); +} + +# POP +# --- +# Remove last element of the array and return it +sub POP { + my $class = shift; + + my $value = ${$class->{OBJECT}}->get('end'); + ${$class->{OBJECT}}->delete('end'); + return $value; +} + +# SHIFT +# ----- +# Removes the first element and returns it +sub SHIFT { + my $class = shift; + + my $value = ${$class->{OBJECT}}->get(0); + ${$class->{OBJECT}}->delete(0); + return $value +} + +# UNSHIFT +# ------- +# Insert elements at the beginning of the Listbox +sub UNSHIFT { + my ( $class, @list ) = @_; + ${$class->{OBJECT}}->insert(0, @list); +} + +# DELETE +# ------ +# Delete element at specified index +sub DELETE { + my ( $class, @list ) = @_; + + my $value = ${$class->{OBJECT}}->get(@list); + ${$class->{OBJECT}}->delete(@list); + return $value; +} + +# EXISTS +# ------ +# Returns true if the index exist, and undef if not +sub EXISTS { + my ( $class, $index ) = @_; + return undef unless ${$class->{OBJECT}}->get($index); +} + +# SPLICE +# ------ +# Performs equivalent of splice on the listbox contents +sub SPLICE { + my $class = shift; + + my $self = ${$class->{OBJECT}}; + + # check for arguments + my @elements; + if ( scalar(@_) == 0 ) { + # none + @elements = $self->get(0,'end'); + $self->delete(0,'end'); + return wantarray ? @elements : $elements[scalar(@elements)-1];; + + } elsif ( scalar(@_) == 1 ) { + # $offset + my ( $offset ) = @_; + if ( $offset < 0 ) { + my $start = $self->size() + $offset; + if ( $start > 0 ) { + @elements = $self->get($start,'end'); + $self->delete($start,'end'); + return wantarray ? @elements : $elements[scalar(@elements)-1]; + } else { + return undef; + } + } else { + @elements = $self->get($offset,'end'); + $self->delete($offset,'end'); + return wantarray ? @elements : $elements[scalar(@elements)-1]; + } + + } elsif ( scalar(@_) == 2 ) { + # $offset and $length + my ( $offset, $length ) = @_; + if ( $offset < 0 ) { + my $start = $self->size() + $offset; + my $end = $self->size() + $offset + $length - 1; + if ( $start > 0 ) { + @elements = $self->get($start,$end); + $self->delete($start,$end); + return wantarray ? @elements : $elements[scalar(@elements)-1]; + } else { + return undef; + } + } else { + @elements = $self->get($offset,$offset+$length-1); + $self->delete($offset,$offset+$length-1); + return wantarray ? @elements : $elements[scalar(@elements)-1]; + } + + } else { + # $offset, $length and @list + my ( $offset, $length, @list ) = @_; + if ( $offset < 0 ) { + my $start = $self->size() + $offset; + my $end = $self->size() + $offset + $length - 1; + if ( $start > 0 ) { + @elements = $self->get($start,$end); + $self->delete($start,$end); + $self->insert($start,@list); + return wantarray ? @elements : $elements[scalar(@elements)-1]; + } else { + return undef; + } + } else { + @elements = $self->get($offset,$offset+$length-1); + $self->delete($offset,$offset+$length-1); + $self->insert($offset,@list); + return wantarray ? @elements : $elements[scalar(@elements)-1]; + } + } +} + +# ---- + +# +# Bind -- +# This procedure is invoked the first time the mouse enters a listbox +# widget or a listbox widget receives the input focus. It creates +# all of the class bindings for listboxes. +# +# Arguments: +# event - Indicates which event caused the procedure to be invoked +# (Enter or FocusIn). It is used so that we can carry out +# the functions of that event in addition to setting up +# bindings. + +sub xyIndex +{ + my $w = shift; + my $Ev = $w->XEvent; + return $w->index($Ev->xy); +} + +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); + $w->eventGenerate("<<ListboxSelect>>"); +} + + +sub Cntrl_End +{ + my $w = shift; + my $Ev = $w->XEvent; + $w->activate('end'); + $w->see('end'); + $w->selectionClear(0,'end'); + $w->selectionSet('end'); + $w->eventGenerate("<<ListboxSelect>>"); +} + + +sub Cntrl_backslash +{ + my $w = shift; + my $Ev = $w->XEvent; + if ($w->cget('-selectmode') ne 'browse') + { + $w->selectionClear(0,'end'); + $w->eventGenerate("<<ListboxSelect>>"); + } +} + +# 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); + @Selection = (); + $Prev = $el + } + $w->focus if ($w->cget('-takefocus')); + $w->eventGenerate("<<ListboxSelect>>"); +} +# 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($Prev) && $el == $Prev) + { + return; + } + my $anchor = $w->index('anchor'); + my $mode = $w->cget('-selectmode'); + if ($mode eq 'browse') + { + $w->selectionClear(0,'end'); + $w->selectionSet($el); + $Prev = $el; + $w->eventGenerate("<<ListboxSelect>>"); + } + elsif ($mode eq 'extended') + { + my $i = $Prev; + if (!defined $i || $i eq '') + { + $i = $el; + $w->selectionSet($el); + } + if ($w->selectionIncludes('anchor')) + { + $w->selectionClear($i,$el); + $w->selectionSet('anchor',$el) + } + else + { + $w->selectionClear($i,$el); + $w->selectionClear('anchor',$el) + } + if (!@Selection) + { + @Selection = $w->curselection; + } + while ($i < $el && $i < $anchor) + { + if (Tk::lsearch(\@Selection,$i) >= 0) + { + $w->selectionSet($i) + } + $i++ + } + while ($i > $el && $i > $anchor) + { + if (Tk::lsearch(\@Selection,$i) >= 0) + { + $w->selectionSet($i) + } + $i-- + } + $Prev = $el; + $w->eventGenerate("<<ListboxSelect>>"); + } +} +# 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 ($w->cget('-selectmode') eq 'extended' && $w->selectionIncludes('anchor')) + { + $w->Motion($el) + } + else + { + # No selection yet; simulate the begin-select operation. + $w->BeginSelect($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') + { + @Selection = $w->curselection(); + $Prev = $el; + $w->selectionAnchor($el); + if ($w->selectionIncludes($el)) + { + $w->selectionClear($el) + } + else + { + $w->selectionSet($el) + } + $w->eventGenerate("<<ListboxSelect>>"); + } +} +# 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; + return if !Tk::Exists($w); + 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 $mode = $w->cget('-selectmode'); + if ($mode eq 'browse') + { + $w->selectionClear(0,'end'); + $w->selectionSet('active'); + $w->eventGenerate("<<ListboxSelect>>"); + } + elsif ($mode eq 'extended') + { + $w->selectionClear(0,'end'); + $w->selectionSet('active'); + $w->selectionAnchor('active'); + $Prev = $w->index('active'); + @Selection = (); + $w->eventGenerate("<<ListboxSelect>>"); + } +} +# 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; + } + my $active = $w->index('active'); + if (!@Selection) + { + $w->selectionSet($active); + @Selection = $w->curselection; + } + $w->activate($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 $Prev) + { + return; + } + my $first = $w->index('anchor'); + my $last = $Prev; + if ($first > $last) + { + ($first, $last) = ($last, $first); + } + $w->selectionClear($first,$last); + while ($first <= $last) + { + if (Tk::lsearch(\@Selection,$first) >= 0) + { + $w->selectionSet($first) + } + $first++ + } + $w->eventGenerate("<<ListboxSelect>>"); +} +# 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') + } + $w->eventGenerate("<<ListboxSelect>>"); +} + +# Perl/Tk extensions: +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 $index = $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($index++,$_); + } +} + +sub getSelected +{ + my ($w) = @_; + my $i; + my (@result) = (); + foreach $i ($w->curselection) + { + push(@result,$w->get($i)); + } + return (wantarray) ? @result : $result[0]; +} + + + +1; +__END__ + + |