CodeManager
2 results

 view release on metacpan or  search on metacpan

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


sub profile_default
{
	my %def = %{$_[ 0]-> SUPER::profile_default};
	my $font = $_[ 0]-> get_default_font;

	return {
		%def,
		accelItems => [
# navigation
			[ CursorDown   => 0, 0, kb::Down                , sub{$_[0]-> cursor_down}],
			[ CursorUp     => 0, 0, kb::Up                  , sub{$_[0]-> cursor_up}],
			[ CursorLeft   => 0, 0, kb::Left                , sub{$_[0]-> cursor_left}],
			[ CursorRight  => 0, 0, kb::Right               , sub{$_[0]-> cursor_right}],
			[ PageUp       => 0, 0, kb::PgUp                , sub{$_[0]-> cursor_pgup}],
			[ PageDown     => 0, 0, kb::PgDn                , sub{$_[0]-> cursor_pgdn}],
			[ Home         => 0, 0, kb::Home                , sub{$_[0]-> cursor_home}],
			[ End          => 0, 0, kb::End                 , sub{$_[0]-> cursor_end}],
			[ CtrlPageUp   => 0, 0, kb::PgUp|km::Ctrl       , sub{$_[0]-> cursor_cpgup}],
			[ CtrlPageDown => 0, 0, kb::PgDn|km::Ctrl       , sub{$_[0]-> cursor_cpgdn}],
			[ CtrlHome     => 0, 0, kb::Home|km::Ctrl       , sub{$_[0]-> cursor_chome}],
			[ CtrlEnd      => 0, 0, kb::End |km::Ctrl       , sub{$_[0]-> cursor_cend}],
			[ WordLeft     => 0, 0, kb::Left |km::Ctrl      , sub{$_[0]-> word_left}],
			[ WordRight    => 0, 0, kb::Right|km::Ctrl      , sub{$_[0]-> word_right}],
			[ ShiftCursorDown   => 0, 0, km::Shift|kb::Down                , q(cursor_shift_key)],
			[ ShiftCursorUp     => 0, 0, km::Shift|kb::Up                  , q(cursor_shift_key)],
			[ ShiftCursorLeft   => 0, 0, km::Shift|kb::Left                , q(cursor_shift_key)],
			[ ShiftCursorRight  => 0, 0, km::Shift|kb::Right               , q(cursor_shift_key)],
			[ ShiftPageUp       => 0, 0, km::Shift|kb::PgUp                , q(cursor_shift_key)],
			[ ShiftPageDown     => 0, 0, km::Shift|kb::PgDn                , q(cursor_shift_key)],
			[ ShiftHome         => 0, 0, km::Shift|kb::Home                , q(cursor_shift_key)],
			[ ShiftEnd          => 0, 0, km::Shift|kb::End                 , q(cursor_shift_key)],
			[ ShiftCtrlPageUp   => 0, 0, km::Shift|kb::PgUp|km::Ctrl       , q(cursor_shift_key)],
			[ ShiftCtrlPageDown => 0, 0, km::Shift|kb::PgDn|km::Ctrl       , q(cursor_shift_key)],
			[ ShiftCtrlHome     => 0, 0, km::Shift|kb::Home|km::Ctrl       , q(cursor_shift_key)],
			[ ShiftCtrlEnd      => 0, 0, km::Shift|kb::End |km::Ctrl       , q(cursor_shift_key)],
			[ ShiftWordLeft     => 0, 0, km::Shift|kb::Left |km::Ctrl      , q(cursor_shift_key)],
			[ ShiftWordRight    => 0, 0, km::Shift|kb::Right|km::Ctrl      , q(cursor_shift_key)],
			[ Insert         => 0, 0, kb::Insert , sub {$_[0]-> insertMode(!$_[0]-> insertMode)}],
# edit keys
			[ Delete         => 0, 0, kb::Delete,    sub {
				return if $_[0]-> {readOnly};
				$_[0]-> has_selection ? $_[0]-> delete_block : $_[0]-> delete_char;
			}],
			[ Backspace      => 0, 0, kb::Backspace, sub {$_[0]-> back_char unless $_[0]-> {readOnly}}],
			[ DeleteChunk    => 0, 0, '^Y',          sub {$_[0]-> delete_current_chunk unless $_[0]-> {readOnly}}],
			[ DeleteToEnd    => 0, 0, '^E',          sub {$_[0]-> delete_to_end unless $_[0]-> {readOnly}}],
			[ DupLine        => 0, 0, '^K',          sub {$_[0]-> insert_line($_[0]-> cursorY, $_[0]-> get_line($_[0]-> cursorY)) unless $_[0]-> {readOnly}}],
			[ DeleteBlock    => 0, 0, '@D',          sub {$_[0]-> delete_block unless $_[0]-> {readOnly}}],
			[ SplitLine      => 0, 0, kb::Enter,     sub {$_[0]-> split_line if !$_[0]-> {readOnly} && $_[0]-> {wantReturns}}],
			[ SplitLine2     => 0, 0, km::Ctrl|kb::Enter,sub {$_[0]-> split_line if !$_[0]-> {readOnly} && !$_[0]-> {wantReturns}}],
# block keys
			[ CancelBlock    => 0, 0, '@U',          q(cancel_block)],
			[ MarkVertical   => 0, 0, '@B',          q(mark_vertical)],
			[ MarkHorizontal => 0, 0, '@L',          q(mark_horizontal)],
			[ CopyBlock      => 0, 0, '@C',          q(copy_block)],
			[ OvertypeBlock  => 0, 0, '@O',          q(overtype_block)],
# clipboard keys

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

# undo
			[ Undo            => 0, 0, '^Z', q(undo)],
			[ Undo            => 0, 0, km::Alt|kb::Backspace, q(undo)],
#			[ Redo            => 0, 0, '^R', q(redo)],
		],
		autoIndent        => 1,
		autoHScroll       => 1,
		autoVScroll       => 1,
		blockType         => bt::CUA,
		borderWidth       => 1,
		cursorSize        => [ $::application-> get_default_cursor_width, $font-> { height}],
		cursorVisible     => 1,
		cursorX           => 0,
		cursorY           => 0,
		cursorWrap        => 0,
		insertMode        => 0,
		hiliteNumbers     => cl::Green,
		hiliteQStrings    => cl::LightBlue,
		hiliteQQStrings   => cl::LightBlue,
		hiliteIDs         => [[qw(
abs accept alarm atan2 bind binmode bless caller chdir chmod chomp chop chown
chr chroot close closedir connect continue cos crypt defined
delete die do dump each endgrent endhostent endnetent endprotoent endpwent
endservent eof eval exec exists exit exp fcntl fileno flock for fork format
formline getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname gethostent

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


sub init
{
	my $self = shift;

	for ( qw( autoIndent topLine  offset resetDisabled blockType persistentBlock
		tabIndent readOnly wantReturns wantTabs
	))
		{ $self-> {$_} = 1; }
	for ( qw( wordWrap hScroll vScroll rows maxLineCount maxLineLength maxLineWidth
		scrollTransaction maxLine maxChunk capLen cursorY cursorX cursorWrap
		cursorXl cursorYl syntaxHilite hiliteNumbers hiliteQStrings hiliteQQStrings
		notifyChangeLock modified borderWidth autoHScroll autoVScroll blockShiftMark
	))
		{ $self-> {$_} = 0;}
	$self-> { insertMode}   = $::application-> insertMode;
	for ( qw( markers lines chunkMap hiliteIDs hiliteChars hiliteREs)) { $self-> {$_} = []}
	for ( qw( selStart selEnd selStartl selEndl)) { $self-> {$_} = [0,0]}
	$self-> {defcw} = $::application-> get_default_cursor_width;
	my %profile = $self-> SUPER::init(@_);
	$self-> setup_indents;
	$self-> {undo} = [];
	$self-> {redo} = [];
	$profile{selection} = [@{$profile{selStart}}, @{$profile{selEnd}}];
	for ( qw( hiliteNumbers hiliteQStrings hiliteQQStrings hiliteIDs hiliteChars hiliteREs
		autoHScroll autoVScroll
		textRef syntaxHilite autoIndent persistentBlock blockType hScroll vScroll borderWidth
		topLine  tabIndent readOnly offset wordDelimiters wantTabs wantReturns
		wordWrap cursorWrap markers undoLimit))
		{ $self-> $_( $profile{ $_}); }
	delete $self-> {resetDisabled};
	$self-> {uChange} = 0;
	$self-> reset;
	$self-> selection( @{$profile{selection}});
	for ( qw( cursorX cursorY))
	{ $self-> $_( $profile{ $_}); }
	$self-> reset_scrolls;
	$self-> {modified} = 0;

	$self-> {hiliteBlok_modified} = 0;
	$self-> area;

	return %profile;
}

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

	my $fh    = $self-> font-> height + $self->{lineSpace};
	$self-> {rows}  = int($size[1] / $fh);
	my $yTail = $size[1] - $self-> {rows} * $fh;

	if ( $uC < 2) {
		$self-> {maxLine}  = scalar @{$self-> {lines}} - 1;
		$self-> {maxChunk} = $self-> {wordWrap} ? (scalar @{$self-> {chunkMap}}/3-1) : $self-> {maxLine};
		$self-> {yTail} = ( $yTail > 0) ? 1 : 0;
# updating selections
		$self-> selection( @{$self-> {selStart}}, @{$self-> {selEnd}});
# updating cursor
		$self-> cursor( $self-> cursor);
		my $chunk = $self-> get_chunk( $self-> {cursorYl});
		my $x     = $self-> {cursorXl};
		$self-> {cursorAtX}      = $self-> get_chunk_width( $chunk, 0, $x);
		$self-> {cursorInsWidth} = $self-> get_chunk_width( $chunk, $x, 1);
	}
# positioning cursor
	my $cx  = $a[0] + $self-> {cursorAtX} - $self-> {offset};
	my $cy  = $a[1] + $yTail + ($self-> {rows} - $self-> {cursorYl} + $self-> {topLine } - 1) * $fh;
	my $xcw = $self-> {insertMode} ? $cw : $self-> {cursorInsWidth};
	my $ycw = $fh;
	$ycw -= $a[1] - $cy, $cy = $a[1] if $cy < $a[1];
	$xcw = $size[0] + $a[0] - $cx - 1 if $cx + $xcw >= $size[0] + $a[0];
	$self-> cursorVisible( $xcw > 0);
	if ( $xcw > 0) {
		$self-> cursorPos( $cx, $cy);
		$self-> cursorSize( $xcw, $ycw);
	}
	$self-> {uChange} = 0;

}

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

sub reset_cursor
{
	my $self = $_[0];
	$self-> {uChange} = 2;
	$self-> reset;
	$self-> {uChange} = 0;
}

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

sub reset_render

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


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

sub on_mousedown
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $self-> {mouseTransaction};
	return if $btn != mb::Left && $btn != mb::Middle;
	my @xy = $self-> point2xy( $x, $y);
	return unless $xy[2];
	$self-> cursor( @xy);

	if ( $btn == mb::Middle) {
		my $cp = $::application-> bring('Primary');
		return if !$cp || $self-> {readOnly};
		$self-> insert_text( $cp-> text, 0);
		$self-> clear_event;
		return;
	}

	$self-> {mouseTransaction} = 1;

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

	if ( $xy[2])
	{
		$self-> scroll_timer_stop;
	} else {
		$self-> scroll_timer_start unless $self-> scroll_timer_active;
		return unless $self-> scroll_timer_semaphore;
		$self-> scroll_timer_semaphore(0);
	}
	$self-> {delayPanning} = 1;
	$self-> blockShiftMark(1);
	$self-> cursor( @xy);
	$self-> blockShiftMark(0);
	$self-> update_block unless $self-> {mouseTransaction} == 2;
	$self-> realize_panning;
}

sub on_mousewheel
{
	my ( $self, $mod, $x, $y, $z) = @_;
#	$z = int( $z/120);
	$self-> {wheelRows} += 0;

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

	if ( !$dbl) {
		if ( $self-> {doubleclickTimer}) {
			$self-> {doubleclickTimer}-> destroy;
			delete $self-> {doubleclickTimer};
			$self-> selection( 0, $xy[1], length $s, $xy[1]);
		}
		return;
	}

	$self-> cancel_block;
	$self-> cursor( @xy);

	my $p = $xy[0];
	my $sl = length $s;
	my ($l,$r);

	return unless $sl;

	$p = $sl-1 if $p >= $sl;
	my $word = quotemeta($self-> {wordDelimiters});
	my $nonword = "[$word]";

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

}

##########################################################################

sub on_keydown
{
	my ( $self, $code, $key, $mod, $repeat) = @_;

#	$self->{hiliteBlok_modified} = 1;

#	my @cs = $self-> cursor;
#	my $curr_row  = $self->{topLine} + $cs[1];
#	my $blok_beg  = $self->{hiliteBlok}->[0];
#	my $blok_end  = $self->{hiliteBlok}->[1];

#	my ( $prev_type, $next_type ) = ( 0, 0 );
#	$prev_type =  1 if $self-> get_line( $cs[1] ) =~  /($blok_beg|blok_end)/;

#	my $modify = 0;
#	for (my $i = $cs[1] ; $i < $cs[1] + $self->{rows} ; $i++ ) {
#		$modify = 1 if $self-> get_line( $i ) && (

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

	if  (
		( $code >= ord(' ') || ( $code == ord("\t"))) &&
		(( $mod  & (km::Alt | km::Ctrl)) == 0) &&
		(( $key == kb::NoKey) || ( $key == kb::Space) || ( $key == kb::Tab))
	) {

		{	#wb:
			$self-> delete_block if $self-> has_selection;
		}

		my @cs = $self-> cursor;
		my $c  = $self-> get_line( $cs[1] );
		my $l = 0;

		$self-> begin_undo_group;
		if ( $self-> insertMode) {
			$l = $cs[0] - length( $c), $c .= ' ' x $l if length( $c) < $cs[ 0];
			substr( $c, $cs[0], 0) = chr($code) x $repeat;
			$self-> set_line( $cs[1], $c, q(add), $cs[0], $l + $repeat);

		} else {
			$l = $cs[0] - length( $c) + $repeat, $c .= ' ' x $l
				if length( $c) < $cs[ 0] + $repeat;

			substr( $c, $cs[0], $repeat) = chr($code) x $repeat;
			$self-> set_line( $cs[1], $c, q(overtype));
		}

#		$next_type =  1 if $self-> get_line( $cs[1] ) =~  /($blok_beg|blok_end)/;
#		$self-> area;

		$self-> cursor( $cs[0] + $repeat, $cs[1]);
		$self-> end_undo_group;
		$self-> clear_event;
	}
}

sub on_fontchanged
{
	my $self = $_[0];
	$self-> reset_render;
	$self-> reset_scrolls;

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

	@{$self-> {lines}} = ();
	@{$self-> {lines}} = split( "\n", $$ref." ");
	$self-> {maxLine} = scalar @{$self-> {lines}}-1;

	$self-> reset_syntax;
	$self-> reset_scrolls;
	if ( !$self-> {resetDisabled}) {
		$self-> lock;
		$self-> selection(0,0,0,0);
		$self-> reset;
		$self-> cursor($self-> {cursorX}, $self-> {cursorY});
		$self-> unlock;
		$self-> notify(q(Change));
		$self-> reset_scrolls;
	}
}

sub text
{
	unless ($#_) {
		my $hugeScalarRef = $_[0]-> textRef;

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

{
	delete $_[0]-> {delayPanning};
	for ( qw( topLine  offset)) {
		my $c = 'delay_' . $_;
		next unless defined $_[0]-> {$c};
		$_[0]-> $_( $_[0]-> {$c});
		delete $_[0]-> {$c};
	}
}

sub set_cursor
{
	my ( $self, $x, $y) = @_;
	my ( $ox, $oy) = ($self-> {cursorX}, $self-> {cursorY});
	my $maxY = $self-> {maxLine};
	$y = $maxY if $y < 0 || $y > $maxY;
	$y = 0 if $y < 0; # ??
	my $line = $self-> get_line( $y);
	$x = length( $line) if $x < 0;
	my ( $lx, $ly) = $self-> make_logical( $x, $y);
	my ( $olx, $oly) = ( $self-> {cursorXl}, $self-> {cursorYl});
	$self-> {cursorXl} = $lx;
	$self-> {cursorYl} = $ly;
	return if $y == $oy and $x == $ox and $lx == $olx and $ly == $oly;
	my ( $tl, $r, $yt) = ( $self-> {topLine }, $self-> {rows}, $self-> {yTail});
	if ( $ly < $tl) {
		$self-> topLine ( $ly);
	} elsif ( $ly >= $tl + $r) {
		my $nfc = $ly - $r + 1;
		$self-> topLine ( $nfc);
	}
	my $chunk  = $self-> get_chunk( $ly);
	my $atX    = $self-> get_chunk_width( $chunk, 0, $lx);

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

	my $avg = $self-> {averageWidth};
	if ( $atX < $ofs) {
		my $nofs = $atX;
		$self-> offset( $nofs - $avg);
	} elsif ( $atX >= $ofs + $actualWidth - $deltaX) {
		my $nofs = $atX - $actualWidth + $deltaX;
		$nofs = $ofs + $avg if $nofs - $ofs < $avg;
		$self-> offset( $nofs);
	}

	# check if last undo record contains cursor movements only, so these movements
	# can be grouped

	my $undo = 1;
	if ( !$self-> {undo_in_action} && @{$self-> {undo}} && @{$self-> {undo}-> [-1]}) {
		my $ok = 1;

		for ( @{$self-> {undo}-> [-1]}) {
			$ok = 0, last if $$_[0] ne 'cursor';
		}
		$undo = 0 if $ok;
	}

	$self-> push_undo_action( 'cursor', $self-> {cursorX}, $self-> {cursorY}) if $undo;
	$self-> {cursorX}        = $x;
	$self-> {cursorY}        = $y;
	$self-> {cursorAtX}      = $atX;
	$self-> {cursorInsWidth} = $deltaX;

	$self-> reset_cursor;
	$self-> cancel_block

		if !$self-> {blockShiftMark} && !$self-> {persistentBlock};

}

sub set_top_line
{
	my ( $self, $tl) = @_;
	$tl = $self-> {maxChunk} if $tl >= $self-> {maxChunk};

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

		return;
	}
	my $dt = $tl - $self-> {topLine };
	$self-> push_group_undo_action( 'topLine', $self-> {topLine});
	$self-> {topLine } = $tl;
	if ( $self-> {vScroll} && $self-> {scrollTransaction} != 1) {
		$self-> {scrollTransaction} = 1;
		$self-> {vScrollBar}-> value( $tl);
		$self-> {scrollTransaction} = 0;
	}
	$self-> reset_cursor;
	$self-> scroll( 0, $dt * ($self-> font-> height + $self->{lineSpace}),
		clipRect => [ $self-> get_active_area]);
}

sub reset_indents
{
	my ( $self) = @_;
	$self-> reset_render;
	$self-> reset_scrolls;
		$self-> repaint;

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

		$self-> reset_syntaxer;
		$self-> repaint;
	}
}

sub set_insert_mode
{
	my ( $self, $insert) = @_;
	my $oi = $self-> {insertMode};
	$self-> {insertMode} = $insert;
	$self-> reset_cursor if $oi != $insert;
	$::application-> insertMode( $insert);
	$self-> push_group_undo_action( 'insertMode', $oi) if $oi != $insert;
}

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

sub set_offset
{
	my ( $self, $offset) = @_;
	$offset = 0 if $offset < 0;

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

		return;
	}
	my $dt = $offset - $self-> {offset};
	$self-> push_group_undo_action( 'offset', $self-> {offset});
	$self-> {offset} = $offset;
	if ( $self-> {hScroll} && $self-> {scrollTransaction} != 2) {
		$self-> {scrollTransaction} = 2;
		$self-> {hScrollBar}-> value( $offset);
		$self-> {scrollTransaction} = 0;
	}
	$self-> reset_cursor;
	$self-> scroll( -$dt, 0,
		clipRect => [ $self-> get_active_area]);
}

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

sub set_selection
{
	my ( $self, $sx, $sy, $ex, $ey) = @_;
	my $maxY = $self-> {maxLine};

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

{
	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]));

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

		$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;

	$self-> area( $self->{topLine}, $self->{rows} ) if @{$self->{hiliteBlok}};

	$self-> cursor( @xy );
}

