view release on metacpan or  search on metacpan

lib/Prima/CodeManager/Edit.pm  view on Meta::CPAN

	my $text = $self-> get_selected_text;
	$::application-> Clipboard-> text($text) if defined $text;
}

#-------------------------------------------------------------------------------

sub get_selected_text
{
	my $self = $_[0];
	return undef unless $self-> has_selection;
	my @sel = $self-> selection;
	my $text = '';
	my $bt = $self-> blockType;

	if ( $bt == bt::CUA) {
#print "$sel[1] == $sel[3]\n";
		if ( $sel[1] == $sel[3]) {
			$text = substr( $self-> get_line( $sel[1]), $sel[0], $sel[2] - $sel[0]);
		} else {
			my $c = $self-> get_line( $sel[1]);
			$text = substr( $c, $sel[0], length( $c) - $sel[0])."\n";
			my $i;
			for ( $i = $sel[1] + 1; $i < $sel[3]; $i++) {
				$text .= $self-> get_line( $i)."\n";
			}
			$c = $self-> get_line( $sel[3]);
			$text .= substr( $c, 0, $sel[2]);
		}
	} elsif ( $bt == bt::Horizontal) {
		my $i;
		for ( $i = $sel[1]; $i <= $sel[3]; $i++) {
		$text .= $self-> get_line( $i)."\n";
		}
	} else {
		my $i;
		for ( $i = $sel[1]; $i <= $sel[3]; $i++) {
			my $c = $self-> get_line( $i);
			my $cl = $sel[2] - length( $c);
			$c .= ' 'x$cl if $cl > 0;
			$text .= substr($c, $sel[0], $sel[2] - $sel[0])."\n";
		}
		chomp( $text);
	}
#print "|$text|\n";
	return $text;
}

#-------------------------------------------------------------------------------

sub lock_change
{
	my ( $self, $lock) = @_;
	$lock = $lock ? 1 : -1;
	$self-> {notifyChangeLock} += $lock;
	$self-> {notifyChangeLock} = 0 if $lock > 0 && $self-> {notifyChangeLock} < 0;
	$self-> notify(q(Change)) if $self-> {notifyChangeLock} == 0 && $lock < 0;
}

#-------------------------------------------------------------------------------

sub change_locked
{
	my $self = $_[0];
	return $self-> {notifyChangeLock} != 0;
}

#-------------------------------------------------------------------------------

sub insert_text
{
	my ( $self, $s, $hilite) = @_;

#print "$s\n";

	return if $self-> {readOnly};
	return if !defined($s) or length( $s) == 0;

	$self-> begin_undo_group;
	$self-> cancel_block unless $self-> {blockType} == bt::CUA;
	my @cs = $self-> cursor;
	my @xy = @cs;

	my @ln = split( "\n", $s, -1);
#	my $zzz = join '|', @ln;
#print "<|$zzz|>$cs[1]\n";
#	pop @ln unless length $ln[-1];
	$s = $self-> get_line( $cs[1]);

#cursor position shift to end of the line if is greater than it:
	$cs[0] = length( $s) if $cs[0] > length( $s);

	my $cl = $cs[0] - length( $s);
#	$s .= ' 'x$cl if $cl > 0;
#	$cl = 0 if $cl < 0;
	$self-> lock_change(1);

	if ( scalar @ln == 1) {
		substr( $s, $cs[0], 0) = $ln[0];
		$self-> set_line( $cs[1], $s, q(add), $cs[0], $cl + length( $ln[0]));
		$self-> selection( $cs[0], $cs[1], $cs[0] + length( $ln[0]), $cs[1])
			if $hilite && $self-> {blockType} == bt::CUA;
		@xy = ( $xy[0] + length($ln[0]) ,$xy[1] );

	} else {
		my $spl0 = substr( $s, 0, $cs[0]);
		my $spl1 = substr( $s, $cs[0] );
#		substr( $s, $cs[0], length( $s) - $cs[0] ) = $ln[0];
#		substr( $s, $cs[0], 0 ) = $ln[0];
		$self-> lock;
		$self-> set_line( $cs[1], $spl0.$ln[0] );
		shift @ln;
#		$self-> insert_line( $cs[1] + 1, (@ln, $spl));
		$self-> insert_line( $cs[1] + 1, @ln);
		$self-> set_line( $cs[1] + scalar @ln, $ln[(scalar @ln) -1 ].$spl1 );
		$self-> selection( $cs[0], $cs[1], length( $ln[-1]), $cs[1]+scalar(@ln))
			if $hilite && $self-> {blockType} == bt::CUA;
		$self-> unlock;
		@xy = ( length( $ln[(scalar @ln) -1 ] ), $cs[1] + scalar @ln );
	}
	$self-> lock_change(0);
	$self-> end_undo_group;