view release on metacpan or  search on metacpan

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

sub Button2Release {
	my $self = shift;
	my $mousepos = $self->{'mouse_pos'};
	$self->configure(-cursor => $mousepos->[2]);
	delete $self->{'mouse_pos'};
}

=item B<canUndo>

=cut

sub canUndo {
	my $self = shift;
	my $stack = $self->UndoStack;
	return ((@$stack > 0) or ($self->Buffer ne ''));
}

=item B<canRedo>

=cut

sub canRedo {
	my $stack = $_[0]->RedoStack;
	return (@$stack > 0)
}

sub caseChange {
	my ($self, $upper) = @_;
	$upper = 1 unless defined $upper;
	my @sel = $self->tagRanges('sel');
	my $begin;
	my $end;
	if (@sel) {
		$begin = shift @sel;
		$end = shift @sel;
	} else {
		$begin = $self->index('insert');
		$end = $self->index("$begin + 1c");
	}
	my $text = $self->get($begin, $end);
	if ($text ne '') {
		if ($upper) {
			$text = uc($text)
		} else {
			$text = lc($text)
		}
		$self->replace($begin, $end, $text);
	}
}

sub ClassInit {
	my ($class,$mw) = @_;
	$class->bindRdOnly($mw);
 
	$mw->bind($class,'<Tab>', 'insertTab');
	$mw->bind($class,'<Return>', 'returnPressed');
	$mw->bind($class,'<Delete>','Delete');
	$mw->bind($class,'<BackSpace>','Backspace');
	$mw->bind($class,'<Insert>', 'ToggleInsertMode' ) ;
	$mw->bind($class,'<KeyPress>',['InsertKeypress',Ev('A')]);
	$class->clipboardOperations($mw,'Copy', 'Cut', 'Paste');
	
	$mw->bind($class, '<<Find>>', ['findandreplacepopup', 1]);
	$mw->bind($class, '<<Replace>>', ['findandreplacepopup', 0]);
	$mw->bind($class, '<<Comment>>', 'comment');
	$mw->bind($class, '<<Comment>>', 'comment');
	$mw->bind($class, '<<UnComment>>', 'uncomment');
	$mw->bind($class, '<<Indent>>', 'indent');
	$mw->bind($class, '<<UnIndent>>', 'unindent');
	$mw->bind($class, '<<Undo>>', 'undo');
	$mw->bind($class, '<<Redo>>', 'redo');
	$mw->bind($class, '<<UpperCase>>', ['caseChange', 1]);
	$mw->bind($class, '<<LowerCase>>', ['caseChange', 0]);
	return $class
}

=item B<clear>

=cut

sub clear {
	my $self = shift;
	$self->SUPER::delete('1.0', 'end');

	$self->ResetRedo;
	$self->ResetUndo;

	$self->Buffer('');
	$self->BufferMode('');
	$self->BufferModified(0);
	$self->BufferReplace('');
	$self->BufferStart('1.0');
	$self->editModified(0);
	$self->OverstrikeMode(0);

	$self->modifiedCall('1.0');
}

sub clearModified {
	my $self = shift;
	$self->Flush;
	$self->editModified(0);
	$self->BufferModified(0);
	my $r = $self->RedoStack;
	my $u = $self->UndoStack;
	for (@$r, @$u) { $_->{'modified'} = 1 }
}

#preventing copy and cut from sending empty string to the clipboard
sub clipboardCopy {
	my $self = shift;
	$self->SUPER::clipboardCopy(@_) if $self->tagRanges('sel');
}
 
sub clipboardCut {
	my $self = shift;
	return $self->clipboardCopy(@_) if $self->cget('-readonly');
	$self->SUPER::clipboardCut(@_) if $self->tagRanges('sel');
}
 
sub clipboardPaste {
	my $self = shift;
	return if $self->cget('-readonly');
	$self->SUPER::clipboardPaste(@_);
}
 
=item B<comment>

=cut

