view release on metacpan or  search on metacpan

testTextEdit  view on Meta::CPAN

	#   i.e. bare widgets don't work.
	my $container = $mw->Frame();
	my $textWidget = $container->Scrolled('Text', 
			-relief => 'sunken',
			-height => 10,
			-width => 80,
			-scrollbars => 'se',
                        -wrap => 'none',
			);
	$textWidget->pack(-fill => 'both', -expand => 1);
	my @lines;
	my $lineCount = 0;
	while(defined($_ = <INFILE>) && ($lineCount < 200) ){ # For speed, limit lines to 200
		s/\r//; #get rid of dos newlines
		push @lines, $_;
		$lineCount++;
	}
	close INFILE;
	
	$textWidget->insert('0.0', join("", @lines));

        # Create Tags for syntax highlighting
        $textWidget->tagConfigure('Subroutine', -foreground => 'brown');
        $textWidget->tagConfigure('Subroutine1', -foreground => 'chocolate');
        $textWidget->tagConfigure('Numeric Const', -foreground => 'RoyalBlue4');
        $textWidget->tagConfigure('String', -foreground => 'RoyalBlue3');
        $textWidget->tagConfigure('String2', -foreground => 'RoyalBlue3');
        
        $textWidget->tagConfigure('Identifier1', -foreground => 'Black');
        $textWidget->tagConfigure('Keyword', -foreground => 'Purple4');
        $textWidget->tagConfigure('Comment', -foreground => 'seagreen');

        $HIGHLIGHT_PATTERNS = readHighlightPatterns();
        
        # Apply text highlighting
        applyHighlighting($textWidget, $HIGHLIGHT_PATTERNS);
        
	return $container;
}

# Sub to return syntax highlight patterns.
#   This is a quick-and-dirty tranlation of the Nedit perl highlighting patterns
sub readHighlightPatterns{
	
        my $patterns = 
        {
          'statements' => {
                            'highlightStyle' => 'Keyword',
                            'options' => 'D',
                            'errorMatch' => '',
                            'endMatch' => '',
                            'parentPattern' => '',
                            'startMatch' => '\\b(if|until|while|elsif|else|unless|for(each)?|continue|last|goto|next|redo|do(?=\\s*\\{)|BEGIN|END)bb'
                          },
          'library functions' => {
                                   'highlightStyle' => 'Subroutine',
                                   'options' => undef,
                                   'errorMatch' => '',
                                   'endMatch' => '',
                                   'parentPattern' => '',
                                   'startMatch' => '\\b((?# arithmetic functions)abs|atan2|cos|exp|int|log|rand|sin|sqrt|srand|time|(?# conversion functions)chr|gmtime|hex|localtime|oct|ord|vec|(?# structure conversion)pack|unpack|(?# string function...
                                 },
          'subroutine call' => {
                                 'highlightStyle' => 'Subroutine1',
                                 'options' => 'D',
                                 'errorMatch' => '',
                                 'endMatch' => '',
                                 'parentPattern' => '',
                                 'startMatch' => '&\\w(\\w|::)\\b|\\b\\w(\\w|::)*(?=\\s*\\()'
                               },
          'comment' => {
                         'highlightStyle' => 'Comment',
                         'options' => undef,
                         'errorMatch' => '',
                         'endMatch' => '$',
                         'parentPattern' => '',
                         'startMatch' => '(?:[^$]|^)#'
                       },
          'dq string' => {
                           'highlightStyle' => 'String2',
                           'options' => undef,
                           'errorMatch' => '\\n\\s*\\n',
                           'endMatch' => '',
                           'parentPattern' => '',
                           'startMatch' => '"[^\'\\n]*"'
                         },
          'sq string' => {
                           'highlightStyle' => 'String',
                           'options' => undef,
                           'errorMatch' => '\\n\\s*\\n',
                           'endMatch' => '',
                           'parentPattern' => '',
                           'startMatch' => '\'[^\'\\n]*\''
                         }
        };
	return $patterns;
}

########## Sub to actually apply the text highlighting patterns ############
sub applyHighlighting{

	my $text = shift;
	my $patterns = shift;
	
	
	my $startIndex = shift || '1.0';
	
	my $stopIndex =  shift || 'end';
	
	#my $patterns = $text->cget('-highlightpatterns');
	
	my $string = $text->get($startIndex,$stopIndex);
        #print "Highlighting $startIndex, $stopIndex '$string'\n";

	my ($pos1, $pos2); # starting/stopping positions in the text
	# Go Thru each highlighting pattern
	
	
	foreach my $patName(keys %$patterns){

		my @fromToIndexes; # Array of from/to indexes to use for this patName