view release on metacpan or  search on metacpan

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

package Tk::Text::SuperText;

use Exporter ();
use Tk qw(800 Ev);
use Tk::Text;
use Tk::Derived;


#+20010117 JWT TextANSIColor support
my $ansicolor = 0;
eval 'use Term::ANSIColor; 1' or $ansicolor = -1;
#+

use Carp;
use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT);

@EXPORT = qw(
	mouseSetInsert mouseSelect mouseSelectWord mouseSelectLine mouseSelectAdd mouseSelectChar
	mouseSelectAddWord mouseSelectAddLine mouseSelectAutoScan mouseSelectAutoScanStop 
	mouseMoveInsert mouseRectSelection mouseMovePageTo mouseMovePage mousePasteSelection 
	moveLeft selectLeft selectRectLeft moveLeftWord selectLeftWord 
	moveRight selectRight selectRectRight moveRightWord selectRightWord moveUp selectUp 
	selectRectUp moveUpParagraph selectUpParagraph moveDown selectDown selectRectDown 
	moveDownParagraph selectDownParagraph moveLineStart selectToLineStart moveTextStart 
	selectToTextStart moveLineEnd selectToLineEnd moveTextEnd selectToTextEnd movePageUp 
	selectToPageUp movePageLeft movePageDown selectToPageDown movePageRight 
	setSelectionMark selectToMark selectAll selectionShiftLeft selectionShiftLeftTab 
	selectionShiftRight selectionShiftRightTab ins enter autoIndentEnter 
	noAutoIndentEnter del backSpace deleteToWordStart deleteToWordEnd deleteToLineStart 
	deleteToLineEnd deleteWord deleteLine insertControlCode focusNext focusPrev 
	flashMatchingChar removeMatch findMatchingChar jumpToMatchingChar escape tab 
	leftTab copy cut paste inlinePaste undo redo destroy keyPress menuSelect noOP
);

$VERSION = '0.12';
@ISA = qw(Tk::Derived Tk::Text Exporter);

use base qw(Tk::Text);

Construct Tk::Widget 'SuperText';

my (%fgcolors, %bgcolors, $clear, $code_bold, $code_uline, @colors);

#+20010117 JWT TextANSIColor support
unless ($ansicolor == -1)
{
	$clear = color('clear');  # Code to reset control codes
	$code_bold = color('bold');
	$code_uline= color('underline');
	@colors = qw/black red green yellow blue magenta cyan white/;
	for (@colors)
	{
		my $fg = color($_);
		my $bg = color("on_$_");
		
		$fgcolors{$fg} = "ANSIfg$_";
		$bgcolors{$bg} = "ANSIbg$_";
	}
}
#+

# returns an hash with the default events and key binds
sub DefaultEvents {
	my (%events);
	
	%events = (
		'MouseSetInsert'			=>	['<1>'],
		'MouseSelect'				=>	['<B1-Motion>'],
		'MouseSelectWord'			=>	['<Double-1>'],
		'MouseSelectLine'			=>	['<Triple-1>'],
		'MouseSelectChar'			=>	['<ButtonRelease-3>'],    #ADDED 1999/07 by JWT TO CAUSE RIGHT BUTTON TO EXTEND SELECT!
		'MouseSelectAdd'			=>	['<Shift-1>'],
		'MouseSelectAddWord'		=>	['<Double-Shift-1>'],
		'MouseSelectAddLine'		=>	['<Triple-Shift-1>'],
		'MouseSelectAutoScan'		=>	['<B1-Leave>'],
		'MouseSelectAutoScanStop'	=>	['<B1-Enter>','<ButtonRelease-1>'],
		'MouseMoveInsert'			=>	['<Alt-1>'],
		'MouseRectSelection'		=>	['<Control-B1-Motion>'],
		'MouseMovePageTo'			=>	['<2>'],
		'MouseMovePage'			=>	['<B2-Motion>'],
		'MousePasteSelection'		=>	['<ButtonRelease-2>'],
		
		'MoveLeft'					=>	['<Left>'],
		'SelectLeft'				=>	['<Shift-Left>'],
		'SelectRectLeft'			=>	['<Shift-Alt-Left>'],
		'MoveLeftWord'				=>	['<Control-Left>'],
		'SelectLeftWord'			=>	['<Shift-Control-Left>'],
		'MoveRight'				=>	['<Right>'],
		'SelectRight'				=>	['<Shift-Right>'],
		'SelectRectRight'			=>	['<Shift-Alt-Right>'],
		'MoveRightWord'			=>	['<Control-Right>'],
		'SelectRightWord'			=>	['<Shift-Control-Right>'],
		'MoveUp'					=>	['<Up>'],
		'SelectUp'					=>	['<Shift-Up>'],
		'SelectRectUp'				=>	['<Shift-Alt-Up>'],
		'MoveUpParagraph'			=>	['<Control-Up>'],