sub insert_text_orig
{
	my ( $self, $s, $hilite) = @_;
	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 @ln = split( "\n", $s, -1);
	pop @ln unless length $ln[-1];
	$s = $self-> get_line( $cs[1]);
	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]));

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

	return $x + $ofs, $nY;
}

sub start_block
{
	my $self = $_[0];
	return if exists $self-> {anchor};
	my $blockType = $_[1] || $self-> {blockType};
	$self-> selection(0,0,0,0);
	$self-> blockType( $blockType);
	$self-> {anchor} = [ $self-> {cursorX}, $self-> {cursorY}];
}

sub update_block
{
	my $self = $_[0];
	return unless exists $self-> {anchor};
	$self-> selection( @{$self-> {anchor}}, $self-> {cursorX}, $self-> {cursorY});
}

sub end_block
{
	my $self = $_[0];
	return unless exists $self-> {anchor};
	my @anchor = @{$self-> {anchor}};
	delete $self-> {anchor};
	$self-> selection( @anchor, $self-> {cursorX}, $self-> {cursorY});
}

sub cancel_block
{
	delete $_[0]-> {anchor};
	$_[0]-> selection(0,0,0,0);
}

sub set_marking
{

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

		last if $dlu >= $vis_len_prev;
		if ( $1 eq "\t" ) {
			$dlu += 3 - ( $dlu % 4 );
		}
		$dlu++;
		$res++;
	}
	return $res;
}

