Alt-Tickit-Widgets-ObjectPad

 view release on metacpan or  search on metacpan

lib/Tickit/Widget/Entry.pm  view on Meta::CPAN

=item * Home or Ctrl-A

Move the cursor to the beginning of the input line

=item * Insert

Toggle between overwrite and insert mode

=item * Left

Move the cursor one character left

=item * Ctrl-Left or Alt-B

Move the cursor one word left

=item * Right

Move the cursor one character right

=item * Ctrl-Right or Alt-F

Move the cursor one word right

=back

=cut

=head1 CONSTRUCTOR

=cut

=head2 $entry = Tickit::Widget::Entry->new( %args )

Constructs a new C<Tickit::Widget::Entry> object.

Takes the following named arguments:

=over 8

=item text => STR

Optional. Initial text to display in the box

=item position => INT

Optional. Initial position of the cursor within the text.

=item on_enter => CODE

Optional. Callback function to invoke when the C<< <Enter> >> key is pressed.

=back

=cut

has $_text;
has $_pos_ch;
has $_scrolloffs_co = 0;
has $_overwrite     = 0;
has %_keybindings;
has $_on_enter;

method BUILD
{
   my %params = @_;

   $_text = defined $params{text} ? $params{text} : "";
   $_pos_ch = defined $params{position} ? $params{position} : 0;

   my $textlen = length $_text;
   $_pos_ch = $textlen if $_pos_ch > $textlen;

   # TODO: It'd be nice to get this out of Object::Pad but it's a list on a
   #   hash and thus not const
   %_keybindings = (
      'C-a' => "key_beginning_of_line",
      'C-e' => "key_end_of_line",
      'C-k' => "key_delete_line",
      'C-u' => "key_backward_delete_line",
      'C-w' => "key_backward_delete_word",

      'M-b' => "key_backward_word",
      'M-f' => "key_forward_word",

      'Backspace'   => "key_backward_delete_char",
      'C-Backspace' => "key_backward_delete_word",
      'Delete'      => "key_forward_delete_char",
      'C-Delete'    => "key_forward_delete_word",
      'End'         => "key_end_of_line",
      'Enter'       => "key_enter_line",
      'Home'        => "key_beginning_of_line",
      'Insert'      => "key_overwrite_mode",
      'Left'        => "key_backward_char",
      'C-Left'      => "key_backward_word",
      'Right'       => "key_forward_char",
      'C-Right'     => "key_forward_word",
   );

   $self->set_on_enter( $params{on_enter} ) if defined $params{on_enter};

   # Since we take keyboard input we almost certainly want to take focus here
   $self->take_focus;
}

method lines { 1 }
method cols  { 5 }

method char2col
{
   my ( $ch ) = @_;

   return scalar chars2cols $_text, $ch;
}

method pretext_width
{
   return 0 if $_scrolloffs_co == 0;
   return textwidth( $self->get_style_values( "more_left" ) );
}

method pretext_render
{
   my ( $rb ) = @_;

   $rb->text_at( 0, 0, $self->get_style_values( "more_left" ), $self->get_style_pen( "more" ) );
}

method posttext_width
{
   return 0 if textwidth( $self->text ) <= $_scrolloffs_co + $self->window->cols;
   return textwidth( $self->get_style_values( "more_right" ) );
}

