home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _30ca104e860ad75f4efc4c0fff0a258b < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.6 KB  |  85 lines
  1. # NOTE: Derived from ..\blib\lib\Tk\Listbox.pm.
  2. # Changes made here will be lost when autosplit is run again.
  3. # See AutoSplit.pm.
  4. package Tk::Listbox;
  5.  
  6. #line 374 "..\blib\lib\Tk\Listbox.pm (autosplit into ..\blib\lib\auto\Tk\Listbox\SPLICE.al)"
  7. # SPLICE
  8. # ------
  9. # Performs equivalent of splice on the listbox contents
  10. sub SPLICE {
  11.    my $class = shift;
  12.  
  13.    my $self = ${$class->{OBJECT}};
  14.  
  15.    # check for arguments
  16.    my @elements;
  17.    if ( scalar(@_) == 0 ) {
  18.       # none
  19.       @elements = $self->get(0,'end');
  20.       $self->delete(0,'end');
  21.       return wantarray ? @elements : $elements[scalar(@elements)-1];;
  22.  
  23.    } elsif ( scalar(@_) == 1 ) {
  24.       # $offset
  25.       my ( $offset ) = @_;
  26.       if ( $offset < 0 ) {
  27.          my $start = $self->size() + $offset;
  28.          if ( $start > 0 ) {
  29.         @elements = $self->get($start,'end');
  30.             $self->delete($start,'end');
  31.         return wantarray ? @elements : $elements[scalar(@elements)-1];
  32.          } else {
  33.             return undef;
  34.      }
  35.       } else {
  36.      @elements = $self->get($offset,'end');
  37.          $self->delete($offset,'end');
  38.          return wantarray ? @elements : $elements[scalar(@elements)-1];
  39.       }
  40.  
  41.    } elsif ( scalar(@_) == 2 ) {
  42.       # $offset and $length
  43.       my ( $offset, $length ) = @_;
  44.       if ( $offset < 0 ) {
  45.          my $start = $self->size() + $offset;
  46.          my $end = $self->size() + $offset + $length - 1;
  47.      if ( $start > 0 ) {
  48.         @elements = $self->get($start,$end);
  49.             $self->delete($start,$end);
  50.         return wantarray ? @elements : $elements[scalar(@elements)-1];
  51.          } else {
  52.             return undef;
  53.      }
  54.       } else {
  55.      @elements = $self->get($offset,$offset+$length-1);
  56.          $self->delete($offset,$offset+$length-1);
  57.          return wantarray ? @elements : $elements[scalar(@elements)-1];
  58.       }
  59.  
  60.    } else {
  61.       # $offset, $length and @list
  62.       my ( $offset, $length, @list ) = @_;
  63.       if ( $offset < 0 ) {
  64.          my $start = $self->size() + $offset;
  65.          my $end = $self->size() + $offset + $length - 1;
  66.      if ( $start > 0 ) {
  67.         @elements = $self->get($start,$end);
  68.             $self->delete($start,$end);
  69.         $self->insert($start,@list);
  70.         return wantarray ? @elements : $elements[scalar(@elements)-1];
  71.          } else {
  72.             return undef;
  73.      }
  74.       } else {
  75.      @elements = $self->get($offset,$offset+$length-1);
  76.          $self->delete($offset,$offset+$length-1);
  77.      $self->insert($offset,@list);
  78.          return wantarray ? @elements : $elements[scalar(@elements)-1];
  79.       }
  80.    }
  81. }
  82.  
  83. # end of Tk::Listbox::SPLICE
  84. 1;
  85.