sub cursor_down
{
	my $d = $_[1] || 1;
#print "cursor_down\n";
	my $l1 = $_[0]->get_line( $_[0]-> {cursorYl} );
	my $l2 = $_[0]->get_line( $_[0]-> {cursorYl} + $d );

	($l1,undef) = wstaw_tab_15( $l1, 0, $_[0]-> {cursorX}, '', 0 );
	my $len2 = kursor_w_dol( $l2,length($l1));
	$_[0]-> cursorLog( $len2, $_[0]-> {cursorYl} + $d);

	$_[0]-> area( $_[0]->{topLine}, $_[0]->{rows} ) if $_[0]-> {hiliteBlok_modified} && @{$_[0]->{hiliteBlok}};
}

sub cursor_up
{
#print "cursor_up\n";
	return if $_[0]-> {cursorYl} == 0;

	my $d = $_[1] || 1;

	my $l1 = $_[0]->get_line( $_[0]-> {cursorYl} );
	my $l2 = $_[0]->get_line( $_[0]-> {cursorYl} - $d );
	($l1,undef) = wstaw_tab_15( $l1, 0, $_[0]-> {cursorX}, '', 0 );
	my $len2 = kursor_w_dol( $l2,length($l1));

	my ( $x, $y) = $_[0]-> make_physical( $len2, $_[0]-> {cursorYl} - $d);
#	my ( $x, $y) = $_[0]-> make_physical( $_[0]-> {cursorXl}, $_[0]-> {cursorYl} - $d);
	$y = 0 if $y < 0;
	$_[0]-> cursor( $x, $y);

	$_[0]-> area( $_[0]->{topLine}, $_[0]->{rows} ) if $_[0]-> {hiliteBlok_modified} && @{$_[0]->{hiliteBlok}};
}

