diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/auto/Tk/Listbox')
36 files changed, 1073 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/AutoScan.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/AutoScan.al new file mode 100644 index 00000000000..89bda0179c6 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/AutoScan.al @@ -0,0 +1,49 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 676 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\AutoScan.al)" +# 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)); +} + +# end of Tk::Listbox::AutoScan +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginExtend.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginExtend.al new file mode 100644 index 00000000000..afd8f0e9fda --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginExtend.al @@ -0,0 +1,34 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 620 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\BeginExtend.al)" +# 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); + } +} + +# end of Tk::Listbox::BeginExtend +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginSelect.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginSelect.al new file mode 100644 index 00000000000..304a0afe1e1 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginSelect.al @@ -0,0 +1,46 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 515 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\BeginSelect.al)" +# 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>>"); +} + +# end of Tk::Listbox::BeginSelect +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginToggle.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginToggle.al new file mode 100644 index 00000000000..6c70e35d75a --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/BeginToggle.al @@ -0,0 +1,40 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 645 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\BeginToggle.al)" +# 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>>"); + } +} + +# end of Tk::Listbox::BeginToggle +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/ButtonRelease_1.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/ButtonRelease_1.al new file mode 100644 index 00000000000..ec8fa789fb9 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/ButtonRelease_1.al @@ -0,0 +1,16 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 471 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\ButtonRelease_1.al)" +sub ButtonRelease_1 +{ + my $w = shift; + my $Ev = $w->XEvent; + $w->CancelRepeat; + $w->activate($Ev->xy); +} + +# end of Tk::Listbox::ButtonRelease_1 +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/CLEAR.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/CLEAR.al new file mode 100644 index 00000000000..8ed6feba4b5 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/CLEAR.al @@ -0,0 +1,16 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 304 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\CLEAR.al)" +# CLEAR +# ----- +# Empty the Listbox of contents if tied to an array +sub CLEAR { + my $class = shift; + ${$class->{OBJECT}}->delete(0, 'end'); +} + +# end of Tk::Listbox::CLEAR +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cancel.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cancel.al new file mode 100644 index 00000000000..7ff924756f8 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cancel.al @@ -0,0 +1,42 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 805 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\Cancel.al)" +# 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>>"); +} + +# end of Tk::Listbox::Cancel +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_End.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_End.al new file mode 100644 index 00000000000..dad5a4bc0d1 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_End.al @@ -0,0 +1,19 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 492 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\Cntrl_End.al)" +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>>"); +} + +# end of Tk::Listbox::Cntrl_End +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_Home.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_Home.al new file mode 100644 index 00000000000..08131896da1 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_Home.al @@ -0,0 +1,19 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 480 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\Cntrl_Home.al)" +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>>"); +} + +# end of Tk::Listbox::Cntrl_Home +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_backslash.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_backslash.al new file mode 100644 index 00000000000..402426261a7 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Cntrl_backslash.al @@ -0,0 +1,19 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 504 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\Cntrl_backslash.al)" +sub Cntrl_backslash +{ + my $w = shift; + my $Ev = $w->XEvent; + if ($w->cget('-selectmode') ne 'browse') + { + $w->selectionClear(0,'end'); + $w->eventGenerate("<<ListboxSelect>>"); + } +} + +# end of Tk::Listbox::Cntrl_backslash +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/DELETE.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/DELETE.al new file mode 100644 index 00000000000..3dd81ad40fd --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/DELETE.al @@ -0,0 +1,19 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 355 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\DELETE.al)" +# DELETE +# ------ +# Delete element at specified index +sub DELETE { + my ( $class, @list ) = @_; + + my $value = ${$class->{OBJECT}}->get(@list); + ${$class->{OBJECT}}->delete(@list); + return $value; +} + +# end of Tk::Listbox::DELETE +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/DataExtend.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/DataExtend.al new file mode 100644 index 00000000000..4240300aa68 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/DataExtend.al @@ -0,0 +1,39 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 775 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\DataExtend.al)" +# 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) + } +} + +# end of Tk::Listbox::DataExtend +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/EXISTS.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/EXISTS.al new file mode 100644 index 00000000000..ae1ed1bc5e6 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/EXISTS.al @@ -0,0 +1,16 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 366 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\EXISTS.al)" +# EXISTS +# ------ +# Returns true if the index exist, and undef if not +sub EXISTS { + my ( $class, $index ) = @_; + return undef unless ${$class->{OBJECT}}->get($index); +} + +# end of Tk::Listbox::EXISTS +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/EXTEND.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/EXTEND.al new file mode 100644 index 00000000000..2a483ea08c1 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/EXTEND.al @@ -0,0 +1,16 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 312 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\EXTEND.al)" +# EXTEND +# ------ +# Do nothing and be happy about it +sub EXTEND { } + +# PUSH +# ---- +# Append elements onto the Listbox contents +# end of Tk::Listbox::EXTEND +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/ExtendUpDown.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/ExtendUpDown.al new file mode 100644 index 00000000000..9b72250ea41 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/ExtendUpDown.al @@ -0,0 +1,36 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 748 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\ExtendUpDown.al)" +# 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')) +} + +# end of Tk::Listbox::ExtendUpDown +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/FETCH.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/FETCH.al new file mode 100644 index 00000000000..fbbe7a3ce9a --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/FETCH.al @@ -0,0 +1,56 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 176 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\FETCH.al)" +# 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; +} + +# end of Tk::Listbox::FETCH +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/FETCHSIZE.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/FETCHSIZE.al new file mode 100644 index 00000000000..13b612a26f5 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/FETCHSIZE.al @@ -0,0 +1,16 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 224 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\FETCHSIZE.al)" +# FETCHSIZE +# --------- +# Return the number of elements in the Listbox when tied to an array +sub FETCHSIZE { + my $class = shift; + return ${$class->{OBJECT}}->size(); +} + +# end of Tk::Listbox::FETCHSIZE +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Listbox.bs b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Listbox.bs new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Listbox.bs diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Listbox.dll b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Listbox.dll Binary files differnew file mode 100755 index 00000000000..878d0f22787 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Listbox.dll diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Motion.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Motion.al new file mode 100644 index 00000000000..c1c3cbd978b --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/Motion.al @@ -0,0 +1,77 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 552 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\Motion.al)" +# 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>>"); + } +} + +# end of Tk::Listbox::Motion +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/POP.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/POP.al new file mode 100644 index 00000000000..db469652447 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/POP.al @@ -0,0 +1,19 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 325 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\POP.al)" +# 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; +} + +# end of Tk::Listbox::POP +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/PUSH.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/PUSH.al new file mode 100644 index 00000000000..f2168ef46d9 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/PUSH.al @@ -0,0 +1,13 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 320 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\PUSH.al)" +sub PUSH { + my ( $class, @list ) = @_; + ${$class->{OBJECT}}->insert('end', @list); +} + +# end of Tk::Listbox::PUSH +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SHIFT.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SHIFT.al new file mode 100644 index 00000000000..96a41f7d79c --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SHIFT.al @@ -0,0 +1,19 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 336 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\SHIFT.al)" +# 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 +} + +# end of Tk::Listbox::SHIFT +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SPLICE.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SPLICE.al new file mode 100644 index 00000000000..aeddea8196a --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SPLICE.al @@ -0,0 +1,84 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 374 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\SPLICE.al)" +# 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]; + } + } +} + +# end of Tk::Listbox::SPLICE +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/STORE.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/STORE.al new file mode 100644 index 00000000000..492c32ccc1e --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/STORE.al @@ -0,0 +1,80 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 232 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\STORE.al)" +# 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); + } + } + } +} + +# end of Tk::Listbox::STORE +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SelectAll.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SelectAll.al new file mode 100644 index 00000000000..50569afbe50 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SelectAll.al @@ -0,0 +1,32 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 838 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\SelectAll.al)" +# 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>>"); +} + +# end of Tk::Listbox::SelectAll +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SetList.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SetList.al new file mode 100644 index 00000000000..25e4f596592 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/SetList.al @@ -0,0 +1,16 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 862 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\SetList.al)" +# Perl/Tk extensions: +sub SetList +{ + my $w = shift; + $w->delete(0,'end'); + $w->insert('end',@_); +} + +# end of Tk::Listbox::SetList +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/TIEARRAY.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/TIEARRAY.al new file mode 100644 index 00000000000..8c147e8eac8 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/TIEARRAY.al @@ -0,0 +1,15 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 160 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\TIEARRAY.al)" +sub TIEARRAY { + my ( $class, $obj, %options ) = @_; + return bless { + OBJECT => \$obj, + OPTION => \%options }, $class; +} + +# end of Tk::Listbox::TIEARRAY +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/TIESCALAR.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/TIESCALAR.al new file mode 100644 index 00000000000..9cedf047c7f --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/TIESCALAR.al @@ -0,0 +1,15 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 169 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\TIESCALAR.al)" +sub TIESCALAR { + my ( $class, $obj, %options ) = @_; + return bless { + OBJECT => \$obj, + OPTION => \%options }, $class; +} + +# end of Tk::Listbox::TIESCALAR +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/UNSHIFT.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/UNSHIFT.al new file mode 100644 index 00000000000..10d6bae86ec --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/UNSHIFT.al @@ -0,0 +1,16 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 347 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\UNSHIFT.al)" +# UNSHIFT +# ------- +# Insert elements at the beginning of the Listbox +sub UNSHIFT { + my ( $class, @list ) = @_; + ${$class->{OBJECT}}->insert(0, @list); +} + +# end of Tk::Listbox::UNSHIFT +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/UpDown.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/UpDown.al new file mode 100644 index 00000000000..7ffbfebf4e1 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/UpDown.al @@ -0,0 +1,41 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 716 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\UpDown.al)" +# 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>>"); + } +} + +# end of Tk::Listbox::UpDown +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/autosplit.ix b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/autosplit.ix new file mode 100644 index 00000000000..0cd2e67037c --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/autosplit.ix @@ -0,0 +1,56 @@ +# Index created by AutoSplit for ..\blib\lib\Tk\Listbox.pm +# (file acts as timestamp) +package Tk::Listbox; +sub TIEARRAY ; +sub TIESCALAR ; +sub FETCH ; +sub FETCHSIZE ; +sub STORE ; +sub CLEAR ; +sub EXTEND ; +sub PUSH ; +sub POP ; +sub SHIFT ; +sub UNSHIFT ; +sub DELETE ; +sub EXISTS ; +sub SPLICE ; +sub xyIndex +; +sub ButtonRelease_1 +; +sub Cntrl_Home +; +sub Cntrl_End +; +sub Cntrl_backslash +; +sub BeginSelect +; +sub Motion +; +sub BeginExtend +; +sub BeginToggle +; +sub AutoScan +; +sub UpDown +; +sub ExtendUpDown +; +sub DataExtend +; +sub Cancel +; +sub SelectAll +; +sub SetList +; +sub deleteSelected +; +sub clipboardPaste +; +sub getSelected +; +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/clipboardPaste.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/clipboardPaste.al new file mode 100644 index 00000000000..28f0bd731de --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/clipboardPaste.al @@ -0,0 +1,21 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 880 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\clipboardPaste.al)" +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++,$_); + } +} + +# end of Tk::Listbox::clipboardPaste +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/deleteSelected.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/deleteSelected.al new file mode 100644 index 00000000000..45bdfe73221 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/deleteSelected.al @@ -0,0 +1,18 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 870 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\deleteSelected.al)" +sub deleteSelected +{ + my $w = shift; + my $i; + foreach $i (reverse $w->curselection) + { + $w->delete($i); + } +} + +# end of Tk::Listbox::deleteSelected +1; diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/getSelected.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/getSelected.al new file mode 100644 index 00000000000..a729a713d3e --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/getSelected.al @@ -0,0 +1,24 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 893 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\getSelected.al)" +sub getSelected +{ + my ($w) = @_; + my $i; + my (@result) = (); + foreach $i ($w->curselection) + { + push(@result,$w->get($i)); + } + return (wantarray) ? @result : $result[0]; +} + +1; +__END__ + + +1; +# end of Tk::Listbox::getSelected diff --git a/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/xyIndex.al b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/xyIndex.al new file mode 100644 index 00000000000..5689afdb6ef --- /dev/null +++ b/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/xyIndex.al @@ -0,0 +1,29 @@ +# NOTE: Derived from ..\blib\lib\Tk\Listbox.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package Tk::Listbox; + +#line 450 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\xyIndex.al)" +# ---- + +# +# 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); +} + +# end of Tk::Listbox::xyIndex +1; |