sub comment {
	my $self = shift;
	return if $self->cget('-readonly');
	my $slstart = $self->cget('-slcomment');
	my $mlend = $self->cget('-mlcommentend');
	my $mlstart = $self->cget('-mlcommentstart');
	my $modified = $self->editModified;
	if ($self->CommentType eq 'multi') {
		#multi line operation
		if ((defined $mlend) and (defined $mlstart)) {
			my ($rb, $re) = $self->tagRanges('sel');
			my $old = $self->get($rb, $re);
			$self->SUPER::insert($rb, $mlstart);
			$self->SUPER::insert($re, $mlend);
			my $len = length $mlend;
			$re = $self->index("$re + $len chars");
			my $new = $self->get($rb, $re);
			$self->unselectAll;
			$self->tagAdd('sel',$rb, $re);
			$self->RecordUndo('replace', $modified, $rb, $old, $new);
			$self->modifiedCall($rb);
			my $lines = $self->linenumber($re) - $self->linenumber($rb);
			$self->log("Commented $lines lines");
		} elsif (defined $slstart) { 
			$self->selectionModify($slstart, 0, 'Commented');
		}
	} else { 
		#single line operation
		my $begin = $self->index('insert linestart');
		my $end = $self->index("$begin lineend");
		my $old = $self->get($begin, $end);
		if (defined $slstart) {
			$self->SUPER::insert($begin, $slstart);
		} elsif ((defined $mlend) and (defined $mlstart)) {
			$self->SUPER::insert($end, $mlend);
			$self->SUPER::insert($begin, $mlstart);
		}
		my $new = $self->get($begin, "$begin lineend");
		$self->RecordUndo('replace', $modified, $begin, $old, $new);
		$self->modifiedCall($begin);
	}
}

sub CommentType {
	my $self = shift;
	if ($self->selectionExists) {
		my $mode = 'single'; #does the selection span over multiple lines?
		my ($rb, $re) = $self->tagRanges('sel');
		$mode = 'multi' if ($self->linenumber($rb) < $self->linenumber($re));
		return $mode
	}
	return 'single'	
}

sub delete {
	my $self = shift;
	my $begin = $_[0];
	$begin = 'insert' unless defined $begin;
	$begin = $self->index($begin);
	my $string = $self->get(@_);
	$self->RecordUndo('delete', $self->editModified, $begin, $string);
	$self->SUPER::delete(@_);
	$self->modifiedCall($begin);
}

sub DoPostConfig {
	my $self = shift;
	my $string = '00000000';
	my $length = $self->fontMeasure($self->cget('-font'), $string);
	my $iw =  $self->cget('-insertwidth');
	$self->{'ins_width_ins'} = $iw;
	$self->{'ins_width_ovr'} = int($length/8);
}

sub EditMenuItems {
	my $self = shift;
	return (
		["command"=>'~Copy',
			-accelerator => 'CTRL+C',
			-command => [$self => 'clipboardCopy']
		],
		["command"=>'C~ut', 
			-accelerator => 'CTRL+X',
			-command => [$self => 'clipboardCut']
		],
		["command"=>'~Paste', 
			-accelerator => 'CTRL+V',
			-command => [$self => 'clipboardPaste']
		],
		"-",
		["command"=>'~Undo', 
			-accelerator => 'CTRL+Z',
			-command => [$self => 'undo']
		],
		["command"=>'~Redo', 
			-accelerator => 'CTRL+SHIFT+Z',
			-command => [$self => 'redo']
		],
		"-",
		["command"=>'C~omment', 
			-accelerator => 'CTRL+G',
			-command => [$self => 'comment']
		],
		["command"=>'U~ncomment', 
			-accelerator => 'CTRL+SHIFT+G',
			-command => [$self => 'uncomment']
		],
		"-",
		["command"=>'~Indent', 
			-accelerator => 'CTRL+J',
			-command => [$self => 'indent']
		],
		["command"=>'Unin~dent', 
			-accelerator => 'CTRL+SHIFT+J',
			-command => [$self => 'unindent']
		],
		"-",
		["command"=>'U~pper case', 
			-accelerator => 'CTRL+U',
			-command => [$self => 'caseChange', 1]
		],
		["command"=>'~Lower case', 
			-accelerator => 'ALT+U',
			-command => [$self => 'caseChange', 0]
		],
	);
}

sub EmptyDocument { $_[0]->clear }

sub EscapePressed {
	my $self = shift;
	if ($self->acPop->ismapped) {
		$self->acPopDown;
	} else {
		$self->unselectAll;
		$self->Callback('-escapepressed');
	}
}

sub FindAll {
	my ($self, $mode, $case, $pattern) = @_;
	$self->FindClear;
	my $search = $self->FindExpression($mode, $case, $pattern);
	return unless defined $search;
	my @all;
	for (1 .. $self->linenumber('end - 1c')) {
		my @hits = $self->FindInLine($_, $search);