method posttext_render
{

lib/Tickit/Widget/Entry.pm  view on Meta::CPAN

   my $delta_co = $insertedlen_co - $deletedlen_co;

   my $pos_co = $self->char2col( $pos_ch );
   my $pos_x  = $pos_co - $_scrolloffs_co;

   # Don't bother at all if the affected range is scrolled off the right
   return if $pos_x >= $width;

   if( $pos_x < 0 ) {
      die "TODO: text_splice before window - what to do??\n";
   }

   my $need_reprint = 0;

   # No point doing a scrollrect if there's nothing after here
   if( $delta_co != 0 and !$at_end ) {
      $win->scrollrect( 0, $pos_x, 1, $win->cols - $pos_x, 0, -$delta_co ) or
         $need_reprint = 1;
   }

   if( $need_reprint ) {
      # ICH/DCH failed; we'll have to reprint the entire rest of the line from
      # here
      $win->expose(
         Tickit::Rect->new( top => 0, left => $pos_x, lines => 1, right => $width )
      );
      return;
   }

   if( $insertedlen_co > 0 ) {
      $win->expose(
         Tickit::Rect->new( top => 0, left => $pos_x, lines => 1, cols => $insertedlen_co )
      );

      if( my $posttext_width = $self->posttext_width ) {
         $win->expose(
            Tickit::Rect->new( top => 0, left => $width - $posttext_width, lines => 1, right => $width )
         );
      }
   }

   if( $delta_co < 0 and $_scrolloffs_co + $width < textwidth $self->text ) {
      # Add extra damage to redraw the trashed posttext marker
      my $rhs_x = -$delta_co + $self->posttext_width;

      $win->expose(
         Tickit::Rect->new( top => 0, left => $width - $rhs_x, lines => 1, right => $width )
      );
   }
}

method on_key
{
   my ( $args ) = @_;

   return 0 unless $self->window->is_focused;

   my $type = $args->type;
   my $str  = $args->str;

   if( $type eq "key" and my $code = $_keybindings{$str} ) {
      $self->$code( $str );
      return 1;
   }
   if( $type eq "text" ) {
      $self->on_text( $str );
      return 1;
   }

   return 0;
}

method on_text
{
   my ( $text ) = @_;

   $self->text_splice( $_pos_ch, $_overwrite ? 1 : 0, $text );
}

method on_mouse
{
   my ( $args ) = @_;

   return unless $args->type eq "press" and $args->button == 1;

   my $pos_ch = scalar cols2chars $_text, $args->col + $_scrolloffs_co;
   $self->set_position( $pos_ch );
}

=head1 ACCESSORS

=cut

=head2 $on_enter = $entry->on_enter

=head2 $entry->set_on_enter( $on_enter )

Return or set the CODE reference to be called when the C<key_enter_line>
action is invoked; usually bound to the C<Enter> key.

 $on_enter->( $entry, $line )

=cut

method on_enter { $_on_enter }

method set_on_enter
{
   ( $_on_enter ) = @_;
}

=head2 $offset = $entry->position

Returns the current entry position, in terms of characters within the text.

=cut

method position { $_pos_ch }

=head2 $entry->set_position( $position )

Set the text entry position, moving the cursor

=cut

method set_position
{
   my ( $pos_ch ) = @_;

   $pos_ch = 0 if $pos_ch < 0;
   $pos_ch = length $_text if $pos_ch > length $_text;

   $self->reposition_cursor( $pos_ch );
}

=head1 METHODS

=cut

=head2 $entry->bind_keys( $keystr => $value, ... )

Associate methods or CODE references with keypresses. On receipt of a the key
the method or CODE reference will be invoked, being passed the stringified key
representation and the underlying C<Term::TermKey::Key> structure.

 $ret = $entry->method( $keystr, $key )
 $ret = $coderef->( $entry, $keystr, $key )

This method takes a hash of keystring/value pairs. Binding a value of C<undef>
will remove it.

=cut

method bind_keys
{
   while( @_ ) {
      my $str   = shift;
      my $value = shift;

      if( defined $value ) {
         $_keybindings{$str} = $value;
      }
      else {
         delete $_keybindings{$str};
      }
   }
}

=head1 TEXT MODEL METHODS

These methods operate on the text input buffer directly, updating the stored
text and changing the rendered display to reflect the changes. They can be
used by a program to directly manipulate the text.

=cut

=head2 $text = $entry->text

Returns the currently entered text.

=cut

method text { $_text }

=head2 $entry->set_text( $text )

Replace the text in the entry box. This completely redraws the widget's
window. It is largely provided for initialisation; for normal edits (such as
from keybindings), it is preferable to use C<text_insert>, C<text_delete> or
C<text_splice>.

