view release on metacpan or  search on metacpan

lib/Tk/Text/SuperText.pm  view on Meta::CPAN

#+20010117 JWT TextANSIColor support
#sub get
#{
#	my $self= shift;  # The widget reference
#	return $self->SUPER::get(@_);
#}

sub getansi
{
	my $self= shift;  # The widget reference
	my (@args) = @_;
	return $self->get(@args)  unless ($self->{ansicolor});

	my $i;
	my (@xdump);
	my $tagflag = 0;
	my $res = '';

	@xdump = $self->dump(@args);
	for ($i=0;$i<=$#xdump;$i+=3)
	{
		if ($xdump[$i] eq 'tagon')
		{
			if ($xdump[$i+1] =~ /^ANSIfg(\w+)/)
			{
				$res .= color($1);
				$tagflag = 1;
			}
			elsif ($xdump[$i+1] =~ /^ANSIbg(\w+)/)
			{
				$res .= color("on_$1");
				$tagflag = 1;
			}
			elsif ($xdump[$i+1] =~ /^ANSIbd/)
			{
				$res .= color('bold');
				$tagflag = 1;
			}
			elsif ($xdump[$i+1] =~ /^ANSIul/)
			{
				$res .= color('underline');
				$tagflag = 1;
			}
			#$res .= $xdump[$i+4]  if ($xdump[$i+3] eq 'text');
		}
		if ($tagflag && $xdump[$i] eq 'tagoff')
		{
			$res .= color('reset');
			$tagflag = 0;
		}
		if ($xdump[$i] eq 'text')
		{
			$res .= $xdump[$i+1];
		}
	};
	return $res;
}
#+

# clipboard methods that must be overriden for rectangular selections

sub deleteSelected
{
	my $w = shift;
	
	if(!defined $Tk::selectionType || ($Tk::selectionType eq 'normal')) {
		$w->SUPER::deleteSelected;
	} elsif ($Tk::selectionType eq 'rect') {
		my ($sl,$sc) = split('\.',$w->index('sel.first'));
		my ($el,$ec) = split('\.',$w->index('sel.last'));
		my ($i,$x);
		
		# delete only text in the rectangular selection range
		$w->_BeginUndoBlock;
		for($i=$sl;$i<=$el;$i++) {
			my ($l,$c) = split('\.',$w->index("$i.end"));
			# check if selection is too right (??) for this line
			if($sc > $c) {next;}
			# and clip selection
			if($ec <= $c) {$x=$ec;}
			else { $x=$c;}
			
			$w->delete($w->index("$i.$sc"),$w->index("$i.$x"));
		}
		$w->_EndUndoBlock;
	}
}

sub getSelected
{
	my $w = shift;
	
	if(!defined $Tk::selectionType || ($Tk::selectionType eq 'normal')) {
		return $w->SUPER::getSelected;
	} elsif ($Tk::selectionType eq 'rect') {
		my ($sl,$sc) = split('\.',$w->index('sel.first'));
		my ($el,$ec) = split('\.',$w->index('sel.last'));
		my ($i,$x);
		my ($sel,$str);
		
		$sel="";
		
		# walk throught all the selected lines and add a sel tag
		for($i=$sl;$i<=$el;$i++) {
			my ($l,$c) = split('\.',$w->index("$i.end"));
			# check if  selection is too much to the right
			if($sc > $c) {next;}
			# or clif if too wide
			if($ec <= $c) {$x=$ec;}
			else { $x=$c;}
			$str=$w->get($w->index("$i.$sc"),$w->index("$i.$x"));
			# add a new line if not the last line
			if(substr($str,-1,1) ne "\n") {
				$str=$str."\n";
			}
			$sel=$sel.$str;
		}
		return $sel;
	}
}

lib/Tk/Text/SuperText.pm  view on Meta::CPAN

sub flashMatchingChar
{
	my $w = shift;
	my $s = $w->index('insert');
	my $str = $w->get('insert');
	
	if(exists $w->{MATCHINGCOUPLES}->{$str}) {
		my $i=$w->_FindMatchingChar($str,$s,"1.0","end");
		if(defined $i) {
			my $sel = Tk::catch {$w->tag('nextrange','match','1.0','end');};
			if(defined $sel) {$w->tag('remove','match','match.first');}
			$w->tag('add','match',$i,$w->index("$i + 1c"));
			my $t=$w->cget('-matchhighlighttime');
			if($t != 0) {$w->after($t,[\&removeMatch,$w,$i]);}
			return $i;
		}
	}
	return undef;
}

sub findMatchingChar
{
	my $w = shift;
	my $i = $w->flashMatchingChar;
	
	if(defined $i) {$w->see($i);}
}

sub jumpToMatchingChar
{
	my $w = shift;
	my $i = $w->flashMatchingChar;
	
	if(defined $i) {$w->SetCursor($i);}
}


sub escape
{
	my $w = shift;
	$w->tag('remove','sel','1.0','end');
}

sub tab
{
	my $w = shift;

	$w->Insert("\t");
	$w->focus;
	$w->break;
}

sub leftTab
{
}

sub copy
{
	my $w = shift;

	Tk::catch{$w->clipboardCopy;};
}

sub cut
{
	my $w = shift;

	Tk::catch{$w->clipboardCut;};
	$w->see('insert');
}

sub paste
{
	my $w = shift;

	Tk::catch{$w->clipboardPaste;};
	$w->see('insert');
}

sub inlinePaste
{
	my $w = shift;
	my ($l,$c) = split('\.',$w->index('insert'));
	my $str;
	my $f=0;
	Tk::catch{$str=$w->clipboardGet;};
	
	if($str eq "") {return;}
	$w->_BeginUndoBlock;
	while($str =~ /(.*)\n+/g) {
		$w->insert("$l.$c",$1);
		if($f == 0) {
			my ($el,$ec) = split('\.',$w->index('end'));
			if($l == $el) {
				$w->insert('end',"\n");
				$f=1;
			}
		} else {$w->insert('end',"\n");}
		$l++;
		$w->idletasks;
	}
	$w->_EndUndoBlock;
	$w->see('insert');
}

sub destroy
{
	my $w = shift;

	$w->Destroy;
}

sub keyPress
{
	my $w = shift;
	my $ev = $w->XEvent;

	$w->Insert($ev->A);
}

sub menuSelect
{
	my $w = shift;
	#NOTE: (JWT) ALSO FIXED IN auto/Tk/Text/SuperText/menuSelect.al!!!!!

#+20010117 JWT don't do these 2 lines in windows
	unless ($^O =~ /Win/)
	{
		my $ev = $w->XEvent;
	
		$w->TraverseToMenu($ev->K);
	}
#+
}

sub noOP
{
	my $w = shift;
	$w->NoOp;
}

1;
__END__

=pod