summaryrefslogtreecommitdiffstats
path: root/src/perl/searchable-scrollback
diff options
context:
space:
mode:
Diffstat (limited to 'src/perl/searchable-scrollback')
-rw-r--r--src/perl/searchable-scrollback258
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
+}
+
+