# Copyright (c) 1995-1999 Nick Ing-Simmons.
# Copyright (c) 1999 Greg London.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
use vars
qw($VERSION $DoDebug);
$VERSION = '3.048'; # $Id: //depot/Tk8/Tk/TextUndo.pm#48 $
Construct Tk
::Widget
'TextUndo';
$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.
####################################################################
$w->{UNDO
} = [] unless (exists $w->{UNDO
});
$w->{REDO
} = [] unless (exists $w->{REDO
});
return pop(@
{$w->{UNDO
}}) if defined $w->{UNDO
};
return pop(@
{$w->{REDO
}}) if defined $w->{REDO
};
return shift(@
{$w->{REDO
}}) if defined $w->{REDO
};
return 0 unless (exists $w->{'UNDO'}) and (defined($w->{'UNDO'}));
return scalar(@
{$w->{'UNDO'}});
return 0 unless exists $w->{'REDO'};
return scalar(@
{$w->{'REDO'}});
return undef unless (exists $w->{UNDO
});
return $w->{UNDO
}[$index];
return undef unless (exists $w->{REDO
});
return $w->{REDO
}[$index];
####################################################################
# pressing REDO should not do anything
# pressing UNDO should make "out" disappear.
# pressing UNDO should make "there" reappear.
# pressing UNDO should make "there" disappear.
# pressing UNDO should make "hello" disappear.
# if there is anything in REDO stack and
# the OperationMode is normal, (i.e. not in the middle of an ->undo or ->redo)
# then before performing the current operation
# take the REDO stack, and put it on UNDO stack
# such that UNDO/REDO keystrokes will still make logical sense.
# call this method at the beginning of any overloaded method
# which adds operations to the undo or redo stacks.
# it will perform all the magic needed to handle the redo stack.
####################################################################
my $size_redo = $w->SizeRedo;
return unless $size_redo && ($w->OperationMode eq 'normal');
# we are about to 'do' something new, but have something in REDO stack.
# The REDOs may conflict with new ops, but we want to preserve them.
# So convert them to UNDOs - effectively do them and their inverses
# so net effect on the widget is no-change.
$w->dump_array('StartShuffle');
$w->OperationMode('REDO_MAGIC');
$w->MarkSelectionsSavePositions;
# go through REDO array from end downto 0, i.e. pseudo pop
# then pretend we did 'redo' get inverse, and push into UNDO array
for (my $i=$size_redo-1; $i>=0 ; $i--)
my ($op,@args) = @
{$w->getRedoAtIndex($i)};
my $op_undo = $op .'_UNDO';
# save the inverse of the op on the UNDO array
# do this before the re-doing the op - after a 'delete' we cannot see
my $undo = $w->$op_undo(@args);
# We must 'do' the operation now so if this is an insert
# the text and tags are available for inspection in delete_UNDO, and
# indices reflect changes.
# Save the undo that will reverse what we just did - it is
# on the undo stack but will be tricky to find
# Now shift each item off REDO array until empty
# push each item onto UNDO array - this reverses the order
# and we are not altering buffer so we cannot look in the
# buffer to compute inverses - which is why we saved them above
# Finally undo whatever we did to compensate for doing it
# and get buffer back to state it was before we started.
my ($op,@args) = @
{pop(@pvtundo)};
$w->RestoreSelectionsMarkedSaved;
$w->OperationMode('normal');
$w->dump_array('EndShuffle');
# sets/returns undo/redo/normal operation mode
$w->{'OPERATION_MODE'} = $mode if (@_ > 1);
$w->{'OPERATION_MODE'} = 'normal' unless exists($w->{'OPERATION_MODE'});
return $w->{'OPERATION_MODE'};
####################################################################
# dump the undo and redo stacks to the screen.
# used for debug purposes.
foreach my $key ('UNDO','REDO')
print " $key array is:\n";
foreach my $ref (@
$array)
print " [",join(',',@items),"]\n";
############################################################
############################################################
# these are a group of methods used to indicate the start and end of
# several operations that are to be undo/redo 'ed in a single step.
# in other words, "glob" a bunch of operations together.
# for example, a search and replace should be undone with a single
# keystroke, rather than one keypress undoes the insert and another
# all other methods should access the count via these methods.
# no other method should directly access the {GLOB_COUNT} value directly
#############################################################
#############################################################
my $mode = $w->OperationMode;
{$w->PushUndo([@operation]);}
{$w->PushRedo([@operation]);}
{$w->PushUndo([@operation]);}
{die "invalid destination '$mode', must be one of 'normal', 'undo' or 'redo'";}
sub addGlobStart
# add it to end of undo list
unless (defined($who)) {$who = (caller(1))[3];}
$w->dump_array('Start'.$who);
$w->AddOperation('GlobStart', $who) ;
sub addGlobEnd
# add it to end of undo list
unless (defined($who)) {$who = (caller(1))[3];}
my $topundo = $w->getUndoAtIndex(-1);
if ($topundo->[0] eq 'GlobStart')
my $nxtundo = $w->getUndoAtIndex(-2);
if ($nxtundo->[0] eq 'GlobStart')
$w->AddOperation('GlobEnd', $who);
$w->dump_array('End'.$who);
unless (defined($w->{GLOB_COUNT
})) {$w->{GLOB_COUNT
}=0;}
if ($w->OperationMode eq 'normal')
$w->PushUndo($w->GlobStart_UNDO($who));
$w->{GLOB_COUNT
} = $w->{GLOB_COUNT
} + 1;
$who = 'GlobEnd_UNDO' unless defined($who);
unless (defined($w->{GLOB_COUNT
})) {$w->{GLOB_COUNT
}=0;}
if ($w->OperationMode eq 'normal')
$w->PushUndo($w->GlobStart_UNDO($who));
$w->{GLOB_COUNT
} = $w->{GLOB_COUNT
} - 1;
$who = 'GlobStart_UNDO' unless defined($who);
return ['GlobStart',$who];
unless ( exists($w->{'GLOB_COUNT'}) and defined($w->{'GLOB_COUNT'}) )
$w->{'GLOB_COUNT'}=$count;
return $w->{'GLOB_COUNT'};
####################################################################
# two methods should be used by applications to access undo and redo
# capability, namely, $w->undo; and $w->redo; methods.
# these methods undo and redo the last operation, respectively.
####################################################################
$w->dump_array('Start'.'undo');
unless ($w->numberChanges) {$w->bell; return;} # beep and return if empty
$w->GlobCount(0); #initialize to zero
$w->OperationMode('undo');
my ($op,@args) = @
{$w->PopUndo}; # get undo operation, convert ref to array
my $undo_op = $op .'_UNDO';
$w->PushRedo($w->$undo_op(@args)); # find out how to undo it
$w->$op(@args); # do the operation
} while($w->GlobCount and $w->numberChanges);
$w->OperationMode('normal');
$w->dump_array('End'.'undo');
unless ($w->SizeRedo) {$w->bell; return;} # beep and return if empty
$w->OperationMode('redo');
$w->GlobCount(0); #initialize to zero
my ($op,@args) = @
{$w->PopRedo}; # get op from redo stack, convert to list
my $undo_op = $op .'_UNDO';
$w->PushUndo($w->$undo_op(@args)); # figure out how to undo operation
$w->$op(@args); # do the operation
} while($w->GlobCount and $w->SizeRedo);
$w->OperationMode('normal');
############################################################
# override low level subroutines so that they work with UNDO/REDO capability.
# every overridden subroutine must also have a corresponding *_UNDO subroutine.
# the *_UNDO method takes the same parameters in and returns an array reference
# which is how to undo itself.
# note that the *_UNDO must receive absolute indexes.
# ->insert receives 'markname' as the starting index.
# ->insert must convert 'markname' using $absindex=$w->index('markname')
# and pass $absindex to ->insert_UNDO.
############################################################
$w->markSet('insert', $w->index(shift) );
my $index1 = $w->index('insert');
my $taglist_ref = shift if @_;
if ($w->OperationMode eq 'normal')
$w->PushUndo($w->insert_UNDO($index1,$string,$taglist_ref));
$w->markSet('notepos' => $index1);
$w->SUPER::insert
($index1,$string,$taglist_ref);
$w->markSet('insert', $w->index('notepos'));
# This possible call: ->insert (index, string, tag, string, tag...);
# if more than one string, keep reading strings in (discarding tags)
# until all strings are read in and $string contains entire text inserted.
my $tags = shift if (@_);
# possible things to insert:
# single character (not CR)
# single line of characters (not ending in CR)
# single line of characters ending with a CR
# multi-line characters. last line does not end with CR
# multi-line characters, last line does end with CR.
my ($line,$col) = split(/\./,$index);
if ($string =~ /\n(.*)$/)
$line += $string =~ tr/\n/\n/;
return ['delete', $index, $line.'.'.$col];
my ($w, $start, $stop) = @_;
{ $stop = $start .'+1c'; }
my $index1 = $w->index($start);
my $index2 = $w->index($stop);
if ($w->OperationMode eq 'normal')
$w->PushUndo($w->delete_UNDO($index1,$index2));
$w->SUPER::delete($index1,$index2);
# why call SetCursor - it has side effects
# which cause a whole slew if save/restore hassles ?
my ($w, $index1, $index2) = @_;
my @result = ( 'insert' => $index1 );
###############################################################
# get tags in range and return them in a format that
# $text->insert('1.0', $string1, [tag1,tag2], $string2, [tag2, tag3]);
# note, have to break tags up into sequential order
# in reference to _all_ tags.
###############################################################
$w->dump('-text','-tag', -command
=> sub {
my ($kind,$value,$posn) = @_;
push(@result,$str,[keys %tags]) if (length $str);
elsif ($kind eq 'tagoff')
push(@result,$str,[keys %tags]) if (length $str);
############################################################
# override subroutines which are collections of low level
# routines executed in sequence.
# wrap a globstart and globend around the SUPER:: version of routine.
############################################################
sub ReplaceSelectionsWith
$w->SUPER::ReplaceSelectionsWith
(@_);
$w->SUPER::FindAndReplaceAll
(@_);
$w->SUPER::clipboardCut
(@_);
$w->SUPER::clipboardPaste
(@_);
$w->SUPER::clipboardColumnCut
(@_);
$w->SUPER::clipboardColumnPaste
(@_);
# Greg: this method is more tightly coupled to the base class
# than I would prefer, but I know of no other way to do it.
$w->SUPER::Insert
($char);
if ($char =~ /^\S$/ and !$w->OverstrikeMode and !$w->tagRanges('sel'))
my $index = $w->index('insert');
my $undo_item = $w->getUndoAtIndex(-1);
if (defined($undo_item) &&
($undo_item->[0] eq 'delete') &&
($undo_item->[2] == $index)
$w->SUPER::insert
($index,$char);
$undo_item->[2] = $w->index('insert');
$w->SUPER::InsertKeypress
($char);
############################################################
my ($w,$action,$filename,$count,$val,$total) = @_;
return unless(defined($filename) and defined($count));
my $popup = $w->{'FILE_PROGRESS_POP_UP'};
$popup = $w->Toplevel(-title
=> "File Progress",-popover
=> $w);
$popup->transient($w->toplevel);
$popup->resizable('no','no');
$popup->Label(-textvariable
=> \
$popup->{ACTION
})->pack;
$popup->Label(-textvariable
=> \
$popup->{FILENAME
})->pack;
$popup->Label(-textvariable
=> \
$popup->{COUNT
})->pack;
my $f = $popup->Frame(-height
=> 10, -border
=> 2, -relief
=> 'sunken')->pack(-fill
=> 'x');
my $i = $f->Frame(-background
=> 'blue', -relief
=> 'raised', -border
=> 2);
$w->{'FILE_PROGRESS_POP_UP'} = $popup;
$popup->{ACTION
} = $action;
$popup->{COUNT
} = "lines: $count";
$popup->{FILENAME
} = "Filename: $filename";
if (defined($val) && defined($total) && $total != 0)
$popup->{PROGBAR
}->place('-x' => 0, '-y' => 0, -relheight
=> 1, -relwidth
=> $val/$total);
$popup->{PROGBAR
}->placeForget;
unless ($popup->viewable)
$w->toplevel->deiconify unless $w->viewable;
$w->{'FILENAME'}=$filename;
my $ans = $w->messageBox(-icon
=> 'warning',
-type
=> 'YesNoCancel', -default => 'Yes',
"The text has been modified without being saved.
return 0 if $ans eq 'Cancel';
return 0 if ($ans eq 'Yes' && !$w->Save);
################################################################################
# if the file has been modified since being saved, a pop up window will be
# created, asking the user to confirm whether or not to exit.
# this allows the user to return to the application and save the file.
# the code would look something like this:
# if ($w->user_wants_to_exit)
# it is also possible to trap attempts to delete the main window.
# this allows the ->ConfirmExit method to be called when the main window
# is attempted to be deleted.
# $mw->protocol('WM_DELETE_WINDOW'=>
# sub{$w->ConfirmExit;});
# finally, it might be desirable to trap Control-C signals at the
# application level so that ->ConfirmExit is also called.
# $SIG{INT}= sub{$w->ConfirmExit;};
################################################################################
$w->toplevel->destroy if $w->ConfirmDiscard;
$filename = $w->FileName unless defined $filename;
return $w->FileSaveAsPopup unless defined $filename;
if (open(FILE
,">$filename"))
my ($lines) = $w->index('end') =~ /^(\d+)\./;
while ($w->compare($index,'<','end'))
# my $end = $w->index("$index + 1024 chars");
my $end = $w->index("$index lineend +1c");
print FILE
$w->get($index,$end);
if (($count++%1000) == 0)
$progress = $w->TextUndoFileProgress (Saving
=> $filename,$count,$count,$lines);
$progress->withdraw if defined $progress;
$w->BackTrace("Cannot open $filename:$!");
$filename = $w->FileName unless (defined($filename));
return 0 unless defined $filename;
if (open(FILE
,"<$filename"))
$w->SUPER::insert
('end',$_);
if (($count++%1000) == 0)
$progress = $w->TextUndoFileProgress (Loading
=> $filename,$count,tell(FILE
),-s
$filename);
$progress->withdraw if defined $progress;
$w->markSet('insert' => '1.0');
$w->BackTrace("Cannot open $filename:$!");
unless (defined($filename))
{$w->BackTrace("filename not specified"); return;}
if (open(FILE
,"<$filename"))
if (($count++%1000) == 0)
$progress = $w->TextUndoFileProgress(Including
=> $filename,$count,tell(FILE
),-s
$filename);
$progress->withdraw if defined $progress;
$w->BackTrace("Cannot open $filename:$!");
# clear document without pushing it into UNDO array, (use SUPER::delete)
# (using plain delete(1.0,end) on a really big document fills up the undo array)
# and then clear the Undo and Redo stacks.
$w->SUPER::delete('1.0','end');
$w->EmptyDocument if $w->ConfirmDiscard;
["command"=>'~Open', -command
=> [$w => 'FileLoadPopup']],
["command"=>'~Save', -command
=> [$w => 'Save' ]],
["command"=>'Save ~As', -command
=> [$w => 'FileSaveAsPopup']],
["command"=>'~Include', -command
=> [$w => 'IncludeFilePopup']],
["command"=>'~Clear', -command
=> [$w => 'ConfirmEmptyDocument']],
"-",@
{$w->SUPER::FileMenuItems
}
["command"=>'Undo', -command
=> [$w => 'undo']],
["command"=>'Redo', -command => [$w => 'redo']],
"-",@{$w->SUPER::EditMenuItems}
my @types = (['All Files
', '*']);
($name,$dir,$sfx) = File::Basename::fileparse($name,'\
..*');
if (defined($sfx) && length($sfx))
unshift(@types,['Similar Files
',[$sfx]]);
return $w->$k(-initialdir => $dir, -initialfile => $name,
-filetypes => \@types, @_);
my $name = $w->CreateFileSelect('getOpenFile
',-title => 'File Load
');
return $w->Load($name) if defined($name) and length($name);
my $name = $w->CreateFileSelect('getOpenFile
',-title => 'File Include
');
return $w->IncludeFile($name) if defined($name) and length($name);
my $name = $w->CreateFileSelect('getSaveFile
',-title => 'File Save As
');
return $w->Save($name) if defined($name) and length($name);
sub MarkSelectionsSavePositions
$w->markSet('MarkInsertSavePosition
','insert
');
my @ranges = $w->tagRanges('sel
');
my ($start,$end) = splice(@ranges,0,2);
$w->markSet( 'MarkSelectionsSavePositions_
'.++$i, $start);
$w->markSet( 'MarkSelectionsSavePositions_
'.++$i, $end);
$w->tagRemove('sel
',$start,$end);
sub RestoreSelectionsMarkedSaved
foreach my $mark ($w->markNames)
my $markstart = 'MarkSelectionsSavePositions_
'.$i++;
last unless(exists($mark_hash{$markstart}));
my $indexstart = $w->index($markstart);
my $markend = 'MarkSelectionsSavePositions_
'.$i++;
last unless(exists($mark_hash{$markend}));
my $indexend = $w->index($markend);
$w->tagAdd('sel
',$indexstart, $indexend);
$w->markUnset($markstart, $markend);
$w->markSet('insert
','MarkInsertSavePosition
');
####################################################################
# selected lines may be discontinous sequence.
my @ranges = $w->tagRanges('sel
');
my ($first) = split(/\./,shift(@ranges));
my ($last) = split(/\./,shift(@ranges));
# if previous selection ended on the same line that this selection starts,
# then fiddle the numbers so that this line number isnt included twice.
if (defined($selection_list[-1]) and ($first == $selection_list[-1]))
# if this selection ends on the same line its starts, then skip this sel
next if ($first == $last);
$first++; # count this selection starting from the next line.
push(@selection_list, $first .. $last);
sub insertStringAtStartOfSelectedLines
my ($w,$insert_string)=@_;
$w->MarkSelectionsSavePositions;
foreach my $line ($w->SelectedLineNumbers)
$w->insert($line.'.0', $insert_string);
$w->RestoreSelectionsMarkedSaved;
sub deleteStringAtStartOfSelectedLines
my ($w,$insert_string)=@_;
$w->MarkSelectionsSavePositions;
my $length = length($insert_string);
foreach my $line ($w->SelectedLineNumbers)
my $end = $line.'.'.$length;
my $current_text = $w->get($start, $end);
next unless ($current_text eq $insert_string);
$w->delete($start, $end);
$w->RestoreSelectionsMarkedSaved;