[ViewVC] Annotation of: cvs/cvsroot/rxvt-unicode/src/perl/searchable-scrollback

#! perl

# this extension implements scrollback buffer search

#:META:RESOURCE:%:string:activation hotkey keysym

=head1 NAME

searchable-scrollback - incremental scrollback search

=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 ($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 ($row);
   } elsif ($keysym == 0xff56) { # next
      my $row = $self->view_start + ($self->nrow - 1);
      $self->view_start ($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/\e\[20[01]~//g;

   $self->{search} =~ s/^\(\?i\)//
      if $self->{search} =~ /^\(.*[[:upper:]]/;

   delete $self->{found};
   $self->search (-1, $self->{row});
   $self->idle;

   1
}


Revision:	1.47
Committed:	Wed Jul 14 12:39:57 2021 UTC (5 years, 2 months ago) by sf-exg
Branch:	MAIN
Changes since 1.46:	+3 -3 lines
Log Message:	Improve view_start perl method
#	User	Rev	Content
1	root	1.1	#! perl
2
3			# this extension implements scrollback buffer search
4
5	root	1.32	#:META:RESOURCE:%:string:activation hotkey keysym
6	root	1.27
7	root	1.29	=head1 NAME
8
9	root	1.46	searchable-scrollback - incremental scrollback search
10	root	1.29
11			=head1 DESCRIPTION
12
13	sf-exg	1.36	Adds regex search functionality to the scrollback buffer, triggered by
14			the C<searchable-scrollback:start> action (bound to C<M-s> by
15			default). While in search mode, normal terminal input/output is
16			suspended and a regex is displayed at the bottom of the screen.
17	root	1.29
18			Inputting characters appends them to the regex and continues incremental
19	sf-exg	1.44	search. In addition, the following bindings are recognized:
20
21			=over 4
22
23			=item C<BackSpace>
24
25			Remove a character from the regex.
26
27			=item C<Insert>
28
29			Append the value of the PRIMARY selection to the regex.
30
31			=item C<Up>
32
33			Search for a match upwards.
34
35			=item C<Down>
36
37			Search for a match downwards.
38
39			=item C<Prior>
40
41			Scroll up.
42
43			=item C<Next>
44
45			Scroll down.
46
47			=item C<End>
48
49			Scroll to the bottom.
50
51			=item C<Escape>
52
53			Leave the mode and return to the point where search was started.
54
55			=item C<Enter> or C<Return>
56
57			Leave the mode maintaining the current position in the scrollback.
58			Additionally, if the C<Shift> modifier is active, store the first
59			match in the current line into the primary selection.
60
61			=back
62	root	1.29
63			The regex defaults to "(?i)", resulting in a case-insensitive search. To
64			get a case-sensitive search you can delete this prefix using C<BackSpace>
65			or simply use an uppercase character which removes the "(?i)" prefix.
66
67			See L<perlre> for more info about perl regular expression syntax.
68
69			=cut
70
71	root	1.1	sub on_init {
72			my ($self) = @_;
73
74	root	1.33	# only for backwards compatibility
75	root	1.12	my $hotkey = $self->{argv}[0]
76	root	1.28	\|\| $self->x_resource ("%")
77	root	1.42	\|\| "M-s";
78	root	1.1
79	root	1.43	$self->bind_action ($hotkey, "%:start")
80	root	1.4	or warn "unable to register '$hotkey' as scrollback search start hotkey\n";
81	root	1.1
82			()
83			}
84
85	sf-exg	1.40	sub on_user_command {
86			my ($self, $cmd) = @_;
87
88			$cmd eq "searchable-scrollback:start"
89			and $self->enter;
90
91			()
92			}
93
94	root	1.33	sub on_action {
95			my ($self, $action) = @_;
96	root	1.1
97	root	1.33	$action eq "start"
98	root	1.8	and $self->enter;
99	root	1.1
100			()
101			}
102
103			sub msg {
104			my ($self, $msg) = @_;
105
106			$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
107			$self->{overlay}->set (0, 0, $self->special_encode ($msg));
108			}
109
110			sub enter {
111			my ($self) = @_;
112
113			return if $self->{overlay};
114
115	root	1.8	$self->{view_start} = $self->view_start;
116	root	1.24	$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
117	root	1.13	$self->{row} = $self->nrow - 1;
118	root	1.22	$self->{search} = "(?i)";
119	root	1.1
120			$self->enable (
121	root	1.2	key_press => \&key_press,
122	root	1.7	tt_write => \&tt_write,
123	root	1.2	refresh_begin => \&refresh,
124			refresh_end => \&refresh,
125	root	1.1	);
126
127	root	1.8	$self->{manpage_overlay} = $self->overlay (0, -2, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
128	root	1.11	$self->{manpage_overlay}->set (0, 0, "scrollback search, see the ${urxvt::RXVTNAME}perl manpage for details");
129	root	1.8
130	root	1.1	$self->idle;
131			}
132
133			sub leave {
134			my ($self) = @_;
135
136	root	1.7	$self->disable ("key_press", "tt_write", "refresh_begin", "refresh_end");
137	root	1.8	$self->pty_ev_events ($self->{pty_ev_events});
138	root	1.1
139	root	1.8	delete $self->{manpage_overlay};
140			delete $self->{overlay};
141	root	1.13	delete $self->{search};
142	sf-exg	1.41	delete $self->{found};
143	root	1.1	}
144
145			sub idle {
146			my ($self) = @_;
147
148	root	1.13	$self->msg ("(escape cancels) /$self->{search}█");
149	root	1.1	}
150
151			sub search {
152	sf-exg	1.37	my ($self, $dir, $row) = @_;
153	root	1.1
154	root	1.7	my $search = $self->special_encode ($self->{search});
155
156	root	1.1	no re 'eval'; # just to be sure
157	root	1.16	if (my $re = eval { qr/$search/ }) {
158	sf-exg	1.25	while ($self->nrow > $row && $row >= $self->top_row) {
159	root	1.16	my $line = $self->line ($row)
160			or last;
161
162			my $text = $line->t;
163			if ($text =~ /$re/g) {
164	sf-exg	1.38	delete $self->{found};
165
166	root	1.16	do {
167			push @{ $self->{found} }, [$line->coord_of ($-[0]), $line->coord_of ($+[0])];
168			} while $text =~ /$re/g;
169
170			$self->{row} = $row;
171	sf-exg	1.47	$self->view_start ($row - ($self->nrow >> 1));
172	root	1.16	$self->want_refresh;
173	sf-exg	1.39	return;
174	root	1.16	}
175	root	1.1
176	root	1.16	$row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
177	root	1.1	}
178			}
179
180	sf-exg	1.39	$self->scr_bell;
181	root	1.1	}
182
183	root	1.2	sub refresh {
184			my ($self) = @_;
185
186	root	1.18	return unless $self->{found};
187
188	root	1.15	my $xor = urxvt::RS_RVid \| urxvt::RS_Blink;
189	root	1.13	for (@{ $self->{found} }) {
190			$self->scr_xor_span (@$_, $xor);
191			$xor = urxvt::RS_RVid;
192			}
193	root	1.2
194			()
195			}
196
197			sub key_press {
198	root	1.1	my ($self, $event, $keysym, $string) = @_;
199
200	root	1.13	delete $self->{manpage_overlay};
201
202	root	1.14	if ($keysym == 0xff0d \|\| $keysym == 0xff8d) { # enter
203	ayin	1.23	if ($self->{found} && $event->{state} & urxvt::ShiftMask) {
204	root	1.13	my ($br, $bc, $er, $ec) = @{ $self->{found}[0] };
205			$self->selection_beg ($br, $bc);
206			$self->selection_end ($er, $ec);
207			$self->selection_make ($event->{time});
208			}
209			$self->leave;
210	root	1.14	} elsif ($keysym == 0xff1b) { # escape
211	root	1.13	$self->view_start ($self->{view_start});
212			$self->leave;
213	root	1.14	} elsif ($keysym == 0xff57) { # end
214	root	1.13	$self->{row} = $self->nrow - 1;
215			$self->view_start (0);
216	root	1.14	} elsif ($keysym == 0xff52) { # up
217	sf-exg	1.37	my $line = $self->line ($self->{row});
218			$self->search (-1, $line->beg - 1)
219			if $line->beg > $self->top_row;
220	root	1.14	} elsif ($keysym == 0xff54) { # down
221	sf-exg	1.37	my $line = $self->line ($self->{row});
222			$self->search (+1, $line->end + 1)
223			if $line->end < $self->nrow;
224	sf-exg	1.44	} elsif ($keysym == 0xff55) { # prior
225			my $row = $self->view_start - ($self->nrow - 1);
226	sf-exg	1.47	$self->view_start ($row);
227	sf-exg	1.44	} elsif ($keysym == 0xff56) { # next
228			my $row = $self->view_start + ($self->nrow - 1);
229	sf-exg	1.47	$self->view_start ($row);
230	sf-exg	1.44	} elsif ($keysym == 0xff63) { # insert
231			$self->selection_request (urxvt::CurrentTime, 1);
232	root	1.14	} elsif ($keysym == 0xff08) { # backspace
233	root	1.13	substr $self->{search}, -1, 1, "";
234	sf-exg	1.37	$self->search (+1, $self->{row});
235	root	1.13	$self->idle;
236	root	1.19	} elsif ($string !~ /[\x00-\x1f\x80-\xaf]/) {
237	root	1.13	return; # pass to tt_write
238	root	1.1	}
239
240			1
241			}
242
243	root	1.7	sub tt_write {
244			my ($self, $data) = @_;
245
246			$self->{search} .= $self->locale_decode ($data);
247	root	1.45	$self->{search} =~ s/\e\[20[01]~//g;
248	root	1.22
249			$self->{search} =~ s/^\(\?i\)//
250			if $self->{search} =~ /^\(.*[[:upper:]]/;
251	sf-exg	1.26
252	sf-exg	1.38	delete $self->{found};
253	sf-exg	1.37	$self->search (-1, $self->{row});
254	root	1.13	$self->idle;
255	root	1.7
256			1
257			}
258
259	root	1.1