sub cursor_left
{
	my $d = $_[1] || 1;
	my $x = $_[0]-> cursorX;
	if ( $x - $d >= 0) {
		$_[0]-> cursorX( $x - $d)
	} elsif ( $_[0]-> {cursorWrap}) {
		if ( $d == 1) {
			my $y = $_[0]-> cursorY - 1;
			$_[0]-> cursor( -1, $y < 0 ? 0 : $y);
		} else {
			$_[0]-> cursor_left( $d - 1);
		}
	} else {
		$_[0]-> cursorX( 0);
	}
}

sub cursor_right
{
	my $d = $_[1] || 1;
	my $x = $_[0]-> cursorX;
	if ( $_[0]-> {cursorWrap} || $_[0]-> {wordWrap}) {
		my $y = $_[0]-> cursorY;
		if ( $x + $d > length( $_[0]-> get_line( $y))) {
			if ( $d == 1) {
				$_[0]-> cursor( 0, $y + 1) if $y < $_[0]-> {maxLine};
			} else {
				$_[0]-> cursor_right( $d - 1);
			}
		} else {
			$_[0]-> cursorX( $x + $d);
		}
	} else {
		$_[0]-> cursorX( $x + $d);
	}
}

sub cursor_home
{
	my ($spaces) = ($_[0]-> get_line( $_[0]-> cursorY) =~ /^([s\t]*)/);
	$_[0]-> begin_undo_group;
	$_[0]-> offset(0);
	$_[0]-> cursorX(0);
	$_[0]-> end_undo_group;
}

