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

#! perl

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

#:META:RESOURCE:%.launcher:string:default launcher command
#:META:RESOURCE:%.button:string:the mouse button used to activate a match
#: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 eq "matcher:list") {
      $self->matchlist;
   } elsif ($cmd eq "matcher:last") {
      $self->most_recent;
   } elsif ($cmd eq "matcher:select") {
      $self->select_enter;
   } elsif ($cmd eq "matcher") {
      # 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;
   my $rend;

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