package Tk::TextEdit;
use vars qw($VERSION);
$VERSION = '3.004'; # $Id: //depot/Tk8/Tk/TextEdit.pm#4 $
use Tk qw (Ev);
use AutoLoader;
use Text::Tabs;
use base qw(Tk::TextUndo);
Construct Tk::Widget 'TextEdit';
sub ClassInit{my($class,$mw)=@_;
$class->SUPER::ClassInit($mw);
$mw->bind($class,'<F5>','IndentSelectedLines');
$mw->bind($class,'<F6>','UnindentSelectedLines');
$mw->bind($class,'<F7>','CommentSelectedLines');
$mw->bind($class,'<F8>','UncommentSelectedLines');
return$class;}my$tab_multiplier=8;
sub debug_code_f1{my$w=shift;}sub debug_code_f2{my$w=shift;}sub InitObject{my($w)=@_;
$w->SUPER::InitObject;
$w->{'INDENT_STRING'}="\t";
$w->{'LINE_COMMENT_STRING'}="#";
my%pair_descriptor_hash=('PARENS'=>['multiline','(',')',"[()]"],'CURLIES'=>['multiline','{','}',"[{}]"],'BRACES'=>['multiline','[',']',"[][]"],'DOUBLEQUOTE'=>['singleline',"\"","\""],'SINGLEQUOTE'=>['singleline',"'","'"],);
$w->{'HIGHLIGHT_PAIR_DESCRIPTOR_HASH_REF'}=\%pair_descriptor_hash;
$w->tagConfigure('CURSOR_HIGHLIGHT_PARENS',-foreground=>'white',-background=>'violet');
$w->tagConfigure('CURSOR_HIGHLIGHT_CURLIES',-foreground=>'white',-background=>'blue');
$w->tagConfigure('CURSOR_HIGHLIGHT_BRACES',-foreground=>'white',-background=>'purple');
$w->tagConfigure('CURSOR_HIGHLIGHT_DOUBLEQUOTE',-foreground=>'black',-background=>'green');
$w->tagConfigure('CURSOR_HIGHLIGHT_SINGLEQUOTE',-foreground=>'black',-background=>'grey');
$w->tagConfigure('BLOCK_HIGHLIGHT_PARENS',-background=>'red');
$w->tagConfigure('BLOCK_HIGHLIGHT_CURLIES',-background=>'orange');
$w->tagConfigure('BLOCK_HIGHLIGHT_BRACES',-background=>'red');
$w->tagConfigure('BLOCK_HIGHLIGHT_DOUBLEQUOTE',-background=>'red');
$w->tagConfigure('BLOCK_HIGHLIGHT_SINGLEQUOTE',-background=>'red');
$w->tagRaise('BLOCK_HIGHLIGHT_PARENS','CURSOR_HIGHLIGHT_PARENS');
$w->tagRaise('BLOCK_HIGHLIGHT_CURLIES','CURSOR_HIGHLIGHT_CURLIES');
$w->tagRaise('BLOCK_HIGHLIGHT_BRACES','CURSOR_HIGHLIGHT_BRACES');
$w->tagRaise('BLOCK_HIGHLIGHT_DOUBLEQUOTE','CURSOR_HIGHLIGHT_DOUBLEQUOTE');
$w->tagRaise('BLOCK_HIGHLIGHT_SINGLEQUOTE','CURSOR_HIGHLIGHT_SINGLEQUOTE');
$w->{'UPDATE_WIDGET_PERIOD'}=300;
$w->{'WINDOW_PLUS_AND_MINUS_VALUE'}=80;
$w->SetGUICallbackIndex(0);
$w->schedule_next_callback;}sub cancel_current_gui_callback_and_restart_from_beginning{my($w)=@_;
if(defined($w->{'UPDATE_WIDGET_AFTER_REFERENCE'})){$w->{'UPDATE_WIDGET_AFTER_REFERENCE'}->cancel();}$w->SetGUICallbackIndex(0);
$w->schedule_next_callback;}sub schedule_next_callback{my($w)=@_;
return if$w->NoMoreGUICallbacksToCall;
$w->{'UPDATE_WIDGET_AFTER_REFERENCE'}=$w->after($w->{'UPDATE_WIDGET_PERIOD'},sub{$w->CallNextGUICallback;
$w->schedule_next_callback;});}sub SetGUICallbacks{my($w,$callback_array_ref)=@_;
$w->{GUI_CALLBACK_ARRAY_REF}=$callback_array_ref;
$w->SetGUICallbackIndex(0);}sub GetGUICallbacks{return shift->{GUI_CALLBACK_ARRAY_REF};}sub SetGUICallbackIndex{my($w,$val)=@_;
$w->{GUI_CALLBACK_ARRAY_INDEX}=$val;}sub GetGUICallbackIndex{return shift->{GUI_CALLBACK_ARRAY_INDEX};}sub IncrementGUICallbackIndex{shift->{GUI_CALLBACK_ARRAY_INDEX}+=1;}sub NoMoreGUICallbacksToCall{my($w)=@_;
return 0 unless defined($w->{GUI_CALLBACK_ARRAY_REF});
return 0 unless defined($w->{GUI_CALLBACK_ARRAY_INDEX});
my$arr_ref=$w->{GUI_CALLBACK_ARRAY_REF};
my$arr_ind=$w->{GUI_CALLBACK_ARRAY_INDEX};
return$arr_ind>=@$arr_ref;}sub CallNextGUICallback{my($w)=@_;
return if$w->NoMoreGUICallbacksToCall;
my$arr_ref=$w->{GUI_CALLBACK_ARRAY_REF};
my$arr_ind=$w->{GUI_CALLBACK_ARRAY_INDEX};
&{$arr_ref->[$arr_ind]} if $arr_ref->[$arr_ind];
$w->IncrementGUICallbackIndex;}sub insert{my$w=shift;
$w->SUPER::insert(@_);
$w->cancel_current_gui_callback_and_restart_from_beginning;}sub delete{my$w=shift;
$w->SUPER::delete(@_);
$w->cancel_current_gui_callback_and_restart_from_beginning;}sub SetCursor{my$w=shift;
$w->SUPER::SetCursor(@_);
$w->cancel_current_gui_callback_and_restart_from_beginning;}sub OverstrikeMode{my($w,$mode)=@_;
if(defined($mode)){$w->SUPER::OverstrikeMode($mode);
$w->cancel_current_gui_callback_and_restart_from_beginning;}return$w->SUPER::OverstrikeMode;}sub GetScreenWindowCoordinates{my$w=shift;
my($top_frac,$bot_frac)=$w->yview;
my$end_index=$w->index('end');
my($lines,$columns)=split(/\./,$end_index);
my$window=$w->{'WINDOW_PLUS_AND_MINUS_VALUE'};
my$top_line=int(($top_frac*$lines)-$window);
$top_line=0 if($top_line<0);
my$bot_line=int(($bot_frac*$lines)+$window);
$bot_line=$lines if($bot_line>$lines);
my$top_index=$top_line.'.0';
my$bot_index=$bot_line.'.0';
$_[0]=$top_index;
$_[1]=$bot_index;}sub IndicesLookGood{my($w,$start,$end,$singleline)=@_;
return 0 unless((defined($start))and(defined($end)));
my($start_line,$start_column)=split(/\./,$start);
my($end_line,$end_column)=split(/\./,$end);
return 1 if($start_line==$end_line);
return 0 if$singleline;
my$string;
$string=$w->get($start_line.'.0',$start_line.'.0 lineend');
$string=substr($string,0,$start_column+1);
$string=expand($string);
$start_column=length($string);
$string=$w->get($end_line.'.0',$end_line.'.0 lineend');
$string=substr($string,0,$end_column+1);
$string=expand($string);
$end_column=length($string);
return 1 if($start_column==$end_column);
return 0;}sub searchForBaseCharacterInPair{my($w,$top_index,$searchfromindex,$bot_index,$direction,$startchar,$endchar,$charpair)=@_;
my($plus_one_char,$search_end_index,$index_offset,$done_index);
if($direction eq '-forward'){$plus_one_char=$endchar;
$search_end_index=$bot_index;
$index_offset=' +1c';
$done_index=$w->index('end');}else{$plus_one_char=$startchar;
$search_end_index=$top_index;
$index_offset='';
$done_index='1.0';}my$at_done_index=0;
my$count=0;
my$char;
while(1){$searchfromindex=$w->search($direction,'-regexp',$charpair,$searchfromindex,$search_end_index);
last unless(defined($searchfromindex));
$char=$w->get($searchfromindex,$w->index($searchfromindex.' +1c'));
if($char eq$plus_one_char){$count+=1;}else{$count-=1;}last if($count==1);
if($at_done_index){$searchfromindex=undef;
last;}$at_done_index=1 if($searchfromindex eq$done_index);
$searchfromindex=$w->index($searchfromindex.$index_offset);}return$searchfromindex;}sub HighlightParenthesisAroundCursor{my($w)=@_;
$w->HighlightSinglePairBracketingCursor('(',')','[()]','CURSOR_HIGHLIGHT_PARENS','BLOCK_HIGHLIGHT_PARENS',0);}sub HighlightCurlyBracesAroundCursor{my($w)=@_;
$w->HighlightSinglePairBracketingCursor('{','}','[{}]','CURSOR_HIGHLIGHT_CURLIES','BLOCK_HIGHLIGHT_CURLIES',0);}sub HighlightBracesAroundCursor{my($w)=@_;
$w->HighlightSinglePairBracketingCursor('[',']','[][]','CURSOR_HIGHLIGHT_BRACES','BLOCK_HIGHLIGHT_BRACES',0);}sub HighlightDoubleQuotesAroundCursor{my($w)=@_;
$w->HighlightSinglePairBracketingCursor("\"","\"","\"",'CURSOR_HIGHLIGHT_DOUBLEQUOTE','BLOCK_HIGHLIGHT_DOUBLEQUOTE',1);}sub HighlightSingleQuotesAroundCursor{my($w)=@_;
$w->HighlightSinglePairBracketingCursor("'","'","'",'CURSOR_HIGHLIGHT_SINGLEQUOTE','BLOCK_HIGHLIGHT_SINGLEQUOTE',1);}sub HighlightAllPairsBracketingCursor{my($w)=@_;
$w->HighlightParenthesisAroundCursor;
$w->HighlightCurlyBracesAroundCursor;
$w->HighlightBracesAroundCursor;
$w->HighlightDoubleQuotesAroundCursor;
$w->HighlightSingleQuotesAroundCursor;}sub HighlightSinglePairBracketingCursor{my($w,$startchar,$endchar,$charpair,$good_tagname,$bad_tagname,$single_line)=@_;
$single_line=0 unless defined($single_line);
$w->tagRemove($good_tagname,'1.0','end');
$w->tagRemove($bad_tagname,'1.0','end');
my$top_index;my$bot_index;
my$cursor=$w->index('insert');
if($single_line){$top_index=$w->index($cursor.' linestart');
$bot_index=$w->index($cursor.' lineend');}else{$w->GetScreenWindowCoordinates($top_index,$bot_index);}my$startindex=$w->searchForBaseCharacterInPair($top_index,$cursor,$bot_index,'-backward',$startchar,$endchar,$charpair);
my$endindex=$w->searchForBaseCharacterInPair($top_index,$cursor,$bot_index,'-forward',$startchar,$endchar,$charpair);
return unless((defined$startindex)and(defined$endindex));
my$final_tag=$bad_tagname;
if($w->IndicesLookGood($startindex,$endindex,$single_line)){$final_tag=$good_tagname;}$w->tagAdd($final_tag,$startindex,$w->index($startindex.'+1c'));
$w->tagAdd($final_tag,$endindex,$w->index($endindex.'+1c'));}sub IndentSelectedLines{my($w)=@_;
$w->insertStringAtStartOfSelectedLines($w->{'INDENT_STRING'});}sub UnindentSelectedLines{my($w)=@_;
$w->deleteStringAtStartOfSelectedLines($w->{'INDENT_STRING'});}sub CommentSelectedLines{my($w)=@_;
$w->insertStringAtStartOfSelectedLines($w->{'LINE_COMMENT_STRING'});}sub UncommentSelectedLines{my($w)=@_;
$w->deleteStringAtStartOfSelectedLines($w->{'LINE_COMMENT_STRING'});}1;
__END__

