view release on metacpan or  search on metacpan

lib/Tk/TextHighlight.pm  view on Meta::CPAN

package Tk::TextHighlight;

use vars qw($VERSION);
$VERSION = '2.2';
use Tk qw(Ev);
use strict;
use Storable;
use File::Basename;

my $blockHighlight = 0;     #USED TO PREVENT RECURSIVE CALLS TO RE-HIGHLIGHT!
my $nodoEvent = 0;          #USED TO PREVENT REPEATING (RUN-AWAY) SCROLLING!
our ($readonly, $TEXTWIDGET, $haveSuperText);

#NOTE:  TextHighlight SUPPORTS USING EITHER SuperText, OR TextUndo (ROText IF USING ROTextOnly SYMLINK).
#       SuperText USES Text (NOT TextUndo).  THE OPTIONAL ROSuperText SYMLINK (uses ROText)
#		IS *NOT* (AND CAN NOT BE) USED HERE!
BEGIN {
	$haveSuperText = 0;
	$readonly = (__FILE__ =~ /RO/o) ? 1 : 0;
	$TEXTWIDGET = 'Tk::Text::SuperText';  #FIRST TRY SuperText:
	my $evalstr = "use $TEXTWIDGET; \$haveSuperText = 1; 1";
	eval $evalstr;
	unless ($haveSuperText) {  #IF SuperText NOT INSTALLED, THEN TRY TextUndo (or ROText):
		$TEXTWIDGET = $readonly ? 'Tk::ROText' : 'Tk::TextUndo';
		$evalstr = "use $TEXTWIDGET; \$haveSuperText = 1; 1";
		eval $evalstr;
	}
	die "e:TextHighlight could not load required widget ($TEXTWIDGET) ($@)!\n"  if ($@);
	$evalstr = "use base ('Tk::Derived', '$TEXTWIDGET')";
	eval $evalstr;
	die "e:TextHighlight could not load base widget ($TEXTWIDGET) ($@)!\n"  if ($@);
};

Construct Tk::Widget 'TextHighlight';

my %syntaxcomments = (  #ALTERNATE COMMENT CHARACTERS FOR SELECTED LANGUAGES (CAN ADD MORE HERE):
	'Kate::C' => '/*',
	'Kate::C++' => '/*',
	'Kate::CPP' => '/*',
	'HTML' => '<!--',
	'Kate::HTML' => '<!--',
	'Kate::Modula-2' => '(*',
	'Kate::Pascal' => '(*',
	'Kate::XML' => '<!--',
);

sub Populate {
	my ($cw,$args) = @_;
	$args->{'-noPopupMenu'} = 0  unless (defined $args->{'-noPopupMenu'});
	$cw->{'-noPopupMenu'} = $args->{'-noPopupMenu'};
	#REMOVE ARGS THAT SUBWIDGETS CAN'T HANDLE:
	my $superargsOK; #THIS INITIALIZATION REQUIRES 2 LINES (my $superargsOK = $args) IS REFERENCE & WILL OVERWRITE LATTER!:
	%{$superargsOK} = %{$args};
	foreach my $badarg (qw(-autoindent -smartindent -match -matchoptions -indentchar
			-disablemenu -commentchar -colorinf -colored -syntax -rules -updatecall 
			-noRulesMenu -noSyntaxMenu -noRulesEditMenu -noSaveRulesMenu -noPlugInit 
			-noPopupMenu -highlightInBackground -syntaxcomments)) {
		delete ($superargsOK->{$badarg})  if (defined($superargsOK->{$badarg}));
	}
	if ($TEXTWIDGET =~ /SuperText/) {
		#ADD ONE THAT IS DIFFERENT (OVERRIDDEN BY OURS):
		$superargsOK->{'-matchingcouples'} = $args->{'-match'}  if (defined $args->{'-match'});
	} else {
		foreach my $badarg (qw(-matchingcouples -showmatching -ansicolor)) {
			delete ($superargsOK->{$badarg})  if (defined($superargsOK->{$badarg}));
			delete ($args->{$badarg})  if (defined($args->{$badarg}));  #-ansicolor MUST ALSO BE REMOVED HERE - DON'T KNOW WHY?!
		}
	}

	$cw->SUPER::Populate($superargsOK);

	my %configSpecs = (
		-autoindent => [qw/PASSIVE autoindent Autoindent/, 0],
		-smartindent => [qw/PASSIVE undef undef/, 1],
		-match => [qw/PASSIVE match Match/, '[]{}()'],
		-matchoptions	=> [qw/METHOD matchoptions Matchoptions/, 
			[-foreground => 'yellow', -background => 'red']], #SuperText'S IS white ON blue, BUT CLASHES W/TOO MANY RULES.
		-indentchar => [qw/PASSIVE indentchar Indentchar/, "\t"],
		-disablemenu => [qw/PASSIVE disablemenu Disablemenu/, 0],
		-commentchar => [qw/PASSIVE commentchar Commentchar/, "#"],
		-syntaxcomments => [qw/PASSIVE undef undef/, 0],    #JWT: ADDED v2 FEATURE.
		-colorinf => [qw/PASSIVE undef undef/, []],
		-colored => [qw/PASSIVE undef undef/, 0],
		-syntax	=> [qw/PASSIVE syntax Syntax/, 'None'],
		-rules	=> [qw/PASSIVE undef undef/, undef],
		-rulesdir	=> [qw/PASSIVE rulesdir Rulesdir/, ''],
		-updatecall	=> [qw/PASSIVE undef undef/, sub {}],
		-noRulesMenu => [qw/PASSIVE undef undef/, 0],       #JWT: ADDED FEATURE.
		-noSyntaxMenu => [qw/PASSIVE undef undef/, 0],      #JWT: ADDED FEATURE.