src/perl/searchable-scrollback

   1 #! perl
   2
   3 # this extension implements scrollback buffer search
   4
   5 sub on_init {
   6    my ($self) = @_;
   7
   8    my $hotkey = $self->{argv}[0]
   9                 || $self->x_resource ("searchable-scrollback")
  10                 || "M-s";
  11
  12    $self->parse_keysym ($hotkey, "perl:searchable-scrollback:start")
  13       or warn "unable to register '$hotkey' as scrollback search start hotkey\n";
  14
  15    ()
  16 }
  17
  18 sub on_user_command {
  19    my ($self, $cmd) = @_;
  20
  21    $cmd eq "searchable-scrollback:start"
  22       and $self->enter;
  23
  24    ()
  25 }
  26
  27 sub msg {
  28    my ($self, $msg) = @_;
  29
  30    $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
  31    $self->{overlay}->set (0, 0, $self->special_encode ($msg));
  32 }
  33
  34 sub enter {
  35    my ($self) = @_;
  36
  37    return if $self->{overlay};
  38
  39    $self->{view_start} = $self->view_start;
  40    $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EVENT_NONE);
  41    $self->{row} = $self->nrow - 1;
  42    $self->{search} = "(?i)";
  43
  44    $self->enable (
  45       key_press     => \&key_press,
  46       tt_write      => \&tt_write,
  47       refresh_begin => \&refresh,
  48       refresh_end   => \&refresh,
  49    );
  50
  51    $self->{manpage_overlay} = $self->overlay (0, -2, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
  52    $self->{manpage_overlay}->set (0, 0, "scrollback search, see the ${urxvt::RXVTNAME}perl manpage for details");
  53
  54    $self->idle;
  55 }
  56
  57 sub leave {
  58    my ($self) = @_;
  59
  60    $self->disable ("key_press", "tt_write", "refresh_begin", "refresh_end");
  61    $self->pty_ev_events ($self->{pty_ev_events});
  62
  63    delete $self->{manpage_overlay};
  64    delete $self->{overlay};
  65    delete $self->{history};
  66    delete $self->{search};
  67 }
  68
  69 sub idle {
  70    my ($self) = @_;
  71
  72    $self->msg ("(escape cancels) /$self->{search}█");
  73 }
  74
  75 sub search {
  76    my ($self, $dir) = @_;
  77
  78    delete $self->{found};
  79    my $row = $self->{row};
  80
  81    my $search = $self->special_encode ($self->{search});
  82
  83    no re 'eval'; # just to be sure
  84    if (my $re = eval { qr/$search/ }) {
  85       while ($self->nrow > $row && $row > $self->top_row) {
  86          my $line = $self->line ($row)
  87             or last;
  88
  89          my $text = $line->t;
  90          if ($text =~ /$re/g) {
  91             do {
  92                push @{ $self->{found} }, [$line->coord_of ($-[0]), $line->coord_of ($+[0])];
  93             } while $text =~ /$re/g;
  94
  95             $self->{row} = $row;
  96             $self->view_start (List::Util::min 0, $row - ($self->nrow >> 1));
  97             $self->want_refresh;
  98             last;
  99          }
 100
 101          $row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
 102       }
 103    }
 104
 105    $self->scr_bell unless $self->{found};
 106 }
 107
 108 sub refresh {
 109    my ($self) = @_;
 110
 111    return unless $self->{found};
 112
 113    my $xor = urxvt::RS_RVid | urxvt::RS_Blink;
 114    for (@{ $self->{found} }) {
 115       $self->scr_xor_span (@$_, $xor);
 116       $xor = urxvt::RS_RVid;
 117    }
 118
 119    ()
 120 }
 121
 122 sub key_press {
 123    my ($self, $event, $keysym, $string) =  @_;
 124
 125    delete $self->{manpage_overlay};
 126
 127    if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter
 128       if ($self->{found} && $event->{state} & urxvt::ShiftMask) {
 129          my ($br, $bc, $er, $ec) = @{ $self->{found}[0] };
 130          $self->selection_beg ($br, $bc);
 131          $self->selection_end ($er, $ec);
 132          $self->selection_make ($event->{time});
 133       }
 134       $self->leave;
 135    } elsif ($keysym == 0xff1b) { # escape
 136       $self->view_start ($self->{view_start});
 137       $self->leave;
 138    } elsif ($keysym == 0xff57) { # end
 139       $self->{row} = $self->nrow - 1;
 140       $self->view_start (0);
 141    } elsif ($keysym == 0xff52) { # up
 142       $self->{row}-- if $self->{row} > $self->top_row;
 143       $self->search (-1);
 144    } elsif ($keysym == 0xff54) { # down
 145       $self->{row}++ if $self->{row} < $self->nrow;
 146       $self->search (+1);
 147    } elsif ($keysym == 0xff08) { # backspace
 148       substr $self->{search}, -1, 1, "";
 149       $self->search;
 150       $self->idle;
 151    } elsif ($string !~ /[\x00-\x1f\x80-\xaf]/) {
 152       return; # pass to tt_write
 153    }
 154
 155    1
 156 }
 157
 158 sub tt_write {
 159    my ($self, $data) = @_;
 160
 161    $self->{search} .= $self->locale_decode ($data);
 162
 163    $self->{search} =~ s/^\(\?i\)//
 164       if $self->{search} =~ /^\(.*[[:upper:]]/;
 165
 166    $self->search (-1);
 167    $self->idle;
 168
 169    1
 170 }
 171
 172