=cut

method set_text
{
   my ( $text ) = @_;

   $_text = $text;
   $_pos_ch = length $text if $_pos_ch > length $text;

   $self->redraw;
}

=head2 $entry->text_insert( $text, $pos_ch )

Insert the given text at the given character position.

=cut

method text_insert
{
   my ( $text, $pos_ch ) = @_;

   $self->text_splice( $pos_ch, 0, $text );
}

=head2 $deleted = $entry->text_delete( $pos_ch, $len_ch )

Delete the given section of text. Returns the deleted text.

=cut

method text_delete
{
   my ( $pos_ch, $len_ch ) = @_;

   return $self->text_splice( $pos_ch, $len_ch, "" );
}

=head2 $deleted = $entry->text_splice( $pos_ch, $len_ch, $text )

Replace the given section of text with the given replacement. Returns the
text deleted from the section.

=cut

method text_splice
{
   my ( $pos_ch, $len_ch, $text ) = @_;

   my $textlen_ch = length($text);

   my $delta_ch = $textlen_ch - $len_ch;

   my $at_end = ( $pos_ch == length $_text );

   my $deleted = substr( $_text, $pos_ch, $len_ch, $text );

   my $new_pos_ch;

lib/Tickit/Widget/Entry.pm  view on Meta::CPAN

{
   my ( $pos, $else ) = @_;

   my $posttext = substr( $self->text, $pos );

   return $posttext =~ m/(?<=\s)\S/ ? $pos + $-[0] : $else;
}

=head2 $pos = $entry->find_eow_forward( $initial )

Search forward in the string, returning the character position of the next
end of word from the initial position. If none is found, returns the length of
the string.

=cut

method find_eow_forward
{
   my ( $pos ) = @_;

   my $posttext = substr( $self->text, $pos );

   $posttext =~ m/(?<=\S)\s|$/;
   return $pos + $-[0];
}

=head2 $pos = $entry->find_bow_backward( $initial )

Search backward in the string, returning the character position of the
previous beginning of word from the initial position. If none is found,
returns 0.

=cut

method find_bow_backward
{
   my ( $pos ) = @_;

   my $pretext = substr( $self->text, 0, $pos );

   return $pretext =~ m/.*\s(?=\S)/ ? $+[0] : 0;
}

=head2 $pos = $entry->find_eow_backward( $initial )

Search backward in the string, returning the character position of the
previous end of word from the initial position. If none is found, returns
C<undef>.

=cut

method find_eow_backward
{
   my ( $pos ) = @_;

   my $pretext = substr( $self->text, 0, $pos + 1 ); # +1 to allow if cursor is on the space

   return $pretext =~ m/.*\S(?=\s)/ ? $+[0] : undef;
}

## Key binding methods

method key_backward_char
{
   if( $_pos_ch > 0 ) {
      $self->set_position( $_pos_ch - 1 );
   }
}

method key_backward_delete_char
{
   if( $_pos_ch > 0 ) {
      $self->text_delete( $_pos_ch - 1, 1 );
   }
}

method key_backward_delete_line
{
   $self->text_delete( 0, $_pos_ch );
}

method key_backward_delete_word
{
   my $bow = $self->find_bow_backward( $_pos_ch );
   $self->text_delete( $bow, $_pos_ch - $bow );
}

method key_backward_word
{
   if( $_pos_ch > 0 ) {
      $self->set_position( $self->find_bow_backward( $_pos_ch ) );
   }
}

method key_beginning_of_line
{
   $self->set_position( 0 );
}

method key_delete_line
{
   $self->text_delete( 0, length $self->text );
}

method key_end_of_line
{
   $self->set_position( length $_text );
}

method key_enter_line
{
   my $text = $self->text;
   return unless length $text;

   $_on_enter->( $self, $text ) if $_on_enter;
}

method key_forward_char
{
   if( $_pos_ch < length $_text ) {
      $self->set_position( $_pos_ch + 1 );