sub cursor_end
{
	my ($nonspaces) = ($_[0]-> get_line( $_[0]-> cursorY) =~ /^(.*?)[\s\t]*$/);
	$_[0]-> cursorX( length $nonspaces);

}

sub cursor_cend  {
	$_[0]-> cursor( 0, -1 );
	$_[0]-> cursor_end;
#print "cursor_cend\n";

	$_[0]-> area if $_[0]-> {hiliteBlok_modified} && @{$_[0]->{hiliteBlok}};
}

sub cursor_chome {
	$_[0]-> cursor( 0,  0 );
#print "cursor_chome\n";

	$_[0]-> area if $_[0]-> {hiliteBlok_modified} && @{$_[0]->{hiliteBlok}};
}
#----------------------------------------------
sub cursor_cpgup
{
	my @xy = (0,0);
#print "cursor_cpgup\n";
	if ( $_[0]->{cursorYl} > $_[0]->topLine ) {
		@xy = ( $_[0]-> {cursorXl}, $_[0]->topLine );
	}
	$_[0]-> cursorLog( @xy );

	$_[0]-> area if $_[0]-> {hiliteBlok_modified} && @{$_[0]->{hiliteBlok}};
}
#----------------------------------------------
sub cursor_cpgdn
{
	my @xy = ( 0, -1 );
#print "cursor_cpgdn\n";
	if ( $_[0]->{cursorYl} < $_[0]->topLine + $_[0]->{rows} - 1 ) {
		@xy = ( $_[0]-> {cursorXl}, $_[0]->topLine + $_[0]->{rows} - 1 );
	}
	$_[0]-> cursorLog( @xy );

	$_[0]-> area if $_[0]-> {hiliteBlok_modified} && @{$_[0]->{hiliteBlok}};

#	my $cy = $_[0]->{cursorYl} == $_[0]->topLine + $_[0]->{rows} - 1 ? 0 : $_[0]->topLine + $_[0]->{rows};
#	$_[0]-> cursorLog( $_[0]-> {cursorXl}, $cy - 1 );
}
#----------------------------------------------
sub cursor_pgup
{
	my $d = $_[1] || 1;
	my $i;
	my @xy = $_[0]->cursor;
	for ( $i = 0; $i < $d; $i++) {
		my ( $tl, $r) = ($_[0]-> topLine , $_[0]-> {rows} );

		my $cy = $tl - $r;

		$_[0]-> cursorLog( $_[0]-> {cursorXl}, $cy < 0 ? 0 : $cy);
		$_[0]-> cursorLog( $_[0]-> {cursorXl}, $xy[1] < $r ? 0 : $xy[1] - $r  );

		$_[0]-> area( $_[0]->{topLine}, $_[0]->{rows} ) if $_[0]-> {hiliteBlok_modified} && @{$_[0]->{hiliteBlok}};
	}
}
#----------------------------------------------

sub cursor_pgdn  {
	my $d = $_[1] || 1;
	my $i;
	my @xy = $_[0]->cursor;
	for ( $i = 0; $i < $d; $i++) {
		my ( $tl, $r) = ($_[0]-> topLine , $_[0]-> {rows} - 1);

		my $cy = $tl + 2*$r + 1;

		$_[0]-> cursorLog( $_[0]-> {cursorXl}, $cy);
		$_[0]-> cursorLog( $_[0]-> {cursorXl}, $xy[1] + $r + 1 );

		$_[0]-> area( $_[0]->{topLine}, $_[0]->{rows} ) if $_[0]-> {hiliteBlok_modified} && @{$_[0]->{hiliteBlok}};
	}
}

