view release on metacpan or  search on metacpan

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

	$mw->bind($class,'<Next>',['SetCursor',Ev('ScrollPages',1)]);
	$mw->bind($class,'<Shift-Next>',['KeySelect',Ev('ScrollPages',1)]);
	$mw->bind($class,'<Control-Next>',['xview','scroll',1,'page']);

	$mw->bind($class,'<Shift-Tab>', 'NoOp');
	$mw->bind($class,'<Control-Tab>','focusNext');
	$mw->bind($class,'<Control-Shift-Tab>','focusPrev');

	$mw->bind($class,'<Control-space>',['markSet','anchor','insert']);
	$mw->bind($class,'<Select>',['markSet','anchor','insert']);
	$mw->bind($class,'<Control-Shift-space>',['SelectTo','insert','char']);
	$mw->bind($class,'<Shift-Select>',['SelectTo','insert','char']);
	$mw->bind($class,'<Control-slash>','selectAll');
	$mw->bind($class,'<Control-backslash>','unselectAll');

	$mw->bind($class,'<Control-z>','processKill');
	$mw->bind($class,'<Control-u>','bufferToggle');
	$mw->bind($class,'<Control-w>','clear');

	$mw->bind($class,'<Destroy>','Destroy');
#	$mw->bind($class, '<3>', ['PostPopupMenu', Ev('X'), Ev('Y')]  );
	$mw->YMouseWheelBind($class);
	$mw->XMouseWheelBind($class);

	$mw->MouseWheelBind($class);
 
	return $class;
}

sub bufferToggle {
	my $self = shift;
	my $flag = $self->cget('-buffering');
	my $val;
	if ($flag) {
		$self->configure(-buffering => 0);
		$val = 'off';
	} else {
		$self->configure(-buffering => 1);
		$val = 'on';
	}
	$self->condNewline;
	$self->writeMessage("buffering $val\n");
	$self->prompt unless $self->processRuns;
}

=item B<clear>

Kills the current process if one is running and deletes all text.

=cut

sub clear {
	my $self = shift;
	$self->processKill;
	$self->delete('1.0', 'end - 2c');
	$self->linkScanned(1);
	$self->prompt;
}

sub clipboardCut { #Disabling clipboard cut
}

sub clipboardPaste { #clipboard paste now pastes as if typed
	my $self = shift;
	my $text = $self->clipboardGet;
	while ($text =~ s/(.)//) {
		$self->Insert($1); 
	}
}

sub commandGet {
	my $self = shift;
	my $command = $self->get($self->start, $self->start . ' lineend - 1c');
	return $command
}

sub commandSet {
	my ($self, $command) = @_;
	my $start = $self->start;

	#remove current entry
	my $cur = $self->commandGet;
	my $l = length $cur;
	$self->delete($start, "$start + $l c") if $l > 0;

	#insert the new one
	$self->insert('point', $command);
}

=item B<configureTags>

Configures all tags for this package.
Call this if you make changes to any of them.

=cut

# This code was blatantly copied from Tk::TextANSIColor
# It does not generate tags when you inherit it.
my (%fgcolors, %bgcolors);
my $clear = color('clear');  # Code to reset control codes

my $code_bold = color('bold');
my $code_uline= color('underline');
my @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$_";
}
#end of blatantly copied code

sub condNewline {
	my $self = shift;
	my $point = $self->point;
	my $text = $self->get("$point linestart", $point);
	$self->insert('point', "\n") unless $text eq '';
}

sub configureTags {
	my $self = shift;
	
	# This code was blatantly copied from Tk::TextANSIColor
	# It does not generate tags when you inherit it.