[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;
   my @exec;
   while($row-- > $self->top_row) {
      @exec = $self->command_for($row);
      last if(@exec);
   }
   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.31
Committed:	Sun Jun 22 07:51:21 2014 UTC (9 years, 10 months ago) by sf-exg
Branch:	MAIN
Changes since 1.30:	+147 -0 lines
Log Message:	Add 'matcher:select' mode.
#	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			my $row = $self->nrow;
193			my @exec;
194			while($row-- > $self->top_row) {
195			@exec = $self->command_for($row);
196			last if(@exec);
197			}
198			if(@exec) {
199			return $self->exec_async (@exec);
200			}
201			()
202			}
203	tpope	1.2
204	root	1.1	sub my_resource {
205	root	1.9	$_[0]->x_resource ("%.$_[1]")
206	root	1.1	}
207
208	tpope	1.2	# turn a rendition spec in the resource into a sub that implements it on $_
209			sub parse_rend {
210			my ($self, $str) = @_;
211	sf-tpope	1.6	my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
212	tpope	1.2	: (urxvt::RS_Uline, undef, undef, []);
213			warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
214			my @rend;
215			push @rend, sub { $_ \|= $mask } if $mask;
216			push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
217			push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
218			sub {
219			for my $s ( @rend ) { &$s };
220			}
221			}
222
223	root	1.1	sub on_start {
224			my ($self) = @_;
225
226	root	1.8	$self->{launcher} = $self->my_resource ("launcher") \|\| $self->x_resource("url-launcher") \|\| "sensible-browser";
227	root	1.1
228			$self->{button} = 2;
229			$self->{state} = 0;
230	root	1.8	if($self->{argv}[0] \|\| $self->my_resource ("button")) {
231			my @mods = split '', $self->{argv}[0] \|\| $self->my_resource ("button");
232	root	1.1	for my $mod (@mods) {
233			if($mod =~ /^\d+$/) {
234			$self->{button} = $mod;
235			} elsif($mod eq "C") {
236			$self->{state} \|= urxvt::ControlMask;
237			} elsif($mod eq "S") {
238			$self->{state} \|= urxvt::ShiftMask;
239			} elsif($mod eq "M") {
240			$self->{state} \|= $self->ModMetaMask;
241			} elsif($mod ne "-" && $mod ne " ") {
242	root	1.9	warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
243	root	1.1	}
244			}
245			}
246
247			my @defaults = ($url);
248			my @matchers;
249	root	1.8	for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") \|\| $defaults[$idx]); $idx++) {
250	root	1.1	$res = $self->locale_decode ($res);
251			utf8::encode $res;
252	root	1.8	my $launcher = $self->my_resource ("launcher.$idx");
253			$launcher =~ s/\$&\|\$\{&\}/\${0}/g if $launcher;
254			my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
255	tpope	1.2	unshift @matchers, [qr($res)x,$launcher,$rend];
256	root	1.1	}
257			$self->{matchers} = \@matchers;
258
259			()
260			}
261
262			sub on_line_update {
263			my ($self, $row) = @_;
264
265			# fetch the line that has changed
266			my $line = $self->line ($row);
267			my $text = $line->t;
268
269			# find all urls (if any)
270			for my $matcher (@{$self->{matchers}}) {
271			while ($text =~ /$matcher->[0]/g) {
272	tpope	1.2	#print "$&\n";
273	root	1.1	my $rend = $line->r;
274
275			# mark all characters as underlined. we _must_ not toggle underline,
276			# as we might get called on an already-marked url.
277	tpope	1.2	&{$matcher->[2]}
278	sf-exg	1.30	for @{$rend}[$-[0] .. $+[0] - 1];
279	root	1.1
280			$line->r ($rend);
281			}
282			}
283
284			()
285			}
286
287			sub valid_button {
288			my ($self, $event) = @_;
289			my $mask = $self->ModLevel3Mask \| $self->ModMetaMask
290			\| urxvt::ShiftMask \| urxvt::ControlMask;
291			return ($event->{button} == $self->{button} &&
292			($event->{state} & $mask) == $self->{state});
293			}
294
295	sf-exg	1.21	sub find_matches {
296	root	1.1	my ($self, $row, $col) = @_;
297			my $line = $self->line ($row);
298			my $text = $line->t;
299	sf-exg	1.29	my $off = $line->offset_of ($row, $col) if defined $col;
300	root	1.1
301	sf-exg	1.21	my @matches;
302	root	1.1	for my $matcher (@{$self->{matchers}}) {
303			my $launcher = $matcher->[1] \|\| $self->{launcher};
304	sf-exg	1.22	while ($text =~ /$matcher->[0]/g) {
305	sf-exg	1.21	my $match = substr $text, $-[0], $+[0] - $-[0];
306	root	1.1	my @begin = @-;
307			my @end = @+;
308	sf-exg	1.21	my @exec;
309
310	sf-exg	1.25	if (!defined($off) \|\| ($-[0] <= $off && $+[0] >= $off)) {
311	root	1.1	if ($launcher !~ /\$/) {
312	sf-exg	1.21	@exec = ($launcher, $match);
313	root	1.1	} else {
314			# It'd be nice to just access a list like ($&,$1,$2...),
315			# but alas, m//g behaves differently in list context.
316	sf-exg	1.21	@exec = map { s/\$(\d+)\|\$\{(\d+)\}/
317	sf-exg	1.23	substr $text, $begin[$1 \|\| $2], $end[$1 \|\| $2] - $begin[$1 \|\| $2]
318	sf-exg	1.22	/egx; $_ } split /\s+/, $launcher;
319	root	1.1	}
320	sf-exg	1.21
321	sf-exg	1.26	push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
322	root	1.1	}
323			}
324			}
325
326	sf-exg	1.21	@matches;
327			}
328
329			sub command_for {
330			my ($self, $row, $col) = @_;
331
332			my @matches = $self->find_matches ($row, $col);
333			if (@matches) {
334			my @match = @{ $matches[0] };
335	sf-exg	1.26	return @match[5 .. $#match];
336	sf-exg	1.21	}
337
338	root	1.1	()
339			}
340
341			sub on_button_press {
342			my ($self, $event) = @_;
343	sf-tpope	1.5	if($self->valid_button($event)
344			&& (my @exec = $self->command_for($event->{row},$event->{col}))) {
345	root	1.1	$self->{row} = $event->{row};
346			$self->{col} = $event->{col};
347	sf-tpope	1.5	$self->{cmd} = \@exec;
348			return 1;
349	root	1.1	} else {
350			delete $self->{row};
351			delete $self->{col};
352	sf-tpope	1.5	delete $self->{cmd};
353	root	1.1	}
354
355			()
356			}
357
358			sub on_button_release {
359			my ($self, $event) = @_;
360
361			my $row = delete $self->{row};
362			my $col = delete $self->{col};
363	sf-tpope	1.5	my $cmd = delete $self->{cmd};
364	root	1.1
365	sf-tpope	1.5	return if !defined $row;
366
367			if($row == $event->{row} && abs($col-$event->{col}) < 2
368			&& join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
369	root	1.1	if($self->valid_button($event)) {
370
371	sf-exg	1.17	$self->exec_async (@$cmd);
372	root	1.1
373			}
374			}
375
376	sf-tpope	1.5	1;
377	root	1.1	}
378
379	sf-exg	1.31	sub select_enter {
380			my ($self) = @_;
381
382			$self->{view_start} = $self->view_start;
383			$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
384			$self->{cur_row} = $self->nrow - 1;
385
386			$self->enable (
387			key_press => \&select_key_press,
388			refresh_begin => \&select_refresh,
389			refresh_end => \&select_refresh,
390			);
391
392			$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
393			$self->{overlay}->set (0, 0, "match-select");
394			}
395
396			sub select_leave {
397			my ($self) = @_;
398
399			$self->disable ("key_press", "refresh_begin", "refresh_end");
400			$self->pty_ev_events ($self->{pty_ev_events});
401
402			delete $self->{overlay};
403			delete $self->{matches};
404			delete $self->{id};
405			}
406
407			sub select_search {
408			my ($self, $dir, $row) = @_;
409
410			while ($self->nrow > $row && $row >= $self->top_row) {
411			my $line = $self->line ($row)
412			or last;
413
414			my @matches = $self->find_matches ($row);
415			if (@matches) {
416			@matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
417			$self->{matches} = \@matches;
418			$self->{cur_row} = $row;
419			$self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
420			$self->view_start (List::Util::min 0, $row - ($self->nrow >> 1));
421			$self->want_refresh;
422			return;
423			}
424
425			$row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
426			}
427
428			$self->scr_bell;
429			}
430
431			sub select_refresh {
432			my ($self) = @_;
433
434			return unless $self->{matches};
435
436			my $cur = $self->{matches}[$self->{id}];
437			$self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
438
439			()
440			}
441
442			sub select_key_press {
443			my ($self, $event, $keysym, $string) = @_;
444
445			if ($keysym == 0xff0d \|\| $keysym == 0xff8d) { # enter
446			if ($self->{matches}) {
447			my @match = @{ $self->{matches}[$self->{id}] };
448			$self->exec_async (@match[5 .. $#match]);
449			}
450			$self->select_leave;
451			} elsif ($keysym == 0x79) { # y
452			if ($self->{matches}) {
453			$self->selection ($self->{matches}[$self->{id}][4], 1);
454			$self->selection_grab (urxvt::CurrentTime, 1);
455			}
456			$self->select_leave;
457			} elsif ($keysym == 0xff1b) { # escape
458			$self->view_start ($self->{view_start});
459			$self->select_leave;
460			} elsif ($keysym == 0xff50) { # home
461			$self->select_search (+1, $self->top_row)
462			} elsif ($keysym == 0xff57) { # end
463			$self->select_search (-1, $self->nrow - 1)
464			} elsif ($keysym == 0xff52) { # up
465			if ($self->{id} > 0) {
466			$self->{id}--;
467			$self->want_refresh;
468			} else {
469			my $line = $self->line ($self->{cur_row});
470			$self->select_search (-1, $line->beg - 1)
471			if $line->beg > $self->top_row;
472			}
473			} elsif ($keysym == 0xff54) { # down
474			if ($self->{id} < @{ $self->{matches} } - 1) {
475			$self->{id}++;
476			$self->want_refresh;
477			} else {
478			my $line = $self->line ($self->{cur_row});
479			$self->select_search (+1, $line->end + 1)
480			if $line->end < $self->nrow;
481			}
482			}
483
484			1
485			}
486
487	root	1.1	# vim:set sw=3 sts=3 et: