diff options
Diffstat (limited to 'src/perl/searchable-scrollback')
| -rw-r--r-- | src/perl/searchable-scrollback | 258 |
1 files changed, 258 insertions, 0 deletions
diff --git a/src/perl/searchable-scrollback b/src/perl/searchable-scrollback new file mode 100644 index 0000000..7c94490 --- /dev/null +++ b/src/perl/searchable-scrollback @@ -0,0 +1,258 @@ +#! perl + +# this extension implements scrollback buffer search + +#:META:RESOURCE:%:string:activation hotkey keysym + +=head1 NAME + +searchable-scrollback - incremental scrollback search (enabled by default) + +=head1 DESCRIPTION + +Adds regex search functionality to the scrollback buffer, triggered by +the C<searchable-scrollback:start> action (bound to C<M-s> by +default). While in search mode, normal terminal input/output is +suspended and a regex is displayed at the bottom of the screen. + +Inputting characters appends them to the regex and continues incremental +search. In addition, the following bindings are recognized: + +=over 4 + +=item C<BackSpace> + +Remove a character from the regex. + +=item C<Insert> + +Append the value of the PRIMARY selection to the regex. + +=item C<Up> + +Search for a match upwards. + +=item C<Down> + +Search for a match downwards. + +=item C<Prior> + +Scroll up. + +=item C<Next> + +Scroll down. + +=item C<End> + +Scroll to the bottom. + +=item C<Escape> + +Leave the mode and return to the point where search was started. + +=item C<Enter> or C<Return> + +Leave the mode maintaining the current position in the scrollback. +Additionally, if the C<Shift> modifier is active, store the first +match in the current line into the primary selection. + +=back + +The regex defaults to "(?i)", resulting in a case-insensitive search. To +get a case-sensitive search you can delete this prefix using C<BackSpace> +or simply use an uppercase character which removes the "(?i)" prefix. + +See L<perlre> for more info about perl regular expression syntax. + +=cut + +sub on_init { + my ($self) = @_; + + # only for backwards compatibility + my $hotkey = $self->{argv}[0] + || $self->x_resource ("%") + || "M-s"; + + $self->bind_action ($hotkey, "%:start") + or warn "unable to register '$hotkey' as scrollback search start hotkey\n"; + + () +} + +sub on_user_command { + my ($self, $cmd) = @_; + + $cmd eq "searchable-scrollback:start" + and $self->enter; + + () +} + +sub on_action { + my ($self, $action) = @_; + + $action eq "start" + and $self->enter; + + () +} + +sub msg { + my ($self, $msg) = @_; + + $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0); + $self->{overlay}->set (0, 0, $self->special_encode ($msg)); +} + +sub enter { + my ($self) = @_; + + return if $self->{overlay}; + + $self->{view_start} = $self->view_start; + $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE); + $self->{row} = $self->nrow - 1; + $self->{search} = "(?i)"; + + $self->enable ( + key_press => \&key_press, + tt_write => \&tt_write, + refresh_begin => \&refresh, + refresh_end => \&refresh, + ); + + $self->{manpage_overlay} = $self->overlay (0, -2, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0); + $self->{manpage_overlay}->set (0, 0, "scrollback search, see the ${urxvt::RXVTNAME}perl manpage for details"); + + $self->idle; +} + +sub leave { + my ($self) = @_; + + $self->disable ("key_press", "tt_write", "refresh_begin", "refresh_end"); + $self->pty_ev_events ($self->{pty_ev_events}); + + delete $self->{manpage_overlay}; + delete $self->{overlay}; + delete $self->{search}; + delete $self->{found}; +} + +sub idle { + my ($self) = @_; + + $self->msg ("(escape cancels) /$self->{search}█"); +} + +sub search { + my ($self, $dir, $row) = @_; + + my $search = $self->special_encode ($self->{search}); + + no re 'eval'; # just to be sure + if (my $re = eval { qr/$search/ }) { + while ($self->nrow > $row && $row >= $self->top_row) { + my $line = $self->line ($row) + or last; + + my $text = $line->t; + if ($text =~ /$re/g) { + delete $self->{found}; + + do { + push @{ $self->{found} }, [$line->coord_of ($-[0]), $line->coord_of ($+[0])]; + } while $text =~ /$re/g; + + $self->{row} = $row; + $self->view_start (List::Util::min 0, $row - ($self->nrow >> 1)); + $self->want_refresh; + return; + } + + $row = $dir < 0 ? $line->beg - 1 : $line->end + 1; + } + } + + $self->scr_bell; +} + +sub refresh { + my ($self) = @_; + + return unless $self->{found}; + + my $xor = urxvt::RS_RVid | urxvt::RS_Blink; + for (@{ $self->{found} }) { + $self->scr_xor_span (@$_, $xor); + $xor = urxvt::RS_RVid; + } + + () +} + +sub key_press { + my ($self, $event, $keysym, $string) = @_; + + delete $self->{manpage_overlay}; + + if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter + if ($self->{found} && $event->{state} & urxvt::ShiftMask) { + my ($br, $bc, $er, $ec) = @{ $self->{found}[0] }; + $self->selection_beg ($br, $bc); + $self->selection_end ($er, $ec); + $self->selection_make ($event->{time}); + } + $self->leave; + } elsif ($keysym == 0xff1b) { # escape + $self->view_start ($self->{view_start}); + $self->leave; + } elsif ($keysym == 0xff57) { # end + $self->{row} = $self->nrow - 1; + $self->view_start (0); + } elsif ($keysym == 0xff52) { # up + my $line = $self->line ($self->{row}); + $self->search (-1, $line->beg - 1) + if $line->beg > $self->top_row; + } elsif ($keysym == 0xff54) { # down + my $line = $self->line ($self->{row}); + $self->search (+1, $line->end + 1) + if $line->end < $self->nrow; + } elsif ($keysym == 0xff55) { # prior + my $row = $self->view_start - ($self->nrow - 1); + $self->view_start (List::Util::min 0, $row); + } elsif ($keysym == 0xff56) { # next + my $row = $self->view_start + ($self->nrow - 1); + $self->view_start (List::Util::min 0, $row); + } elsif ($keysym == 0xff63) { # insert + $self->selection_request (urxvt::CurrentTime, 1); + } elsif ($keysym == 0xff08) { # backspace + substr $self->{search}, -1, 1, ""; + $self->search (+1, $self->{row}); + $self->idle; + } elsif ($string !~ /[\x00-\x1f\x80-\xaf]/) { + return; # pass to tt_write + } + + 1 +} + +sub tt_write { + my ($self, $data) = @_; + + $self->{search} .= $self->locale_decode ($data); + + $self->{search} =~ s/^\(\?i\)// + if $self->{search} =~ /^\(.*[[:upper:]]/; + + delete $self->{found}; + $self->search (-1, $self->{row}); + $self->idle; + + 1 +} + + |