view release on metacpan or  search on metacpan

Prima/InputLine.pm  view on Meta::CPAN

#  Created by Dmitry Karasik <dk@plab.ku.dk>
#  Modifications by Anton Berezin <tobez@tobez.org>
package Prima::InputLine;
use strict;
use warnings;
use Prima;
use Prima::Drawable::Glyphs;
use base qw(Prima::Widget Prima::Widget::MouseScroller Prima::Widget::UndoActions Prima::Widget::BidiInput);

{
my %RNT = (
	%{Prima::Dialog-> notification_types()},
	Validate => nt::Notification,
);

sub notification_types { return \%RNT; }
}

sub profile_default
{
	my %def = %{$_[ 0]-> SUPER::profile_default};
	my $font = $_[ 0]-> get_default_font;
	my $rtl  = $::application-> textDirection;
	return {
		%def,
		alignment      => $rtl ? ta::Right : ta::Left,
		autoHeight     => 1,
		autoSelect     => 1,
		autoTab        => 0,
		borderWidth    => 2,
		charOffset     => 0,
		cursorVisible  => 1,
		cursorSize     => [ Prima::Application-> get_default_cursor_width, $font-> { height}],
		firstChar      => 0,
		dndAware       => 'Text',
		height         => 4 + $font-> { height} + 2,
		insertMode     => 0,
		maxLen         => 256,  # length $def{ text},
		passwordChar   => '*',
		pointerType    => cr::Text,
		popupItems     => [
			[ cut        => 'Cu~t'        => 'cut'       ],
			[ copy       => '~Copy'       => 'copy'      ],
			[ paste      => '~Paste'      => 'paste'     ],
			[ delete     => '~Delete'     => 'delete'    ],
			[],
			[select_all  => 'Select ~All' => 'select_all'],
			[undo        => '~Undo', 'Ctrl+Z', '^Z', 'undo'],
			[redo        => 'R~edo', 'Ctrl+Y', '^Y', 'redo'],
			['@rtl'      => '~RTL input', 'Ctrl+Shift+D', '^#D', 'toggle_rtl'],
			['@ligation' => '~Ligation', 'Ctrl+Shift+L', '^#L', 'toggle_ligation'],
		],
		readOnly       => 0,
		selection      => [0, 0],
		selStart       => 0,
		selEnd         => 0,
		selectable     => 1,
		textDirection  => $rtl,
		textLigation   => 1,
		undoLimit      => 10,
		widgetClass    => wc::InputLine,
		width          => 96,
		wordDelimiters => ".()\"',#$@!%^&*{}[]?/|;:<>-= \t",
		writeOnly      => 0,
	}
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;
	$p-> {autoHeight} = 0
		if exists $p-> {height} || exists $p-> {size} || exists $p-> {rect} || ( exists $p-> {top} && exists $p-> {bottom});
	$p-> {alignment} = ( $p->{textDirection} // $default->{textDirection} ) ?
		ta::Right : ta::Left unless exists $p->{alignment};
	$self-> SUPER::profile_check_in( $p, $default);
	@{$p}{qw(selStart selEnd)} = @{$p-> {selection}} if exists( $p-> { selection});
}

sub init
{
	my $self = shift;

	for ( qw(
		borderWidth passwordChar maxLen alignment autoTab autoSelect
		firstChar charOffset readOnly textLigation))
		{ $self-> {$_} = 1; }
	for ( qw( selStart selEnd atDrawX autoHeight undoLimit n_clusters))
		{ $self-> {$_} = 0;}
	$self-> { insertMode}   = $::application-> insertMode;
	$self-> { maxLen}   = -1;
	$self-> {writeOnly} = 0;
	$self-> {defcw} = $::application-> get_default_cursor_width;
	$self-> {resetDisabled} = 1;

	my %profile = $self-> SUPER::init(@_);
	$self->init_undo(\%profile);

	for ( qw(
		textDirection textLigation
		writeOnly borderWidth passwordChar maxLen alignment
		autoTab autoSelect readOnly selEnd selStart charOffset

Prima/InputLine.pm  view on Meta::CPAN

		$self-> clear_event;
		return;
	}

	if ($code == ord("\cC")) {
		$self-> copy if $p_start != $p_end;
		$self-> clear_event;
		return;
	} elsif ($code == ord("\cA")) {
		$self-> select_all;
		$self-> clear_event;
		return;
	} elsif ($code == ord("\cV")) {
		$self-> push_group_undo_action('text', $self->text);
		$self-> paste;
		$self-> clear_event;
		return;
	} elsif ($code == ord("\cX")) {
		if ( !$self-> {readOnly} && $p_start != $p_end) {
			my $del;
			$del = substr( $cap, $p_start, $p_end - $p_start);
			substr( $cap, $p_start, $p_end - $p_start) = '';
			$self-> begin_undo_group;
			$self-> set_selection(0,0);
			$self-> edit_text( $cap);
			$self-> charOffset( $start);
			$self-> end_undo_group;
			$::application-> Clipboard-> text( $del);
		}
		$self-> clear_event;
		return;
	}

# typing part
	if  (
		!$self-> {readOnly} &&
		( $code >= ord(' ')) &&
		(( $mod  & (km::Alt | km::Ctrl)) == 0) &&
		(( $key == kb::NoKey) || ( $key == kb::Space))
	) {
		my $chr = chr $code;
		$self-> begin_undo_group;
		utf8::upgrade($chr) if $is_unicode;
		my ($curpos, $advance);
		if ( $p_start != $p_end) {
			substr( $cap, $p_start, $p_end - $p_start) = '';
			$self-> charOffset($self->{glyphs}->index2cluster($p_start));
			$self-> edit_text( $cap);
			local $self->{insertMode} = 1;
			$self-> handle_input($chr);
		} else {
			$self-> handle_input($chr);
		}
		$self-> selection(0,0);
		$self-> clear_event;
		$self-> end_undo_group;
		return;
	}
}

sub on_popup
{
	my $self = $_[0];
	my $p    = $self-> popup;

	my $sel = $self-> {selStart} != $self-> {selEnd};

	my $c    = $::application-> Clipboard;
	$c-> open;
	my $clip = $c-> format_exists('Text');
	$c-> close;

	$p-> enabled( 'copy',         $sel && not($self-> {writeOnly}));
	$p-> enabled( 'cut',          $sel && not($self-> {writeOnly}));
	$p-> enabled( 'delete',       $sel);
	$p-> enabled( 'paste',        $clip);
	$p-> enabled( 'select_all',   $self->{n_clusters} > 0);
	$p-> enabled( 'undo',         $self->can_undo );
	$p-> enabled( 'redo',         $self->can_redo );
	$p-> checked( 'rtl',          $self-> textDirection );
	$p-> checked( 'ligation',     $self-> textLigation );
}

sub default_geom_height
{
	my $self = $_[0];
	return $self-> font-> height + 2 + $self-> {borderWidth} * 2;
}

sub check_auto_size
{
	my $self = $_[0];
	$self-> geomHeight( $self-> default_geom_height )
		if $self-> {autoHeight};
}

sub copy
{
	my $self = $_[0];
	my ( $start, $end) = $self-> selection_strpos;
	return if $start == $end;
	return if $self-> {writeOnly};

	my $cap = $self-> text;
	$::application-> Clipboard-> text( substr( $cap, $start, $end - $start));
}

sub toggle_rtl
{	
	my ( $self, $menu, $value ) = @_;
	$self-> textDirection($value);
}

sub toggle_ligation
{	
	my ( $self, $menu, $value ) = @_;
	$self-> textLigation($value);
}

sub paste
{
	my $self = $_[0];
	return if $self-> {readOnly};
	my $cap = $self-> text;