##############################################
##############################################

sub word_right
{
	my $self = $_[0];
	my $d = $_[1] || 1;
	my $i;
	for ( $i = 0; $i < $d; $i++) {
		my ( $x, $y, $w, $delta, $maxY) = (

			$self-> cursorX, $self-> cursorY,

			$self-> wordDelimiters, 0, $self-> {maxLine}
		);
		my $line  = $self-> get_line( $y);
		my $clen  = length( $line);
		if ($self-> {cursorWrap}) {
			while ( $x >= $clen) {
				$y++;
				return if $y > $maxY;
				$x = 0;
				$line = $self-> get_line( $y);
				$clen = length( $line);
			}
		}
		my $cl = $x - $clen + 1;
		$line .= ' 'x$cl if $cl >= 0;
		unless ($w =~ quotemeta substr $line, $x, 1) {
			$delta++ while ( $w !~ quotemeta substr $line, $x + $delta, 1) &&
				$x + $delta < $clen;
		}
		if ( $x + $delta < $clen) {
			$delta++ while ( $w =~ quotemeta substr $line, $x + $delta, 1) &&
				$x + $delta < $clen;
		}
		$self-> cursor( $x + $delta, $y);
	}
}

sub word_left
{
	my $self = $_[0];
	my $d = $_[1] || 1;
	my $i;
	for ( $i= 0;$i<$d; $i++) {
		my ( $x, $y, $w, $delta) =
			( $self-> cursorX, $self-> cursorY, $self-> wordDelimiters, 0);
		my $line = $self-> get_line( $y);
		my $clen = length( $line);
		if ($self-> {cursorWrap}) {
			while ( $x == 0) {
				$y--;
				$y = 0, last if $y < 0;
				$line = $self-> get_line( $y);
				$x = $clen = length( $line);
			}
		}
		my $cl = $x - $clen + 1;
		$line .= ' 'x$cl if $cl >= 0;
		if ( $w =~ quotemeta( substr( $line, $x - 1, 1)))
		{
			$delta-- while (( $w =~ quotemeta( substr( $line, $x + $delta - 1, 1))) &&
				( $x + $delta > 0))
		}
		if ( $x + $delta > 0)
		{
			$delta-- while (!( $w =~ quotemeta( substr( $line, $x + $delta - 1, 1))) &&
				( $x + $delta > 0))
		}
		$self-> cursor( $x + $delta, $y);
	}
}

sub cursor_shift_key
{
	my ( $self, $menuItem) = @_;
	$self-> begin_undo_group;
	$self-> start_block unless exists $self-> {anchor};
	$menuItem =~ s/Shift//;
	my $action = $self-> accelTable-> action( $menuItem);
	$action = $self-> can( $action, 0) unless ref $action;
	$self-> {delayPanning} = 1;
	$self-> blockShiftMark(1);
	$action-> ( @_);
	$self-> blockShiftMark(0);
	$self-> selection( @{$self-> {anchor}}, $self-> {cursorX}, $self-> {cursorY});
	$self-> realize_panning;
	$self-> end_undo_group;
}

sub blockShiftMark
{
	return $_[0]-> {blockShiftMark} unless $#_;
	my ( $self, $mark) = @_;
	return if $self-> {blockShiftMark} == $mark;
	$self-> push_group_undo_action( 'blockShiftMark', $self-> {blockShiftMark});

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

		$self-> update_block;
		delete $self-> {restorePersistentBlock}, $self-> persistentBlock(0)

			if $self-> {restorePersistentBlock};
	} else {
		$self-> blockType( bt::Vertical);
		$self-> {restorePersistentBlock} = 1

			unless $self-> persistentBlock;
		$self-> persistentBlock( 1);
		$self-> cursor_shift_key(q(ShiftCursorRight));
	}
}

sub mark_horizontal
{
	my $self = $_[0];
	if ( exists $self-> {anchor})
	{
		$self-> update_block;
		delete $self-> {restorePersistentBlock}, $self-> persistentBlock(0)

			if $self-> {restorePersistentBlock};
	} else {
		$self-> blockType( bt::Horizontal);
		$self-> {restorePersistentBlock} = 1 unless $self-> persistentBlock;
		$self-> persistentBlock( 1);
		$self-> start_block;
		$self-> selection(

			$self-> make_physical( 0, $self-> {cursorYl}),
			$self-> make_physical( -1, $self-> {cursorYl})
		);
	}
}

sub set_line
{
	my ( $self, $y, $line, $operation, $from, $len) = @_;
	my $maxY = $self-> {maxLine};
	$self-> insert_empty_line(0), $y = $maxY = $self-> {maxLine} if $maxY < 0;
	return if $y > $maxY || $y < 0;

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


	if ( defined $_to)
	{
		$self-> invalidate_rect(
			$a[0], $a[3] - $fh * ( $_to - $tl + 1),
			$a[2], $a[3] - $fh * ( $_from - $tl)
		);
	} else {
		$self-> repaint;
	}
	$self-> cursor( $self-> cursor);
	$self-> end_undo_group;
	$self-> notify(q(Change)) unless $self-> {notifyChangeLock};

}

sub insert_empty_line
{
	my ( $self, $y, $len) = @_;
	my $maxY = $self-> {maxLine};
	$len ||= 1;

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

				}
				$self-> {hScrollBar}-> set(
					max      => $lw - $w,
					whole    => $lw,
					partial  => $w,
				) if $self-> {hScroll};
				last;
			}
		}
	}
	$self-> cursor( $self-> cursor);
	$self-> end_undo_group;
	$self-> repaint;
	$self-> notify(q(Change)) unless $self-> {notifyChangeLock};
}

sub delete_chunk
{
	my ( $self, $y, $len) = @_;
	my $maxY = $self-> {maxChunk};
	$len ||= 1;

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

		$self-> set_line( $psy, $c, q(delete), $start, $cs);
		$sy++;
	}
	$c  = $self-> {lines}-> [$pey];
	if ( $end < length( $c)) {
		substr( $c, 0, $end) = '';
		$self-> set_line( $pey, $c, q(delete), 0,  $end);
		$ey--;
	}
	$self-> delete_line( $sy, $ey - $sy + 1) if $ey >= $sy;
	$self-> cursor( $self-> {cursorX}, $psy);
	$self-> unlock;
	$self-> lock_change(0);
	$self-> end_undo_group;
}

sub delete_text
{
	my ( $self, $x, $y, $len) = @_;
	my $maxY = $self-> {maxLine};
	$y = $maxY if $y < 0;

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

	}
	$len = $l - $x if $len + $x >= $l;
	return if $len <= 0;
	substr( $c, $x, $len) = '';
	$self-> set_line( $y, $c, q(delete), $x, $len);
}

sub delete_char
{
	my $self = $_[0];
	$self-> delete_text( $self-> cursor, $_[1] || 1);
}

sub back_char
{
	my $self = $_[0];

{#wb
	if ( $self-> has_selection ) {
		$self-> delete_block;
		return;
	}
}

	my @c = $self-> cursor;
	my $d = $_[1] || 1;

	$self-> begin_undo_group;
	if ( $c[0] >= $d) {
		$self-> delete_text( $c[0] - $d, $c[1], $d);
		$self-> cursorX( $c[0] - $d);
	} elsif ( $c[1] > 0) {
		$self-> cursor( -1, $c[1] - 1);
		$self-> delete_text( -1, $c[1] - 1);
	}
	$self-> end_undo_group;
}

sub delete_current_chunk
{
	my $self = $_[0];
	$self-> delete_chunk( $self-> {cursorYl});
}

sub delete_to_end
{
	my $self = $_[0];
	my @cs = $self-> cursor;
	my $c = $self-> get_line( $cs[1]);
	return if $cs[ 0] > length( $c);

	$self-> set_line( $cs[1], substr( $c, 0, $cs[0]), q(delete), $cs[0], length( $c) - $cs[0]);
}

sub delete_block
{
	my $self = $_[0];
	return unless $self-> has_selection;

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

			my $c = $self-> get_line( $i);
			if ( $c ne '') {
				substr( $c, $sel[0], $len) = '';
				$self-> set_line( $i, $c);
			}
		}
		$self-> unlock;
		$self-> lock_change(0);
	}

	$self-> cursorLog( $sel[0], $sel[1]);
	$self-> cancel_block;
	$self-> end_undo_group;
}

sub copy_block
{
	my $self = $_[0];
	return if

		$self-> {readOnly} ||

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

	$self-> lock_change(0);
	$self-> lock;
	$self-> begin_undo_group;
	if ( $self-> {blockType} == bt::Horizontal) {
		my @lines;
		my $i;
		for ( $i = $sel[1]; $i <= $sel[3]; $i++) {

			push @lines, $self-> get_line( $i);
		}
		$self-> insert_line( $self-> cursorY, @lines);
	} else {
		my @lines;
		my $i;
		for ( $i = $sel[1]; $i <= $sel[3]; $i++) {
			my $c = $self-> get_line( $i);
			$c .= ' ' x ($sel[2]-length($c))

				if length($c) < $sel[2];
			push( @lines, substr( $c, $sel[0], $sel[2]-$sel[0]));
		}
		my @cs = $self-> cursor;
		for ( $i = $cs[1]; $i < $cs[1] + scalar @lines; $i++) {
			my $c = $self-> get_line( $i);
			$c .= ' 'x($cs[0]-length($c)) if length($c) < $cs[0];
			substr( $c, $cs[0], 0) = $lines[ $i - $cs[1]];
			$self-> set_line( $i, $c);
		}
	}
	$self-> end_undo_group;
	$self-> unlock;
	$self-> lock_change(1);

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

			$self-> set_line( $i, $self-> get_line( $i));
		}
	} else {
		my @lines;
		my $i;
		for ( $i = $sel[1]; $i <= $sel[3]; $i++) {
			my $c = $self-> get_line( $i);
			$c .= ' ' x ($sel[2]-length($c)) if length($c) < $sel[2];
			push( @lines, substr( $c, $sel[0], $sel[2]-$sel[0]));
		}
		my @cs = $self-> cursor;
		my $bx = $sel[3] - $sel[1] + 1;
		for ( $i = $cs[1]; $i < $cs[1] + scalar @lines; $i++) {
			my $c = $self-> get_line( $i);
			$c .= ' ' x ($cs[0]-length($c))

				if length($c) < $cs[0];
			substr( $c, $cs[0], $bx) = $lines[ $i - $cs[1]];
			$self-> set_line( $i, $c);
		}
	}
	$self-> end_undo_group;
	$self-> unlock;
	$self-> lock_change(1);
}

sub split_line
{
	my $self = $_[0];
	my @cs = $self-> cursor;
	my $c = $self-> get_line( $cs[1]);
	$c .= ' 'x($cs[0]-length($c)) if length($c) < $cs[0];
	my ( $old, $new) = ( substr( $c, 0, $cs[0]), substr( $c, $cs[0], length( $c) - $cs[0]));
	$self-> lock_change(1);
	$self-> begin_undo_group;
	$self-> set_line( $cs[1], $old, q(delete), $cs[0], length( $c) - $cs[0]);
	my $cshift = 0;
	if ( $self-> {autoIndent}) {
		my $i = 0;
		my $add = '';
		for ( $i = 0; $i < length( $old); $i++) {
			my $c = substr( $old, $i, 1);
			last if $c ne ' ' and $c ne '\t';
			$add .= $c;
		}
		$new = $add.$new, $cshift = length( $add)

			if length( $add) < length( $old);
	}
	$self-> insert_line( $cs[1]+1, $new);
	$self-> cursor( $cshift, $cs[1] + 1);
	$self-> end_undo_group;
	$self-> lock_change(0);
}

