[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;
   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.33
Committed:	Mon Oct 13 19:39:42 2014 UTC (9 years, 6 months ago) by sf-exg
Branch:	MAIN
Changes since 1.32:	+4 -3 lines
Log Message:	Change matcher:on_line_update to set the line rendition once, rather than for every match.
#	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	sf-exg	1.33	my $rend;
272	root	1.1
273			# find all urls (if any)
274			for my $matcher (@{$self->{matchers}}) {
275			while ($text =~ /$matcher->[0]/g) {
276	tpope	1.2	#print "$&\n";
277	sf-exg	1.33	$rend \|\|= $line->r;
278	root	1.1
279			# mark all characters as underlined. we _must_ not toggle underline,
280			# as we might get called on an already-marked url.
281	tpope	1.2	&{$matcher->[2]}
282	sf-exg	1.30	for @{$rend}[$-[0] .. $+[0] - 1];
283	root	1.1	}
284			}
285
286	sf-exg	1.33	$line->r ($rend) if $rend;
287
288	root	1.1	()
289			}
290
291			sub valid_button {
292			my ($self, $event) = @_;
293			my $mask = $self->ModLevel3Mask \| $self->ModMetaMask
294			\| urxvt::ShiftMask \| urxvt::ControlMask;
295			return ($event->{button} == $self->{button} &&
296			($event->{state} & $mask) == $self->{state});
297			}
298
299	sf-exg	1.21	sub find_matches {
300	root	1.1	my ($self, $row, $col) = @_;
301			my $line = $self->line ($row);
302			my $text = $line->t;
303	sf-exg	1.29	my $off = $line->offset_of ($row, $col) if defined $col;
304	root	1.1
305	sf-exg	1.21	my @matches;
306	root	1.1	for my $matcher (@{$self->{matchers}}) {
307			my $launcher = $matcher->[1] \|\| $self->{launcher};
308	sf-exg	1.22	while ($text =~ /$matcher->[0]/g) {
309	sf-exg	1.21	my $match = substr $text, $-[0], $+[0] - $-[0];
310	root	1.1	my @begin = @-;
311			my @end = @+;
312	sf-exg	1.21	my @exec;
313
314	sf-exg	1.25	if (!defined($off) \|\| ($-[0] <= $off && $+[0] >= $off)) {
315	root	1.1	if ($launcher !~ /\$/) {
316	sf-exg	1.21	@exec = ($launcher, $match);
317	root	1.1	} else {
318			# It'd be nice to just access a list like ($&,$1,$2...),
319			# but alas, m//g behaves differently in list context.
320	sf-exg	1.21	@exec = map { s/\$(\d+)\|\$\{(\d+)\}/
321	sf-exg	1.23	substr $text, $begin[$1 \|\| $2], $end[$1 \|\| $2] - $begin[$1 \|\| $2]
322	sf-exg	1.22	/egx; $_ } split /\s+/, $launcher;
323	root	1.1	}
324	sf-exg	1.21
325	sf-exg	1.26	push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
326	root	1.1	}
327			}
328			}
329
330	sf-exg	1.21	@matches;
331			}
332
333			sub command_for {
334			my ($self, $row, $col) = @_;
335
336			my @matches = $self->find_matches ($row, $col);
337			if (@matches) {
338			my @match = @{ $matches[0] };
339	sf-exg	1.26	return @match[5 .. $#match];
340	sf-exg	1.21	}
341
342	root	1.1	()
343			}
344
345			sub on_button_press {
346			my ($self, $event) = @_;
347	sf-tpope	1.5	if($self->valid_button($event)
348			&& (my @exec = $self->command_for($event->{row},$event->{col}))) {
349	root	1.1	$self->{row} = $event->{row};
350			$self->{col} = $event->{col};
351	sf-tpope	1.5	$self->{cmd} = \@exec;
352			return 1;
353	root	1.1	} else {
354			delete $self->{row};
355			delete $self->{col};
356	sf-tpope	1.5	delete $self->{cmd};
357	root	1.1	}
358
359			()
360			}
361
362			sub on_button_release {
363			my ($self, $event) = @_;
364
365			my $row = delete $self->{row};
366			my $col = delete $self->{col};
367	sf-tpope	1.5	my $cmd = delete $self->{cmd};
368	root	1.1
369	sf-tpope	1.5	return if !defined $row;
370
371			if($row == $event->{row} && abs($col-$event->{col}) < 2
372			&& join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
373	root	1.1	if($self->valid_button($event)) {
374
375	sf-exg	1.17	$self->exec_async (@$cmd);
376	root	1.1
377			}
378			}
379
380	sf-tpope	1.5	1;
381	root	1.1	}
382
383	sf-exg	1.31	sub select_enter {
384			my ($self) = @_;
385
386			$self->{view_start} = $self->view_start;
387			$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
388			$self->{cur_row} = $self->nrow - 1;
389
390			$self->enable (
391			key_press => \&select_key_press,
392			refresh_begin => \&select_refresh,
393			refresh_end => \&select_refresh,
394			);
395
396			$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
397			$self->{overlay}->set (0, 0, "match-select");
398			}
399
400			sub select_leave {
401			my ($self) = @_;
402
403			$self->disable ("key_press", "refresh_begin", "refresh_end");
404			$self->pty_ev_events ($self->{pty_ev_events});
405
406			delete $self->{overlay};
407			delete $self->{matches};
408			delete $self->{id};
409			}
410
411			sub select_search {
412			my ($self, $dir, $row) = @_;
413
414			while ($self->nrow > $row && $row >= $self->top_row) {
415			my $line = $self->line ($row)
416			or last;
417
418			my @matches = $self->find_matches ($row);
419			if (@matches) {
420			@matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
421			$self->{matches} = \@matches;
422			$self->{cur_row} = $row;
423			$self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
424			$self->view_start (List::Util::min 0, $row - ($self->nrow >> 1));
425			$self->want_refresh;
426			return;
427			}
428
429			$row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
430			}
431
432			$self->scr_bell;
433			}
434
435			sub select_refresh {
436			my ($self) = @_;
437
438			return unless $self->{matches};
439
440			my $cur = $self->{matches}[$self->{id}];
441			$self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
442
443			()
444			}
445
446			sub select_key_press {
447			my ($self, $event, $keysym, $string) = @_;
448
449			if ($keysym == 0xff0d \|\| $keysym == 0xff8d) { # enter
450			if ($self->{matches}) {
451			my @match = @{ $self->{matches}[$self->{id}] };
452			$self->exec_async (@match[5 .. $#match]);
453			}
454			$self->select_leave;
455			} elsif ($keysym == 0x79) { # y
456			if ($self->{matches}) {
457			$self->selection ($self->{matches}[$self->{id}][4], 1);
458			$self->selection_grab (urxvt::CurrentTime, 1);
459			}
460			$self->select_leave;
461			} elsif ($keysym == 0xff1b) { # escape
462			$self->view_start ($self->{view_start});
463			$self->select_leave;
464			} elsif ($keysym == 0xff50) { # home
465			$self->select_search (+1, $self->top_row)
466			} elsif ($keysym == 0xff57) { # end
467			$self->select_search (-1, $self->nrow - 1)
468			} elsif ($keysym == 0xff52) { # up
469			if ($self->{id} > 0) {
470			$self->{id}--;
471			$self->want_refresh;
472			} else {
473			my $line = $self->line ($self->{cur_row});
474			$self->select_search (-1, $line->beg - 1)
475			if $line->beg > $self->top_row;
476			}
477			} elsif ($keysym == 0xff54) { # down
478			if ($self->{id} < @{ $self->{matches} } - 1) {
479			$self->{id}++;
480			$self->want_refresh;
481			} else {
482			my $line = $self->line ($self->{cur_row});
483			$self->select_search (+1, $line->end + 1)
484			if $line->end < $self->nrow;
485			}
486			}
487
488			1
489			}
490
491	root	1.1	# vim:set sw=3 sts=3 et: