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

#! perl

# this extension implements scrollback buffer search

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

sub on_init {
   my ($self) = @_;

   my $hotkey = $self->{argv}[0]
                || $self->x_resource ("searchable-scrollback")
                || "M-s";

   $self->parse_keysym ($hotkey, "perl:searchable-scrollback: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 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->{history};
   delete $self->{search};
}

sub idle {
   my ($self) = @_;

   $self->msg ("(escape cancels) /$self->{search}█");
}

sub search {
   my ($self, $dir) = @_;

   delete $self->{found};
   my $row = $self->{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) {
            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;
            last;
         }

         $row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
      }
   }

   $self->scr_bell unless $self->{found};
}

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
      $self->{row}-- if $self->{row} > $self->top_row;
      $self->search (-1);
   } elsif ($keysym == 0xff54) { # down
      $self->{row}++ if $self->{row} < $self->nrow;
      $self->search (+1);
   } elsif ($keysym == 0xff08) { # backspace
      substr $self->{search}, -1, 1, "";
      $self->search;
      $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:]]/;

   $self->search (-1);
   $self->idle;

   1
}


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