summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/auto/Tk/Listbox/STORE.al
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/auto/Tk/Listbox/STORE.al')
-rw-r--r--Master/tlpkg/tlperl/lib/auto/Tk/Listbox/STORE.al80
1 files changed, 80 insertions, 0 deletions
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;