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

#! perl

# Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.org>
#         Bob Farrell <robertanthonyfarrell@gmail.com>

#:META:RESOURCE:%.launcher:string:default launcher command
#:META:RESOURCE:%.button:string:the button, yeah
#:META:RESOURCE:%.pattern.:string:extra pattern to match
#:META:RESOURCE:%.launcher.:string:custom launcher for pattern
#:META:RESOURCE:%.rend.:string:custom rendition for pattern

=head1 NAME

matcher - match strings in terminal output and change their rendition

=head1 DESCRIPTION

Uses per-line display filtering (C<on_line_update>) to underline text
matching a certain pattern and make it clickable. When clicked with the
mouse button specified in the C<matcher.button> resource (default 2, or
middle), the program specified in the C<matcher.launcher> resource
(default, the C<url-launcher> resource, C<sensible-browser>) will be started
with the matched text as first argument.  The default configuration is
suitable for matching URLs and launching a web browser, like the
former "mark-urls" extension.

The default pattern to match URLs can be overridden with the
C<matcher.pattern.0> resource, and additional patterns can be specified
with numbered patterns, in a manner similar to the "selection" extension.
The launcher can also be overridden on a per-pattern basis.

It is possible to activate the most recently seen match or a list of matches
from the keyboard.  Simply bind a keysym to "matcher:last" or
"matcher:list" as seen in the example below.

The 'matcher:select' action enables a mode in which it is possible to
iterate over the matches using the keyboard and either activate them
or copy them to the clipboard. While the mode is active, normal terminal
input/output is suspended and the following bindings are recognized:

=over 4

=item C<Up>

Search for a match upwards.

=item C<Down>

Search for a match downwards.

=item C<Home>

Jump to the topmost match.

=item C<End>

Jump to the bottommost match.

=item C<Escape>

Leave the mode and return to the point where search was started.

=item C<Enter>

Activate the current match.

=item C<y>

Copy the current match to the clipboard.

=back

Example: load and use the matcher extension with defaults.

    URxvt.perl-ext:           default,matcher

Example: use a custom configuration.

    URxvt.url-launcher:       sensible-browser
    URxvt.keysym.C-Delete:    matcher:last
    URxvt.keysym.M-Delete:    matcher:list
    URxvt.matcher.button:     1
    URxvt.matcher.pattern.1:  \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-]
    URxvt.matcher.pattern.2:  \\B(/\\S+?):(\\d+)(?=:|$)
    URxvt.matcher.launcher.2: gvim +$2 $1

=cut

