view release on metacpan or  search on metacpan

lib/Tcl/pTk/TextUndo.pm  view on Meta::CPAN

# Copyright (c) 1995-2004 Nick Ing-Simmons.
# Copyright (c) 1999 Greg London.
# All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
package Tcl::pTk::TextUndo;

our ($VERSION) = ('1.11');

$DoDebug = 0;

use Tcl::pTk qw (Ev);

use base qw(Tcl::pTk::Text Tcl::pTk::Derived );

Construct Tcl::pTk::Widget 'TextUndo';

sub ClassInit
{
 my ($class,$mw) = @_;
 $mw->bind($class,'<<Undo>>','undo');
 $mw->bind($class,'<<Redo>>','redo');

 return $class->SUPER::ClassInit($mw);
}


####################################################################
# methods for manipulating the undo and redo stacks.
# no one should directly access the stacks except for these methods.
# everyone else must access the stacks through these methods.
####################################################################
sub ResetUndo
{
 my ($w) = @_;
 delete $w->{UNDO};
 delete $w->{REDO};
}

sub PushUndo
{
 my $w = shift;
 $w->{UNDO} = [] unless (exists $w->{UNDO});
 push(@{$w->{UNDO}},@_);
}

sub PushRedo
{
 my $w = shift;
 $w->{REDO} = [] unless (exists $w->{REDO});
 push(@{$w->{REDO}},@_);
}

sub PopUndo
{
 my ($w) = @_;
 return pop(@{$w->{UNDO}}) if defined $w->{UNDO};
 return undef;
}

sub PopRedo
{
 my ($w) = @_;
 return pop(@{$w->{REDO}}) if defined $w->{REDO};
 return undef;
}

sub ShiftRedo
{
 my ($w) = @_;
 return shift(@{$w->{REDO}}) if defined $w->{REDO};
 return undef;
}