sub begin_undo_group

{

	my $self = $_[0];
	return if !$self-> {undoLimit};

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

{
	my ( $self, $index) = @_;
	return if $index > scalar @{$self-> {markers}};
	splice( @{$self-> {markers}}, $index, 1);
}

sub select_all { $_[0]-> selection(0,0,-1,-1); }

sub autoIndent      {($#_)?($_[0]-> {autoIndent}    = $_[1])                :return $_[0]-> {autoIndent }  }
sub blockType       {($#_)?($_[0]-> set_block_type  ( $_[1]))               :return $_[0]-> {blockType}    }
sub cursor          {($#_)?($_[0]-> set_cursor    ($_[1],$_[2]))            :return $_[0]-> {cursorX},$_[0]-> {cursorY}}
sub cursorLog       {($#_)?($_[0]-> set_cursor    ($_[0]-> make_physical($_[1],$_[2])))            :return $_[0]-> {cursorXl},$_[0]-> {cursorYl}}
sub cursorX         {($#_)?($_[0]-> set_cursor    ($_[1],$_[0]-> {cursorY})):return $_[0]-> {cursorX}    }
sub cursorY         {($#_)?($_[0]-> set_cursor    ($_[0]-> {q(cursorX)},$_[1])):return $_[0]-> {cursorY}    }
sub cursorWrap      {($#_)?($_[0]-> {cursorWrap     }=$_[1])                :return $_[0]-> {cursorWrap     }}
sub topLine         {($#_)?($_[0]-> set_top_line (   $_[1]))               :return $_[0]-> {topLine }    }
sub hiliteNumbers   {($#_)?$_[0]-> set_hilite_numbers ($_[1])               :return $_[0]-> {hiliteNumbers} }
sub hiliteQStrings  {($#_)?$_[0]-> set_hilite_q_strings($_[1])              :return $_[0]-> {hiliteQStrings} }
sub hiliteQQStrings {($#_)?$_[0]-> set_hilite_qq_strings($_[1])             :return $_[0]-> {hiliteQQStrings} }
sub hiliteChars     {($#_)?$_[0]-> set_hilite_chars     ($_[1])             :return $_[0]-> {hiliteChars    } }
sub hiliteIDs       {($#_)?$_[0]-> set_hilite_ids       ($_[1])             :return $_[0]-> {hiliteIDs      } }
sub hiliteREs       {($#_)?$_[0]-> set_hilite_res       ($_[1])             :return $_[0]-> {hiliteREs      } }
sub insertMode      {($#_)?($_[0]-> set_insert_mode  (    $_[1]))           :return $_[0]-> {insertMode}   }
sub mark            {($#_)?(shift-> set_marking  (    @_   ))               :return exists $_[0]-> {anchor}  }
sub markers         {($#_)?($_[0]-> {markers}    = [@{$_[1]}])              :return $_[0]-> {markers  }    }

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

		vScroll			=>	1,
		tabIndent		=>	4,
		syntaxHilite	=>	1,
		hiliteREs		=>	$::hilite{"rexp_$type"},
		hiliteCase		=>	$::hilite{"case_$type"},
		hiliteStyl		=>	$::hilite{"styl_$type"},
		hiliteBlok		=>	$::hilite{"blok_$type"},
		exportHTML		=>	0,
		backColor		=>	$self->{global}->{GLOBAL}{editor_backColor},
		borderWidth		=>	0,
		cursorWrap		=>	1,
		scope			=>	fds::Cursor,
		lineSpace		=>	$self->{global}->{GLOBAL}{editor_lineSpace},
		wheelRows		=>	5,
		place => {
			x => 33,	relx => 0.5,	width  =>-66,	relwidth  => 1,
			y => 0,		rely => 0.5,	height =>0,		relheight => 1,
		},
		font => {
			name	=>	$self->{global}->{GLOBAL}{editor_fontName},
			$type_dimen	=>	$font_dimen,

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

	my @scope;
	FIND:{
		if ( $$p{scope} != fds::Cursor) {
			if ( $e-> has_selection) {
				my @sel = $e-> selection;
				@scope = ($$p{scope} == fds::Top) ? ($sel[0],$sel[1]) : ($sel[2], $sel[3]);
			} else {
				@scope = ($$p{scope} == fds::Top) ? (0,0) : (-1,-1);
			}
		} else {
			@scope = $e-> cursor;
		}
		my @n = $e-> find( $$p{findText}, @scope, $$p{replaceText}, $$p{options});
		if ( !defined $n[0]) {
			Prima::MsgBox::message( "No more matches found!" , mb::NoSound | mb::Information );
			return;
		}
		$e-> cursor(($$p{options} & fdo::BackwardSearch) ? $n[0] : $n[0] + $n[2], $n[1]);
		$e-> selection( $n[0], $n[1], $n[0] + $n[2], $n[1]);
		unless ( $$p{asFind}) {
			if ( $$p{options} & fdo::ReplacePrompt) {
				my $r = Prima::MsgBox::message_box( "Replace...","Replace text '$$p{findText}'?", mb::YesNoCancel|mb::Information|mb::NoSound);
#				my $r = Prima::MsgBox::message_box( $e-> text,
#				"Replace this text?",
#				mb::YesNoCancel|mb::Information|mb::NoSound);
				redo FIND if ($r == mb::No) && ($$p{result} == mb::ChangeAll);
				last FIND if $r == mb::Cancel;
			}



( run in 0.246 second using v1.01-cache-2.11-cpan-4d50c553e7e )