my $url =
   qr{
      (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
      [\w\-\@;\/?:&=%\$.+!*\x27,~#]*
      (
         \([\w\-\@;\/?:&=%\$.+!*\x27,~#]*\)| # Allow a pair of matched parentheses
         [\w\-\@;\/?:&=%\$+*~]  # exclude some trailing characters (heuristic)
      )+
   }x;

sub matchlist_key_press {
   my ($self, $event, $keysym, $octets) = @_;

   delete $self->{overlay};
   $self->disable ("key_press");

   my $i = ($keysym == 96 ? 0 : $keysym - 48);
   if ($i >= 0 && $i < @{ $self->{matches} }) {
      my @exec = @{ $self->{matches}[$i] };
      $self->exec_async (@exec[5 .. $#exec]);
   }

   1
}

# backwards compat
sub on_user_command {
   my ($self, $cmd) = @_;

   if ($cmd =~ s/^matcher:list\b//) {
      $self->matchlist;
   } else {
      if ($cmd =~ s/^matcher:last\b//) {
         $self->most_recent;
      } elsif ($cmd =~ s/^matcher\b//) {
         # for backward compatibility
         $self->most_recent;
      }
   }

   ()
}

sub on_action {
   my ($self, $action) = @_;

   if ($action eq "list") {
      $self->matchlist;
   } elsif ($action eq "last") {
      $self->most_recent;
   } elsif ($action eq "select") {
      $self->select_enter;
   }

   ()
}

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

   $self->{matches} = [];
   my $row = $self->nrow - 1;
   while ($row >= 0 && @{ $self->{matches} } < 10) {
      my $line = $self->line ($row);
      my @matches = $self->find_matches ($row);

      for (sort { $b->[0] <=> $a->[0] or $b->[1] <=> $a->[1] } @matches) {
         push @{ $self->{matches} }, $_;
         last if @{ $self->{matches} } == 10;
      }

      $row = $line->beg - 1;
   }

   return unless @{ $self->{matches} };

   my $width = 0;

   my $i = 0;
   for my $match (@{ $self->{matches} }) {
      my $text = $match->[4];
      my $w = $self->strwidth ("$i-$text");

      $width = $w if $w > $width;
      $i++;
   }

   $width = $self->ncol - 2 if $width > $self->ncol - 2;

   $self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2);
   my $i = 0;
   for my $match (@{ $self->{matches} }) {
      my $text = $match->[4];

      $self->{overlay}->set (0, $i, "$i-$text");
      $i++;
   }

   $self->enable (key_press => \&matchlist_key_press);
}

sub most_recent {
   my ($self) = shift;
   my $row = $self->nrow - 1;
   my @exec;
   while ($row >= $self->top_row) {
      my $line = $self->line ($row);
      @exec = $self->command_for($row);
      last if(@exec);

      $row = $line->beg - 1;
   }
   if(@exec) {
      return $self->exec_async (@exec);
   }
   ()
}

sub my_resource {
   $_[0]->x_resource ("%.$_[1]")
}

# turn a rendition spec in the resource into a sub that implements it on $_
sub parse_rend {
   my ($self, $str) = @_;
   my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
                                        : (urxvt::RS_Uline, undef, undef, []);
   warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
   my @rend;
   push @rend, sub { $_ |= $mask } if $mask;
   push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
   push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
   sub {
      for my $s ( @rend ) { &$s };
   }
}

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

   $self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser";

   $self->{button}  = 2;
   $self->{state}   = 0;
   if($self->{argv}[0] || $self->my_resource ("button")) {
      my @mods = split '', $self->{argv}[0] || $self->my_resource ("button");
      for my $mod (@mods) {
         if($mod =~ /^\d+$/) {
            $self->{button} = $mod;
         } elsif($mod eq "C") {
            $self->{state} |= urxvt::ControlMask;
         } elsif($mod eq "S") {
            $self->{state} |= urxvt::ShiftMask;
         } elsif($mod eq "M") {
            $self->{state} |= $self->ModMetaMask;
         } elsif($mod ne "-" && $mod ne " ") {
            warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
         }
      }
   }

   my @defaults = ($url);
   my @matchers;
   for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") || $defaults[$idx]); $idx++) {
      $res = $self->locale_decode ($res);
      utf8::encode $res;
      my $launcher = $self->my_resource ("launcher.$idx");
      $launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher;
      my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
      unshift @matchers, [qr($res)x,$launcher,$rend];
   }
   $self->{matchers} = \@matchers;

   ()
}

sub on_line_update {
   my ($self, $row) = @_;

   # fetch the line that has changed
   my $line = $self->line ($row);
   my $text = $line->t;

   # find all urls (if any)
   for my $matcher (@{$self->{matchers}}) {
      while ($text =~ /$matcher->[0]/g) {
         #print "$&\n";
         my $rend = $line->r;

         # mark all characters as underlined. we _must_ not toggle underline,
         # as we might get called on an already-marked url.
         &{$matcher->[2]}
            for @{$rend}[$-[0] .. $+[0] - 1];

         $line->r ($rend);
      }
   }

   ()
}

sub valid_button {
   my ($self, $event) = @_;
   my $mask = $self->ModLevel3Mask | $self->ModMetaMask
   | urxvt::ShiftMask | urxvt::ControlMask;
   return ($event->{button} == $self->{button} &&
      ($event->{state} & $mask) == $self->{state});
}

sub find_matches {
   my ($self, $row, $col) = @_;
   my $line = $self->line ($row);
   my $text = $line->t;
   my $off = $line->offset_of ($row, $col) if defined $col;

   my @matches;
   for my $matcher (@{$self->{matchers}}) {
      my $launcher = $matcher->[1] || $self->{launcher};
      while ($text =~ /$matcher->[0]/g) {
         my $match = substr $text, $-[0], $+[0] - $-[0];
         my @begin = @-;
         my @end = @+;
         my @exec;

         if (!defined($off) || ($-[0] <= $off && $+[0] >= $off)) {
            if ($launcher !~ /\$/) {
               @exec = ($launcher, $match);
            } else {
               # It'd be nice to just access a list like ($&,$1,$2...),
               # but alas, m//g behaves differently in list context.
               @exec = map { s/\$(\d+)|\$\{(\d+)\}/
                  substr $text, $begin[$1 || $2], $end[$1 || $2] - $begin[$1 || $2]
                  /egx; $_ } split /\s+/, $launcher;
            }

            push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
         }
      }
   }

   @matches;
}

sub command_for {
   my ($self, $row, $col) = @_;

   my @matches = $self->find_matches ($row, $col);
   if (@matches) {
      my @match = @{ $matches[0] };
      return @match[5 .. $#match];
   }

   ()
}

sub on_button_press {
   my ($self, $event) = @_;
   if($self->valid_button($event)
      && (my @exec = $self->command_for($event->{row},$event->{col}))) {
      $self->{row} = $event->{row};
      $self->{col} = $event->{col};
      $self->{cmd} = \@exec;
      return 1;
   } else {
      delete $self->{row};
      delete $self->{col};
      delete $self->{cmd};
   }

   ()
}

sub on_button_release {
   my ($self, $event) = @_;

   my $row = delete $self->{row};
   my $col = delete $self->{col};
   my $cmd = delete $self->{cmd};

   return if !defined $row;

   if($row == $event->{row} && abs($col-$event->{col}) < 2
      && join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
      if($self->valid_button($event)) {

         $self->exec_async (@$cmd);

      }
   }

   1;
}

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

   $self->{view_start} = $self->view_start;
   $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
   $self->{cur_row} = $self->nrow - 1;

   $self->enable (
      key_press     => \&select_key_press,
      refresh_begin => \&select_refresh,
      refresh_end   => \&select_refresh,
   );

   $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
   $self->{overlay}->set (0, 0, "match-select");
}

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

   $self->disable ("key_press", "refresh_begin", "refresh_end");
   $self->pty_ev_events ($self->{pty_ev_events});

   delete $self->{overlay};
   delete $self->{matches};
   delete $self->{id};
}

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

   while ($self->nrow > $row && $row >= $self->top_row) {
      my $line = $self->line ($row)
          or last;

      my @matches = $self->find_matches ($row);
      if (@matches) {
         @matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
         $self->{matches} = \@matches;
         $self->{cur_row} = $row;
         $self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
         $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 select_refresh {
   my ($self) = @_;

   return unless $self->{matches};

   my $cur = $self->{matches}[$self->{id}];
   $self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);

   ()
}

sub select_key_press {
   my ($self, $event, $keysym, $string) =  @_;

   if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter
      if ($self->{matches}) {
         my @match = @{ $self->{matches}[$self->{id}] };
         $self->exec_async (@match[5 .. $#match]);
      }
      $self->select_leave;
   } elsif ($keysym == 0x79) { # y
      if ($self->{matches}) {
         $self->selection ($self->{matches}[$self->{id}][4], 1);
         $self->selection_grab (urxvt::CurrentTime, 1);
      }
      $self->select_leave;
   } elsif ($keysym == 0xff1b) { # escape
      $self->view_start ($self->{view_start});
      $self->select_leave;
   } elsif ($keysym == 0xff50) { # home
      $self->select_search (+1, $self->top_row)
   } elsif ($keysym == 0xff57) { # end
      $self->select_search (-1, $self->nrow - 1)
   } elsif ($keysym == 0xff52) { # up
      if ($self->{id} > 0) {
         $self->{id}--;
         $self->want_refresh;
      } else {
         my $line = $self->line ($self->{cur_row});
         $self->select_search (-1, $line->beg - 1)
            if $line->beg > $self->top_row;
      }
   } elsif ($keysym == 0xff54) { # down
      if ($self->{id} < @{ $self->{matches} } - 1) {
         $self->{id}++;
         $self->want_refresh;
      } else {
         my $line = $self->line ($self->{cur_row});
         $self->select_search (+1, $line->end + 1)
            if $line->end < $self->nrow;
      }
   }

   1
}

# vim:set sw=3 sts=3 et:
Revision:	1.32
Committed:	Wed Jul 30 15:22:51 2014 UTC (9 years, 9 months ago) by sf-exg
Branch:	MAIN
Changes since 1.31:	+5 -2 lines
Log Message:	Do not needlessly scan the same line multiple times in matcher:most_recent.
#	User	Rev	Content
1	root	1.1	#! perl
2
3	sf-tpope	1.7	# Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.org>
4	root	1.14	# Bob Farrell <robertanthonyfarrell@gmail.com>
5	root	1.1
6	root	1.15	#:META:RESOURCE:%.launcher:string:default launcher command
7			#:META:RESOURCE:%.button:string:the button, yeah
8			#:META:RESOURCE:%.pattern.:string:extra pattern to match
9			#:META:RESOURCE:%.launcher.:string:custom launcher for pattern
10	sf-exg	1.28	#:META:RESOURCE:%.rend.:string:custom rendition for pattern
11	root	1.8
12	root	1.10	=head1 NAME
13
14	root	1.13	matcher - match strings in terminal output and change their rendition
15	root	1.10
16	root	1.11	=head1 DESCRIPTION
17	root	1.10
18			Uses per-line display filtering (C<on_line_update>) to underline text
19			matching a certain pattern and make it clickable. When clicked with the
20			mouse button specified in the C<matcher.button> resource (default 2, or
21			middle), the program specified in the C<matcher.launcher> resource
22	sf-exg	1.16	(default, the C<url-launcher> resource, C<sensible-browser>) will be started
23	root	1.10	with the matched text as first argument. The default configuration is
24			suitable for matching URLs and launching a web browser, like the
25			former "mark-urls" extension.
26
27			The default pattern to match URLs can be overridden with the
28			C<matcher.pattern.0> resource, and additional patterns can be specified
29			with numbered patterns, in a manner similar to the "selection" extension.
30			The launcher can also be overridden on a per-pattern basis.
31
32			It is possible to activate the most recently seen match or a list of matches
33	sf-exg	1.20	from the keyboard. Simply bind a keysym to "matcher:last" or
34			"matcher:list" as seen in the example below.
35	root	1.10
36	sf-exg	1.31	The 'matcher:select' action enables a mode in which it is possible to
37			iterate over the matches using the keyboard and either activate them
38			or copy them to the clipboard. While the mode is active, normal terminal
39			input/output is suspended and the following bindings are recognized:
40
41			=over 4
42
43			=item C<Up>
44
45			Search for a match upwards.
46
47			=item C<Down>
48
49			Search for a match downwards.
50
51			=item C<Home>
52
53			Jump to the topmost match.
54
55			=item C<End>
56
57			Jump to the bottommost match.
58
59			=item C<Escape>
60
61			Leave the mode and return to the point where search was started.
62
63			=item C<Enter>
64
65			Activate the current match.
66
67			=item C<y>
68
69			Copy the current match to the clipboard.
70
71			=back
72
73	root	1.14	Example: load and use the matcher extension with defaults.
74	root	1.10
75			URxvt.perl-ext: default,matcher
76	root	1.14
77			Example: use a custom configuration.
78
79	root	1.10	URxvt.url-launcher: sensible-browser
80	sf-exg	1.20	URxvt.keysym.C-Delete: matcher:last
81			URxvt.keysym.M-Delete: matcher:list
82	root	1.10	URxvt.matcher.button: 1
83			URxvt.matcher.pattern.1: \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-]
84			URxvt.matcher.pattern.2: \\B(/\\S+?):(\\d+)(?=:\|$)
85			URxvt.matcher.launcher.2: gvim +$2 $1
86
87			=cut
88
89	root	1.1	my $url =
90			qr{
91	tpope	1.2	(?:https?://\|ftp://\|news://\|mailto:\|file://\|\bwww\.)
92	sf-tpope	1.12	[\w\-\@;\/?:&=%\$.+!\x27,~#]
93	tpope	1.2	(
94	sf-tpope	1.12	\([\w\-\@;\/?:&=%\$.+!\x27,~#]\)\| # Allow a pair of matched parentheses
95			[\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic)
96	tpope	1.2	)+
97	root	1.1	}x;
98
99	sf-exg	1.26	sub matchlist_key_press {
100	sf-tpope	1.6	my ($self, $event, $keysym, $octets) = @_;
101
102	sf-exg	1.18	delete $self->{overlay};
103	sf-exg	1.26	$self->disable ("key_press");
104	sf-tpope	1.6
105			my $i = ($keysym == 96 ? 0 : $keysym - 48);
106	sf-exg	1.18	if ($i >= 0 && $i < @{ $self->{matches} }) {
107			my @exec = @{ $self->{matches}[$i] };
108	sf-exg	1.26	$self->exec_async (@exec[5 .. $#exec]);
109	sf-tpope	1.6	}
110
111	sf-exg	1.18	1
112	sf-tpope	1.6	}
113
114	root	1.14	# backwards compat
115	tpope	1.4	sub on_user_command {
116			my ($self, $cmd) = @_;
117	sf-tpope	1.6
118	root	1.14	if ($cmd =~ s/^matcher:list\b//) {
119			$self->matchlist;
120	sf-tpope	1.6	} else {
121	root	1.14	if ($cmd =~ s/^matcher:last\b//) {
122	sf-tpope	1.6	$self->most_recent;
123	root	1.14	} elsif ($cmd =~ s/^matcher\b//) {
124			# for backward compatibility
125	sf-tpope	1.6	$self->most_recent;
126			}
127	tpope	1.4	}
128	root	1.14
129	tpope	1.4	()
130			}
131
132	sf-exg	1.20	sub on_action {
133			my ($self, $action) = @_;
134
135			if ($action eq "list") {
136			$self->matchlist;
137			} elsif ($action eq "last") {
138			$self->most_recent;
139	sf-exg	1.31	} elsif ($action eq "select") {
140			$self->select_enter;
141	sf-exg	1.20	}
142
143			()
144			}
145
146	sf-tpope	1.6	sub matchlist {
147			my ($self) = @_;
148	sf-exg	1.17
149	sf-exg	1.26	$self->{matches} = [];
150	sf-exg	1.18	my $row = $self->nrow - 1;
151			while ($row >= 0 && @{ $self->{matches} } < 10) {
152			my $line = $self->line ($row);
153	sf-exg	1.24	my @matches = $self->find_matches ($row);
154	sf-exg	1.17
155	sf-exg	1.26	for (sort { $b->[0] <=> $a->[0] or $b->[1] <=> $a->[1] } @matches) {
156	sf-exg	1.19	push @{ $self->{matches} }, $_;
157			last if @{ $self->{matches} } == 10;
158			}
159
160	sf-exg	1.18	$row = $line->beg - 1;
161			}
162	sf-exg	1.17
163	sf-exg	1.18	return unless @{ $self->{matches} };
164	sf-exg	1.17
165	sf-exg	1.18	my $width = 0;
166	sf-exg	1.17
167	sf-exg	1.18	my $i = 0;
168			for my $match (@{ $self->{matches} }) {
169	sf-exg	1.26	my $text = $match->[4];
170	sf-exg	1.18	my $w = $self->strwidth ("$i-$text");
171	sf-exg	1.17
172	sf-exg	1.18	$width = $w if $w > $width;
173			$i++;
174	sf-exg	1.17	}
175
176	sf-exg	1.18	$width = $self->ncol - 2 if $width > $self->ncol - 2;
177	sf-exg	1.17
178	sf-exg	1.18	$self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2);
179	sf-exg	1.17	my $i = 0;
180	sf-exg	1.18	for my $match (@{ $self->{matches} }) {
181	sf-exg	1.26	my $text = $match->[4];
182	sf-exg	1.18
183			$self->{overlay}->set (0, $i, "$i-$text");
184	sf-exg	1.17	$i++;
185			}
186	sf-tpope	1.6
187	sf-exg	1.26	$self->enable (key_press => \&matchlist_key_press);
188	sf-tpope	1.6	}
189
190	tpope	1.4	sub most_recent {
191			my ($self) = shift;
192	sf-exg	1.32	my $row = $self->nrow - 1;
193	tpope	1.4	my @exec;
194	sf-exg	1.32	while ($row >= $self->top_row) {
195			my $line = $self->line ($row);
196	tpope	1.4	@exec = $self->command_for($row);
197			last if(@exec);
198	sf-exg	1.32
199			$row = $line->beg - 1;
200	tpope	1.4	}
201			if(@exec) {
202			return $self->exec_async (@exec);
203			}
204			()
205			}
206	tpope	1.2
207	root	1.1	sub my_resource {
208	root	1.9	$_[0]->x_resource ("%.$_[1]")
209	root	1.1	}
210
211	tpope	1.2	# turn a rendition spec in the resource into a sub that implements it on $_
212			sub parse_rend {
213			my ($self, $str) = @_;
214	sf-tpope	1.6	my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
215	tpope	1.2	: (urxvt::RS_Uline, undef, undef, []);
216			warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
217			my @rend;
218			push @rend, sub { $_ \|= $mask } if $mask;
219			push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
220			push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
221			sub {
222			for my $s ( @rend ) { &$s };
223			}
224			}
225
226	root	1.1	sub on_start {
227			my ($self) = @_;
228
229	root	1.8	$self->{launcher} = $self->my_resource ("launcher") \|\| $self->x_resource("url-launcher") \|\| "sensible-browser";
230	root	1.1
231			$self->{button} = 2;
232			$self->{state} = 0;
233	root	1.8	if($self->{argv}[0] \|\| $self->my_resource ("button")) {
234			my @mods = split '', $self->{argv}[0] \|\| $self->my_resource ("button");
235	root	1.1	for my $mod (@mods) {
236			if($mod =~ /^\d+$/) {
237			$self->{button} = $mod;
238			} elsif($mod eq "C") {
239			$self->{state} \|= urxvt::ControlMask;
240			} elsif($mod eq "S") {
241			$self->{state} \|= urxvt::ShiftMask;
242			} elsif($mod eq "M") {
243			$self->{state} \|= $self->ModMetaMask;
244			} elsif($mod ne "-" && $mod ne " ") {
245	root	1.9	warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
246	root	1.1	}
247			}
248			}
249
250			my @defaults = ($url);
251			my @matchers;
252	root	1.8	for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") \|\| $defaults[$idx]); $idx++) {
253	root	1.1	$res = $self->locale_decode ($res);
254			utf8::encode $res;
255	root	1.8	my $launcher = $self->my_resource ("launcher.$idx");
256			$launcher =~ s/\$&\|\$\{&\}/\${0}/g if $launcher;
257			my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
258	tpope	1.2	unshift @matchers, [qr($res)x,$launcher,$rend];
259	root	1.1	}
260			$self->{matchers} = \@matchers;
261
262			()
263			}
264
265			sub on_line_update {
266			my ($self, $row) = @_;
267
268			# fetch the line that has changed
269			my $line = $self->line ($row);
270			my $text = $line->t;
271
272			# find all urls (if any)
273			for my $matcher (@{$self->{matchers}}) {
274			while ($text =~ /$matcher->[0]/g) {
275	tpope	1.2	#print "$&\n";
276	root	1.1	my $rend = $line->r;
277
278			# mark all characters as underlined. we _must_ not toggle underline,
279			# as we might get called on an already-marked url.
280	tpope	1.2	&{$matcher->[2]}
281	sf-exg	1.30	for @{$rend}[$-[0] .. $+[0] - 1];
282	root	1.1
283			$line->r ($rend);
284			}
285			}
286
287			()
288			}
289
290			sub valid_button {
291			my ($self, $event) = @_;
292			my $mask = $self->ModLevel3Mask \| $self->ModMetaMask
293			\| urxvt::ShiftMask \| urxvt::ControlMask;
294			return ($event->{button} == $self->{button} &&
295			($event->{state} & $mask) == $self->{state});
296			}
297
298	sf-exg	1.21	sub find_matches {
299	root	1.1	my ($self, $row, $col) = @_;
300			my $line = $self->line ($row);
301			my $text = $line->t;
302	sf-exg	1.29	my $off = $line->offset_of ($row, $col) if defined $col;
303	root	1.1
304	sf-exg	1.21	my @matches;
305	root	1.1	for my $matcher (@{$self->{matchers}}) {
306			my $launcher = $matcher->[1] \|\| $self->{launcher};
307	sf-exg	1.22	while ($text =~ /$matcher->[0]/g) {
308	sf-exg	1.21	my $match = substr $text, $-[0], $+[0] - $-[0];
309	root	1.1	my @begin = @-;
310			my @end = @+;
311	sf-exg	1.21	my @exec;
312
313	sf-exg	1.25	if (!defined($off) \|\| ($-[0] <= $off && $+[0] >= $off)) {
314	root	1.1	if ($launcher !~ /\$/) {
315	sf-exg	1.21	@exec = ($launcher, $match);
316	root	1.1	} else {
317			# It'd be nice to just access a list like ($&,$1,$2...),
318			# but alas, m//g behaves differently in list context.
319	sf-exg	1.21	@exec = map { s/\$(\d+)\|\$\{(\d+)\}/
320	sf-exg	1.23	substr $text, $begin[$1 \|\| $2], $end[$1 \|\| $2] - $begin[$1 \|\| $2]
321	sf-exg	1.22	/egx; $_ } split /\s+/, $launcher;
322	root	1.1	}
323	sf-exg	1.21
324	sf-exg	1.26	push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
325	root	1.1	}
326			}
327			}
328
329	sf-exg	1.21	@matches;
330			}
331
332			sub command_for {
333			my ($self, $row, $col) = @_;
334
335			my @matches = $self->find_matches ($row, $col);
336			if (@matches) {
337			my @match = @{ $matches[0] };
338	sf-exg	1.26	return @match[5 .. $#match];
339	sf-exg	1.21	}
340
341	root	1.1	()
342			}
343
344			sub on_button_press {
345			my ($self, $event) = @_;
346	sf-tpope	1.5	if($self->valid_button($event)
347			&& (my @exec = $self->command_for($event->{row},$event->{col}))) {
348	root	1.1	$self->{row} = $event->{row};
349			$self->{col} = $event->{col};
350	sf-tpope	1.5	$self->{cmd} = \@exec;
351			return 1;
352	root	1.1	} else {
353			delete $self->{row};
354			delete $self->{col};
355	sf-tpope	1.5	delete $self->{cmd};
356	root	1.1	}
357
358			()
359			}
360
361			sub on_button_release {
362			my ($self, $event) = @_;
363
364			my $row = delete $self->{row};
365			my $col = delete $self->{col};
366	sf-tpope	1.5	my $cmd = delete $self->{cmd};
367	root	1.1
368	sf-tpope	1.5	return if !defined $row;
369
370			if($row == $event->{row} && abs($col-$event->{col}) < 2
371			&& join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
372	root	1.1	if($self->valid_button($event)) {
373
374	sf-exg	1.17	$self->exec_async (@$cmd);
375	root	1.1
376			}
377			}
378
379	sf-tpope	1.5	1;
380	root	1.1	}
381
382	sf-exg	1.31	sub select_enter {
383			my ($self) = @_;
384
385			$self->{view_start} = $self->view_start;
386			$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
387			$self->{cur_row} = $self->nrow - 1;
388
389			$self->enable (
390			key_press => \&select_key_press,
391			refresh_begin => \&select_refresh,
392			refresh_end => \&select_refresh,
393			);
394
395			$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
396			$self->{overlay}->set (0, 0, "match-select");
397			}
398
399			sub select_leave {
400			my ($self) = @_;
401
402			$self->disable ("key_press", "refresh_begin", "refresh_end");
403			$self->pty_ev_events ($self->{pty_ev_events});
404
405			delete $self->{overlay};
406			delete $self->{matches};
407			delete $self->{id};
408			}
409
410			sub select_search {
411			my ($self, $dir, $row) = @_;
412
413			while ($self->nrow > $row && $row >= $self->top_row) {
414			my $line = $self->line ($row)
415			or last;
416
417			my @matches = $self->find_matches ($row);
418			if (@matches) {
419			@matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
420			$self->{matches} = \@matches;
421			$self->{cur_row} = $row;
422			$self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
423			$self->view_start (List::Util::min 0, $row - ($self->nrow >> 1));
424			$self->want_refresh;
425			return;
426			}
427
428			$row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
429			}
430
431			$self->scr_bell;
432			}
433
434			sub select_refresh {
435			my ($self) = @_;
436
437			return unless $self->{matches};
438
439			my $cur = $self->{matches}[$self->{id}];
440			$self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
441
442			()
443			}
444
445			sub select_key_press {
446			my ($self, $event, $keysym, $string) = @_;
447
448			if ($keysym == 0xff0d \|\| $keysym == 0xff8d) { # enter
449			if ($self->{matches}) {
450			my @match = @{ $self->{matches}[$self->{id}] };
451			$self->exec_async (@match[5 .. $#match]);
452			}
453			$self->select_leave;
454			} elsif ($keysym == 0x79) { # y
455			if ($self->{matches}) {
456			$self->selection ($self->{matches}[$self->{id}][4], 1);
457			$self->selection_grab (urxvt::CurrentTime, 1);
458			}
459			$self->select_leave;
460			} elsif ($keysym == 0xff1b) { # escape
461			$self->view_start ($self->{view_start});
462			$self->select_leave;
463			} elsif ($keysym == 0xff50) { # home
464			$self->select_search (+1, $self->top_row)
465			} elsif ($keysym == 0xff57) { # end
466			$self->select_search (-1, $self->nrow - 1)
467			} elsif ($keysym == 0xff52) { # up
468			if ($self->{id} > 0) {
469			$self->{id}--;
470			$self->want_refresh;
471			} else {
472			my $line = $self->line ($self->{cur_row});
473			$self->select_search (-1, $line->beg - 1)
474			if $line->beg > $self->top_row;
475			}
476			} elsif ($keysym == 0xff54) { # down
477			if ($self->{id} < @{ $self->{matches} } - 1) {
478			$self->{id}++;
479			$self->want_refresh;
480			} else {
481			my $line = $self->line ($self->{cur_row});
482			$self->select_search (+1, $line->end + 1)
483			if $line->end < $self->nrow;
484			}
485			}
486
487			1
488			}
489
490	root	1.1	# vim:set sw=3 sts=3 et: