diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Tk/TextUndo.pm')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Tk/TextUndo.pm | 1022 |
1 files changed, 0 insertions, 1022 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Tk/TextUndo.pm b/Master/tlpkg/tlperl0/lib/Tk/TextUndo.pm deleted file mode 100755 index 066e4027a3a..00000000000 --- a/Master/tlpkg/tlperl0/lib/Tk/TextUndo.pm +++ /dev/null @@ -1,1022 +0,0 @@ -# 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 Tk::TextUndo; - -use vars qw($VERSION $DoDebug); -$VERSION = '4.013'; # $Id: //depot/Tkutf8/Tk/TextUndo.pm#15 $ -$DoDebug = 0; - -use Tk qw (Ev); -use AutoLoader; - -use Tk::Text (); -use base qw(Tk::Text); - -Construct Tk::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; -} - -sub numberChanges -{ - my ($w) = @_; - return 0 unless (exists $w->{'UNDO'}) and (defined($w->{'UNDO'})); - return scalar(@{$w->{'UNDO'}}); -} - -sub SizeRedo -{ - my ($w) = @_; - return 0 unless exists $w->{'REDO'}; - return scalar(@{$w->{'REDO'}}); -} - -sub getUndoAtIndex -{ - my ($w,$index) = @_; - return undef unless (exists $w->{UNDO}); - return $w->{UNDO}[$index]; -} - -sub getRedoAtIndex -{ - my ($w,$index) = @_; - return undef unless (exists $w->{REDO}); - return $w->{REDO}[$index]; -} - -#################################################################### -# type "hello there" -# hello there_ -# hit UNDO -# hello_ -# type "out" -# hello out_ -# 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. -#################################################################### -sub CheckForRedoShuffle -{ - my ($w) = @_; - my $size_redo = $w->SizeRedo; - return unless $size_redo && ($w->OperationMode eq 'normal'); - # local $DoDebug = 1; - - # 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; - - my @pvtundo; - - # go through REDO array from end downto 0, i.e. pseudo pop - # then pretend we did 'redo' get inverse, and push into UNDO array - # and 'do' the op. - 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 - # text we deleted! - my $undo = $w->$op_undo(@args); - $w->PushUndo($undo); - # 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. - $w->$op(@args); - # Save the undo that will reverse what we just did - it is - # on the undo stack but will be tricky to find - push(@pvtundo,$undo); - } - - # 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 - - while ($w->SizeRedo) - { - my $ref = $w->ShiftRedo; - $w->PushUndo($ref); - } - - # Finally undo whatever we did to compensate for doing it - # and get buffer back to state it was before we started. - while (@pvtundo) - { - my ($op,@args) = @{pop(@pvtundo)}; - $w->$op(@args); - } - - $w->RestoreSelectionsMarkedSaved; - $w->OperationMode('normal'); - $w->dump_array('EndShuffle'); -} - -# sets/returns undo/redo/normal operation mode -sub OperationMode -{ - my ($w,$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. -sub dump_array -{ - return unless $DoDebug; - my ($w,$why) = @_; - print "At $why:\n"; - foreach my $key ('UNDO','REDO') - { - if (defined($w->{$key})) - { - print " $key array is:\n"; - my $array = $w->{$key}; - foreach my $ref (@$array) - { - my @items; - foreach my $item (@$ref) - { - my $loc = $item; - $loc =~ tr/\n/\^/; - push(@items,$loc); - } - print " [",join(',',@items),"]\n"; - } - } - } - print "\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 -# undoes the delete. -# all other methods should access the count via these methods. -# no other method should directly access the {GLOB_COUNT} value directly -############################################################# -############################################################# - -sub AddOperation -{ - my ($w,@operation) = @_; - my $mode = $w->OperationMode; - - if ($mode eq 'normal') - {$w->PushUndo([@operation]);} - elsif ($mode eq 'undo') - {$w->PushRedo([@operation]);} - elsif ($mode eq 'redo') - {$w->PushUndo([@operation]);} - else - {die "invalid destination '$mode', must be one of 'normal', 'undo' or 'redo'";} -} - -sub addGlobStart # add it to end of undo list -{ - my ($w, $who) = @_; - unless (defined($who)) {$who = (caller(1))[3];} - $w->CheckForRedoShuffle; - $w->dump_array('Start'.$who); - $w->AddOperation('GlobStart', $who) ; -} - -sub addGlobEnd # add it to end of undo list -{ - my ($w, $who) = @_; - unless (defined($who)) {$who = (caller(1))[3];} - my $topundo = $w->getUndoAtIndex(-1); - if ($topundo->[0] eq 'GlobStart') - { - $w->PopUndo; - } - else - { - my $nxtundo = $w->getUndoAtIndex(-2); - if ($nxtundo->[0] eq 'GlobStart') - { - $w->PopUndo; - $w->PopUndo; - $w->PushUndo($topundo); - } - else - { - $w->AddOperation('GlobEnd', $who); - } - } - $w->dump_array('End'.$who); -} - -sub GlobStart -{ - my ($w, $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; -} - -sub GlobStart_UNDO -{ - my ($w, $who) = @_; - $who = 'GlobEnd_UNDO' unless defined($who); - return ['GlobEnd',$who]; -} - -sub GlobEnd -{ - my ($w, $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; -} - -sub GlobEnd_UNDO -{ - my ($w, $who) = @_; - $who = 'GlobStart_UNDO' unless defined($who); - return ['GlobStart',$who]; -} - -sub GlobCount -{ - my ($w,$count) = @_; - unless ( exists($w->{'GLOB_COUNT'}) and defined($w->{'GLOB_COUNT'}) ) - { - $w->{'GLOB_COUNT'}=0; - } - if (defined($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. -#################################################################### -sub undo -{ - my ($w) = @_; - $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'); - do - { - 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'); -} - -sub redo -{ - my ($w) = @_; - unless ($w->SizeRedo) {$w->bell; return;} # beep and return if empty - $w->OperationMode('redo'); - $w->GlobCount(0); #initialize to zero - do - { - 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. -############################################################ - -sub insert -{ - my $w = shift; - $w->markSet('insert', $w->index(shift) ); - while(@_) - { - my $index1 = $w->index('insert'); - my $string = shift; - my $taglist_ref = shift if @_; - - if ($w->OperationMode eq 'normal') - { - $w->CheckForRedoShuffle; - $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')); - } -} - -sub insert_UNDO -{ - my $w = shift; - my $index = shift; - my $string = ''; - # 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. - while (@_) - { - $string .= shift; - my $tags = shift if (@_); - } - # calculate index - # possible things to insert: - # carriage return - # 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/; - $col = length($1); - } - else - { - $col += length($string); - } - return ['delete', $index, $line.'.'.$col]; -} - -sub delete -{ - my ($w, $start, $stop) = @_; - unless(defined($stop)) - { $stop = $start .'+1c'; } - my $index1 = $w->index($start); - my $index2 = $w->index($stop); - if ($w->OperationMode eq 'normal') - { - $w->CheckForRedoShuffle; - $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 ? - $w->SetCursor($index1); -} - -sub delete_UNDO -{ - my ($w, $index1, $index2) = @_; - my %tags; - my @result = ( 'insert' => $index1 ); - my $str = ''; - - ############################################################### - # get tags in range and return them in a format that - # can be inserted. - # $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) = @_; - if ($kind eq 'text') - { - $str .= $value; - } - else - { - push(@result,$str,[keys %tags]) if (length $str); - $str = ''; - if ($kind eq 'tagon') - { - $tags{$value} = 1; - } - elsif ($kind eq 'tagoff') - { - delete $tags{$value}; - } - } - }, $index1, $index2); - push(@result,$str,[keys %tags]) if (length $str); - return \@result; -} - -############################################################ -# 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 -{ - my $w = shift; - $w->addGlobStart; - $w->SUPER::ReplaceSelectionsWith(@_); - $w->addGlobEnd; -} - -sub FindAndReplaceAll -{ - my $w = shift; - $w->addGlobStart; - $w->SUPER::FindAndReplaceAll(@_); - $w->addGlobEnd; -} - -sub clipboardCut -{ - my $w = shift; - $w->addGlobStart; - $w->SUPER::clipboardCut(@_); - $w->addGlobEnd; -} - -sub clipboardPaste -{ - my $w = shift; - $w->addGlobStart; - $w->SUPER::clipboardPaste(@_); - $w->addGlobEnd; -} - -sub clipboardColumnCut -{ - my $w = shift; - $w->addGlobStart; - $w->SUPER::clipboardColumnCut(@_); - $w->addGlobEnd; -} - -sub clipboardColumnPaste -{ - my $w = shift; - $w->addGlobStart; - $w->SUPER::clipboardColumnPaste(@_); - $w->addGlobEnd; -} - -# 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. - -sub Insert -{ - my ($w,$char)=@_; - return if $char eq ''; - $w->addGlobStart; - $w->SUPER::Insert($char); - $w->addGlobEnd; - $w->see('insert'); -} - - -sub InsertKeypress -{ - my ($w,$char)=@_; - return if $char eq ''; - 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'); - return; - } - } - $w->addGlobStart; - $w->SUPER::InsertKeypress($char); - $w->addGlobEnd; -} - -############################################################ -sub TextUndoFileProgress -{ - my ($w,$action,$filename,$count,$val,$total) = @_; - return unless(defined($filename) and defined($count)); - - my $popup = $w->{'FILE_PROGRESS_POP_UP'}; - unless (defined($popup)) - { - $w->update; - $popup = $w->Toplevel(-title => "File Progress",-popover => $w); - $popup->transient($w->toplevel); - $popup->withdraw; - $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->{PROGBAR} = $i; - } - $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); - } - else - { - $popup->{PROGBAR}->placeForget; - } - - $popup->idletasks; - unless ($popup->viewable) - { - $w->idletasks; - $w->toplevel->deiconify unless $w->viewable; - $popup->Popup; - } - $popup->update; - return $popup; -} - -sub FileName -{ - my ($w,$filename) = @_; - if (@_ > 1) - { - $w->{'FILENAME'}=$filename; - } - return $w->{'FILENAME'}; -} - -sub PerlIO_layers -{ - my ($w,$layers) = @_; - $w->{PERLIO_LAYERS} = $layers if @_ > 1; - return $w->{PERLIO_LAYERS} || '' ; -} - -sub ConfirmDiscard -{ - my ($w)=@_; - if ($w->numberChanges) - { - my $ans = $w->messageBox(-icon => 'warning', - -type => 'YesNoCancel', -default => 'Yes', - -message => -"The text has been modified without being saved. -Save edits?"); - return 0 if $ans eq 'Cancel'; - return 0 if ($ans eq 'Yes' && !$w->Save); - } - return 1; -} - -################################################################################ -# 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) -# {$w->ConfirmExit;} -# -# 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;}; -# -################################################################################ - -sub ConfirmExit -{ - my ($w) = @_; - $w->toplevel->destroy if $w->ConfirmDiscard; -} - -sub Save -{ - my ($w,$filename) = @_; - $filename = $w->FileName unless defined $filename; - return $w->FileSaveAsPopup unless defined $filename; - my $layers = $w->PerlIO_layers; - if (open(my $file,">$layers",$filename)) - { - my $status; - my $count=0; - my $index = '1.0'; - my $progress; - my ($lines) = $w->index('end - 1 chars') =~ /^(\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); - $index = $end; - if (($count++%1000) == 0) - { - $progress = $w->TextUndoFileProgress (Saving => $filename,$count,$count,$lines); - } - } - $progress->withdraw if defined $progress; - if (close($file)) - { - $w->ResetUndo; - $w->FileName($filename); - return 1; - } - } - else - { - $w->BackTrace("Cannot open $filename:$!"); - } - return 0; -} - -sub Load -{ - my ($w,$filename) = @_; - $filename = $w->FileName unless (defined($filename)); - return 0 unless defined $filename; - my $layers = $w->PerlIO_layers; - if (open(my $file,"<$layers",$filename)) - { - $w->MainWindow->Busy; - $w->EmptyDocument; - my $count=1; - my $progress; - while (<$file>) - { - $w->SUPER::insert('end',$_); - if (($count++%1000) == 0) - { - $progress = $w->TextUndoFileProgress (Loading => $filename, - $count,tell($file),-s $filename); - } - } - close($file); - $progress->withdraw if defined $progress; - $w->markSet('insert' => '1.0'); - $w->FileName($filename); - $w->MainWindow->Unbusy; - } - else - { - $w->BackTrace("Cannot open $filename:$!"); - } -} - -sub IncludeFile -{ - my ($w,$filename) = @_; - unless (defined($filename)) - {$w->BackTrace("filename not specified"); return;} - my $layers = $w->PerlIO_layers; - if (open(my $file,"<$layers",$filename)) - { - $w->Busy; - my $count=1; - $w->addGlobStart; - my $progress; - while (<$file>) - { - $w->insert('insert',$_); - if (($count++%1000) == 0) - { - $progress = $w->TextUndoFileProgress(Including => $filename, - $count,tell($file),-s $filename); - } - } - $progress->withdraw if defined $progress; - $w->addGlobEnd; - close($file); - $w->Unbusy; - } - else - { - $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. -sub EmptyDocument -{ - my ($w) = @_; - $w->SUPER::delete('1.0','end'); - $w->ResetUndo; - $w->FileName(undef); -} - -sub ConfirmEmptyDocument -{ - my ($w)=@_; - $w->EmptyDocument if $w->ConfirmDiscard; -} - -sub FileMenuItems -{ - my ($w) = @_; - return [ - ["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} - ] -} - -sub EditMenuItems -{ - my ($w) = @_; - - return [ - ["command"=>'Undo', -command => [$w => 'undo']], - ["command"=>'Redo', -command => [$w => 'redo']], - "-",@{$w->SUPER::EditMenuItems} - ]; -} - -sub CreateFileSelect -{ - my $w = shift; - my $k = shift; - my $name = $w->FileName; - my @types = (['All Files', '*']); - my $dir = undef; - if (defined $name) - { - require File::Basename; - my $sfx; - ($name,$dir,$sfx) = File::Basename::fileparse($name,'\..*'); - # - # it should never happen where we have a file suffix and - # no file name... but fileparse() screws this up with dotfiles. - # - if (length($sfx) && !length($name)) { ($name, $sfx) = ($sfx, $name) } - - if (defined($sfx) && length($sfx)) - { - unshift(@types,['Similar Files',[$sfx]]); - $name .= $sfx; - } - } - return $w->$k(-initialdir => $dir, -initialfile => $name, - -filetypes => \@types, @_); -} - -sub FileLoadPopup -{ - my ($w)=@_; - my $name = $w->CreateFileSelect('getOpenFile',-title => 'File Load'); - return $w->Load($name) if defined($name) and length($name); - return 0; -} - -sub IncludeFilePopup -{ - my ($w)=@_; - my $name = $w->CreateFileSelect('getOpenFile',-title => 'File Include'); - return $w->IncludeFile($name) if defined($name) and length($name); - return 0; -} - -sub FileSaveAsPopup -{ - my ($w)=@_; - my $name = $w->CreateFileSelect('getSaveFile',-title => 'File Save As'); - return $w->Save($name) if defined($name) and length($name); - return 0; -} - - -sub MarkSelectionsSavePositions -{ - my ($w)=@_; - $w->markSet('MarkInsertSavePosition','insert'); - my @ranges = $w->tagRanges('sel'); - my $i = 0; - while (@ranges) - { - my ($start,$end) = splice(@ranges,0,2); - $w->markSet( 'MarkSelectionsSavePositions_'.++$i, $start); - $w->markSet( 'MarkSelectionsSavePositions_'.++$i, $end); - $w->tagRemove('sel',$start,$end); - } -} - -sub RestoreSelectionsMarkedSaved -{ - my ($w)=@_; - my $i = 1; - my %mark_hash; - foreach my $mark ($w->markNames) - { - $mark_hash{$mark}=1; - } - while(1) - { - 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. -sub GetMarkedSelectedLineNumbers -{ - my ($w) = @_; - - my $i = 1; - my %mark_hash; - my @ranges; - foreach my $mark ($w->markNames) - { - $mark_hash{$mark}=1; - } - - while(1) - { - 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); - - push(@ranges, $indexstart, $indexend); - } - - my @selection_list; - while (@ranges) - { - 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); - } - return @selection_list; -} - -sub insertStringAtStartOfSelectedLines -{ - my ($w,$insert_string)=@_; - $w->addGlobStart; - $w->MarkSelectionsSavePositions; - foreach my $line ($w->GetMarkedSelectedLineNumbers) - { - $w->insert($line.'.0', $insert_string); - } - $w->RestoreSelectionsMarkedSaved; - $w->addGlobEnd; -} - -sub deleteStringAtStartOfSelectedLines -{ - my ($w,$insert_string)=@_; - $w->addGlobStart; - $w->MarkSelectionsSavePositions; - my $length = length($insert_string); - foreach my $line ($w->GetMarkedSelectedLineNumbers) - { - my $start = $line.'.0'; - my $end = $line.'.'.$length; - my $current_text = $w->get($start, $end); - next unless ($current_text eq $insert_string); - $w->delete($start, $end); - } - $w->RestoreSelectionsMarkedSaved; - $w->addGlobEnd; -} - - -1; -__END__ - |