summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/Reindex.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/Reindex.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/Reindex.pm225
1 files changed, 0 insertions, 225 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/Reindex.pm b/Master/tlpkg/tlperl/lib/Tk/Reindex.pm
deleted file mode 100644
index 05e8e1fc1fc..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/Reindex.pm
+++ /dev/null
@@ -1,225 +0,0 @@
-package Tk::Reindex;
-
-
-use vars qw($VERSION);
-$VERSION = '4.004'; # $Id: //depot/Tkutf8/TextList/Reindex.pm#4 $
-
-use Tk;
-use base qw(Tk::Derived);
-
-
-sub Populate
-{
- my ($w, $args) = @_;
-
- $w->_callbase('Populate',$args);
-
- $w->ConfigSpecs(-linestart => ["PASSIVE", "lineStart", "LineStart", 0],
- -toindexcmd => ["CALLBACK", "toIndexCmd", "ToIndexCmd" , [\&to_index,$w]],
- -fromindexcmd => ["CALLBACK", "fromIndexCmd","FromIndexCmd", [\&from_index,$w]]);
-}
-
-sub import
-{
- my($module,$base)=@_;
- my $pkg=(caller)[0];
-
- no strict 'refs';
- *{"${pkg}::_reindexbase"}=sub{$base};
-}
-
-sub _callbase
-{
- my($w,$sub)=(shift,shift);
- my $supersub=$w->_reindexbase()."::$sub";
- $w->$supersub(@_);
-}
-
-BEGIN
-{
- # list of subroutines and index argument number (-1 as first element means return value)
- my %subs=('bbox' => [0],
- 'compare' => [0,2],
- 'delete' => [0,1],
- 'dlineinfo' => [0],
- 'dump' => \&_find_dump_index,
- 'get' => [0,1],
- 'index' => [-1,0],
- 'insert' => [0],
- 'mark' => \&_find_mark_index,
- 'search' => \&_find_search_index,
- 'see' => [0],
- 'tag' => \&_find_tag_index,
- 'window' => [1],
- 'image' => [1],
- );
-
- foreach my $sub (keys %subs)
- {
- my $args=$subs{$sub};
- my $argsub=ref $args eq 'CODE'?$args:sub{$args};
- my $newsub=sub
- {
- my($w)=shift;
- my(@iargs)=grep($_<=$#_,@{$argsub->(@_)});
- my $iret=shift @iargs if @iargs && $iargs[0]==-1;
- my(@args)=@_;
- @args[@iargs]=$w->Callback(-toindexcmd,@args[@iargs]);
- my(@ret)=$w->_callbase($sub,@args);
- @ret=$w->Callback(-fromindexcmd,@ret) if $iret;
- wantarray?@ret:$ret[0];
- };
- no strict 'refs';
- *{$sub}=$newsub;
- }
-}
-
-sub to_index
-{
- my $w=shift;
- my $offset=$w->cget(-linestart)+1;
- my(@args)=@_;
- foreach (@args)
- {
- s/^\d+(?=\.)/$&+$offset/e;
- }
- @args;
-}
-
-sub from_index
-{
- my $w=shift;
- my $offset=$w->cget(-linestart)+1;
- my(@args)=@_;
- foreach (@args)
- {
- s/^\d+(?=\.)/$&-$offset/e
- }
- @args;
-}
-
-sub _find_dump_index
-{
- my $idx=_count_options(@_);
- [$idx,$idx+1];
-}
-
-sub _find_search_index
-{
- my $idx=_count_options(@_);
- [$idx+1,$idx+2];
-}
-
-sub _count_options
-{
- my $idx=0;
- while($_[$idx]=~/^-/g)
- {
- $idx++;
- $idx++ if $' eq 'count' or $' eq 'command';
- last if $' eq '-';
- }
- $idx;
-}
-
-sub _find_tag_index
-{
- return [1] if $_[0] eq 'names';
- return [2,3] if $_[0]=~/^(add|remove|nextrange|prevrange)$/;
- return [-1] if $_[0] eq 'ranges';
- return [];
-}
-
-sub _find_mark_index
-{
- return [2] if $_[0] eq 'set';
- return [1] if $_[0] eq 'next' or $_[0] eq 'previous';
- return [];
-}
-
-1;
-
-=head1 NAME
-
-Tk::Reindex - change the base index of Text-like widgets
-
-=for category Derived Widgets
-
-=head1 SYNOPSIS
-
- use Tk::ReindexedText;
- $t1=$w->ReindexedText(-linestart => 2);
-
- use Tk::ReindexedROText;
- $t2=$w->ReindexedROText(-linestart => 0);
-
-=head1 DESCRIPTION
-
-Creates a new widget class based on B<Text>-like widgets that can
-redefine the line number base (normally B<Text> widgets start line
-numbers at 1), or possibly other manipulations on indexes.
-
-=head1 STANDARD OPTIONS
-
-The newly-defined widget takes all the same options as the base
-widget, which defaults to B<Text>.
-
-=head1 WIDGET-SPECIFIC OPTIONS
-
-=item Name: B<lineStart>
-
-=item Class: B<LineStart>
-
-=item Switch: B<-linestart>
-
-Sets the line number of the first line in the B<Text> widget. The
-default B<-toindexcmd> and B<-fromindexcmd> use this configuration
-option.
-
--item Name: B<toIndexCmd> B<fromIndexCmd>
-
--item Class: B<ToIndexCmd> B<FromIndexCmd>
-
--item Switch: B<-toindexcmd> B<-fromindexcmd>
-
-These two options specify callbacks that are called with a list of
-indexes and are responsible for translating them to/from indexes that
-the base B<Text> widget can understand. The callback is passed the
-widget followed by a list of indexes, and should return a list of
-translated indexes. B<-toindexcmd> should translate from 'user'
-indexes to 'native' B<Text>-compatible indexes, and B<-fromindexcmd>
-should translate from 'native' indexes to 'user' indexes.
-
-The default callbacks simply add/subtract the offset given by the
-B<-linestart> option for all indexes in 'line.character' format.
-
-It would probably be prudent to make these functions inverses of each
-other.
-
-=head1 CLASS METHODS
-
-=item import
-
-To make new Reindex widgets, this function should be called via B<use>
-with the name of the Text-like base class that you are extending with
-"Reindex" capability. 'use base(Tk::Reindex Tk::nameofbasewidget)'
-should also be specified for that widget.
-
-=head1 BUGS
-
-I've used the word "indexes" instead of "indices" throughout the
-documentation.
-
-All the built-in perl code for widget bindings & methods will use the
-new 'user' indexes. Which means all this index manipulation might
-might break code that is trying to parse/manipulate indexes. Or even
-assume that '1.0' is the beginning index. B<Tk::Text::Contents> comes
-to mind.
-
-=head1 AUTHOR
-
-Andrew Allen <ada@fc.hp.com>
-
-This code may be distributed under the same conditions as Perl.
-
-=cut