[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 C<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

=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

It is also possible to cycle through the matches using a key
combination bound to the C<matcher:select> action.

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

=head2 Regex encoding/wide character matching

Urxvt stores all text as unicode, in a special encoding that uses
one character/code point per column. For various reasons, the regular
expressions are matched directly against this encoding, which means there are a few things
you need to keep in mind:

=over

=item X resources/command line arguments are locale-encoded

The regexes taken from the command line or resources will be converted
from locale encoding to unicode. This can change the number of code points
per character.

=item Wide characters are column-padded with C<$urxvt::NOCHAR>

Wide characters (such as kanji and sometimes tabs) are padded with
a special character value (C<$urxvt::NOCHAR>). That means that
constructs such as C<\w> or C<.> will only match part of a character, as
C<$urxvt::NOCHAR> is not matched by C<\w> and both only match the first
"column" of a wide character.

That means you have to incorporate C<$urxvt::NOCHAR> into parts of regexes
that may match wide characters. For example, to match C<\w+> you might
want to use C<[\w$urxvt::NOCHAR]+> instead, and to match a single character
(C<.>) you might want to use C<.$urxvt::NOCHAR*> instead.

=back

=cut

my $url =
   qr{
      (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
      [\w\-\@;\/?:&=%\$.+!*\x27,~#$urxvt::NOCHAR]*
      (
         \([\w\-\@;\/?:&=%\$.+!*\x27,~#$urxvt::NOCHAR]*\)| # 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->locale_decode ($self->my_resource ("pattern.$idx")) || $defaults[$idx]); $idx++) {
      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 ($row - ($self->nrow >> 1));
         $self->want_refresh;
         return 1;
      }

      $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;
      }
   } elsif ($self->lookup_keysym ($keysym, $event->{state}) eq "matcher:select") {
      if ($self->{id} > 0) {
         $self->{id}--;
         $self->want_refresh;
      } else {
         my $line = $self->line ($self->{cur_row});
         $self->select_search (-1, $self->nrow - 1)
            unless $self->select_search (-1, $line->beg - 1);
      }
   }

   1
}

# vim:set sw=3 sts=3 et:
Revision:	1.39
Committed:	Sun Nov 21 19:33:32 2021 UTC (2 years, 5 months ago) by root
Branch:	MAIN
CVS Tags:	rxvt-unicode-rel-9_29, rxvt-unicode-rel-9_30
Changes since 1.38:	+30 -0 lines
Log Message:	* empty log message *
#	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.35	The C<matcher:select> action enables a mode in which it is possible to
38	sf-exg	1.31	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	root	1.37	=over
43	sf-exg	1.31
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	sf-exg	1.35	It is also possible to cycle through the matches using a key
75			combination bound to the C<matcher:select> action.
76
77	root	1.14	Example: load and use the matcher extension with defaults.
78	root	1.10
79			URxvt.perl-ext: default,matcher
80	root	1.14
81			Example: use a custom configuration.
82
83	root	1.10	URxvt.url-launcher: sensible-browser
84	sf-exg	1.20	URxvt.keysym.C-Delete: matcher:last
85			URxvt.keysym.M-Delete: matcher:list
86	root	1.10	URxvt.matcher.button: 1
87			URxvt.matcher.pattern.1: \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-]
88			URxvt.matcher.pattern.2: \\B(/\\S+?):(\\d+)(?=:\|$)
89			URxvt.matcher.launcher.2: gvim +$2 $1
90
91	root	1.39	=head2 Regex encoding/wide character matching
92
93			Urxvt stores all text as unicode, in a special encoding that uses
94			one character/code point per column. For various reasons, the regular
95			expressions are matched directly against this encoding, which means there are a few things
96			you need to keep in mind:
97
98			=over
99
100			=item X resources/command line arguments are locale-encoded
101
102			The regexes taken from the command line or resources will be converted
103			from locale encoding to unicode. This can change the number of code points
104			per character.
105
106			=item Wide characters are column-padded with C<$urxvt::NOCHAR>
107
108			Wide characters (such as kanji and sometimes tabs) are padded with
109			a special character value (C<$urxvt::NOCHAR>). That means that
110			constructs such as C<\w> or C<.> will only match part of a character, as
111			C<$urxvt::NOCHAR> is not matched by C<\w> and both only match the first
112			"column" of a wide character.
113
114			That means you have to incorporate C<$urxvt::NOCHAR> into parts of regexes
115			that may match wide characters. For example, to match C<\w+> you might
116			want to use C<[\w$urxvt::NOCHAR]+> instead, and to match a single character
117			(C<.>) you might want to use C<.$urxvt::NOCHAR*> instead.
118
119			=back
120
121	root	1.10	=cut
122
123	root	1.1	my $url =
124			qr{
125	tpope	1.2	(?:https?://\|ftp://\|news://\|mailto:\|file://\|\bwww\.)
126	sf-exg	1.38	[\w\-\@;\/?:&=%\$.+!\x27,~#$urxvt::NOCHAR]
127	tpope	1.2	(
128	sf-exg	1.38	\([\w\-\@;\/?:&=%\$.+!\x27,~#$urxvt::NOCHAR]\)\| # Allow a pair of matched parentheses
129	sf-tpope	1.12	[\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic)
130	tpope	1.2	)+
131	root	1.1	}x;
132
133	sf-exg	1.26	sub matchlist_key_press {
134	sf-tpope	1.6	my ($self, $event, $keysym, $octets) = @_;
135
136	sf-exg	1.18	delete $self->{overlay};
137	sf-exg	1.26	$self->disable ("key_press");
138	sf-tpope	1.6
139			my $i = ($keysym == 96 ? 0 : $keysym - 48);
140	sf-exg	1.18	if ($i >= 0 && $i < @{ $self->{matches} }) {
141			my @exec = @{ $self->{matches}[$i] };
142	sf-exg	1.26	$self->exec_async (@exec[5 .. $#exec]);
143	sf-tpope	1.6	}
144
145	sf-exg	1.18	1
146	sf-tpope	1.6	}
147
148	root	1.14	# backwards compat
149	tpope	1.4	sub on_user_command {
150			my ($self, $cmd) = @_;
151	sf-tpope	1.6
152	sf-exg	1.34	if ($cmd eq "matcher:list") {
153	root	1.14	$self->matchlist;
154	sf-exg	1.34	} elsif ($cmd eq "matcher:last") {
155			$self->most_recent;
156			} elsif ($cmd eq "matcher:select") {
157			$self->select_enter;
158			} elsif ($cmd eq "matcher") {
159			# for backward compatibility
160			$self->most_recent;
161	tpope	1.4	}
162	root	1.14
163	tpope	1.4	()
164			}
165
166	sf-exg	1.20	sub on_action {
167			my ($self, $action) = @_;
168
169			if ($action eq "list") {
170			$self->matchlist;
171			} elsif ($action eq "last") {
172			$self->most_recent;
173	sf-exg	1.31	} elsif ($action eq "select") {
174			$self->select_enter;
175	sf-exg	1.20	}
176
177			()
178			}
179
180	sf-tpope	1.6	sub matchlist {
181			my ($self) = @_;
182	sf-exg	1.17
183	sf-exg	1.26	$self->{matches} = [];
184	sf-exg	1.18	my $row = $self->nrow - 1;
185			while ($row >= 0 && @{ $self->{matches} } < 10) {
186			my $line = $self->line ($row);
187	sf-exg	1.24	my @matches = $self->find_matches ($row);
188	sf-exg	1.17
189	sf-exg	1.26	for (sort { $b->[0] <=> $a->[0] or $b->[1] <=> $a->[1] } @matches) {
190	sf-exg	1.19	push @{ $self->{matches} }, $_;
191			last if @{ $self->{matches} } == 10;
192			}
193
194	sf-exg	1.18	$row = $line->beg - 1;
195			}
196	sf-exg	1.17
197	sf-exg	1.18	return unless @{ $self->{matches} };
198	sf-exg	1.17
199	sf-exg	1.18	my $width = 0;
200	sf-exg	1.17
201	sf-exg	1.18	my $i = 0;
202			for my $match (@{ $self->{matches} }) {
203	sf-exg	1.26	my $text = $match->[4];
204	sf-exg	1.18	my $w = $self->strwidth ("$i-$text");
205	sf-exg	1.17
206	sf-exg	1.18	$width = $w if $w > $width;
207			$i++;
208	sf-exg	1.17	}
209
210	sf-exg	1.18	$width = $self->ncol - 2 if $width > $self->ncol - 2;
211	sf-exg	1.17
212	sf-exg	1.18	$self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2);
213	sf-exg	1.17	my $i = 0;
214	sf-exg	1.18	for my $match (@{ $self->{matches} }) {
215	sf-exg	1.26	my $text = $match->[4];
216	sf-exg	1.18
217			$self->{overlay}->set (0, $i, "$i-$text");
218	sf-exg	1.17	$i++;
219			}
220	sf-tpope	1.6
221	sf-exg	1.26	$self->enable (key_press => \&matchlist_key_press);
222	sf-tpope	1.6	}
223
224	tpope	1.4	sub most_recent {
225			my ($self) = shift;
226	sf-exg	1.32	my $row = $self->nrow - 1;
227	tpope	1.4	my @exec;
228	sf-exg	1.32	while ($row >= $self->top_row) {
229			my $line = $self->line ($row);
230	tpope	1.4	@exec = $self->command_for($row);
231			last if(@exec);
232	sf-exg	1.32
233			$row = $line->beg - 1;
234	tpope	1.4	}
235			if(@exec) {
236			return $self->exec_async (@exec);
237			}
238			()
239			}
240	tpope	1.2
241	root	1.1	sub my_resource {
242	root	1.9	$_[0]->x_resource ("%.$_[1]")
243	root	1.1	}
244
245	tpope	1.2	# turn a rendition spec in the resource into a sub that implements it on $_
246			sub parse_rend {
247			my ($self, $str) = @_;
248	sf-tpope	1.6	my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
249	tpope	1.2	: (urxvt::RS_Uline, undef, undef, []);
250			warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
251			my @rend;
252			push @rend, sub { $_ \|= $mask } if $mask;
253			push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
254			push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
255			sub {
256			for my $s ( @rend ) { &$s };
257			}
258			}
259
260	root	1.1	sub on_start {
261			my ($self) = @_;
262
263	root	1.8	$self->{launcher} = $self->my_resource ("launcher") \|\| $self->x_resource("url-launcher") \|\| "sensible-browser";
264	root	1.1
265			$self->{button} = 2;
266			$self->{state} = 0;
267	root	1.8	if($self->{argv}[0] \|\| $self->my_resource ("button")) {
268			my @mods = split '', $self->{argv}[0] \|\| $self->my_resource ("button");
269	root	1.1	for my $mod (@mods) {
270			if($mod =~ /^\d+$/) {
271			$self->{button} = $mod;
272			} elsif($mod eq "C") {
273			$self->{state} \|= urxvt::ControlMask;
274			} elsif($mod eq "S") {
275			$self->{state} \|= urxvt::ShiftMask;
276			} elsif($mod eq "M") {
277			$self->{state} \|= $self->ModMetaMask;
278			} elsif($mod ne "-" && $mod ne " ") {
279	root	1.9	warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
280	root	1.1	}
281			}
282			}
283
284			my @defaults = ($url);
285			my @matchers;
286	sf-exg	1.38	for (my $idx = 0; defined (my $res = $self->locale_decode ($self->my_resource ("pattern.$idx")) \|\| $defaults[$idx]); $idx++) {
287	root	1.8	my $launcher = $self->my_resource ("launcher.$idx");
288			$launcher =~ s/\$&\|\$\{&\}/\${0}/g if $launcher;
289			my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
290	tpope	1.2	unshift @matchers, [qr($res)x,$launcher,$rend];
291	root	1.1	}
292			$self->{matchers} = \@matchers;
293
294			()
295			}
296
297			sub on_line_update {
298			my ($self, $row) = @_;
299
300			# fetch the line that has changed
301			my $line = $self->line ($row);
302			my $text = $line->t;
303	sf-exg	1.33	my $rend;
304	root	1.1
305			# find all urls (if any)
306			for my $matcher (@{$self->{matchers}}) {
307			while ($text =~ /$matcher->[0]/g) {
308	tpope	1.2	#print "$&\n";
309	sf-exg	1.33	$rend \|\|= $line->r;
310	root	1.1
311			# mark all characters as underlined. we _must_ not toggle underline,
312			# as we might get called on an already-marked url.
313	tpope	1.2	&{$matcher->[2]}
314	sf-exg	1.30	for @{$rend}[$-[0] .. $+[0] - 1];
315	root	1.1	}
316			}
317
318	sf-exg	1.33	$line->r ($rend) if $rend;
319
320	root	1.1	()
321			}
322
323			sub valid_button {
324			my ($self, $event) = @_;
325			my $mask = $self->ModLevel3Mask \| $self->ModMetaMask
326			\| urxvt::ShiftMask \| urxvt::ControlMask;
327			return ($event->{button} == $self->{button} &&
328			($event->{state} & $mask) == $self->{state});
329			}
330
331	sf-exg	1.21	sub find_matches {
332	root	1.1	my ($self, $row, $col) = @_;
333			my $line = $self->line ($row);
334			my $text = $line->t;
335	sf-exg	1.29	my $off = $line->offset_of ($row, $col) if defined $col;
336	root	1.1
337	sf-exg	1.21	my @matches;
338	root	1.1	for my $matcher (@{$self->{matchers}}) {
339			my $launcher = $matcher->[1] \|\| $self->{launcher};
340	sf-exg	1.22	while ($text =~ /$matcher->[0]/g) {
341	sf-exg	1.21	my $match = substr $text, $-[0], $+[0] - $-[0];
342	root	1.1	my @begin = @-;
343			my @end = @+;
344	sf-exg	1.21	my @exec;
345
346	sf-exg	1.25	if (!defined($off) \|\| ($-[0] <= $off && $+[0] >= $off)) {
347	root	1.1	if ($launcher !~ /\$/) {
348	sf-exg	1.21	@exec = ($launcher, $match);
349	root	1.1	} else {
350			# It'd be nice to just access a list like ($&,$1,$2...),
351			# but alas, m//g behaves differently in list context.
352	sf-exg	1.21	@exec = map { s/\$(\d+)\|\$\{(\d+)\}/
353	sf-exg	1.23	substr $text, $begin[$1 \|\| $2], $end[$1 \|\| $2] - $begin[$1 \|\| $2]
354	sf-exg	1.22	/egx; $_ } split /\s+/, $launcher;
355	root	1.1	}
356	sf-exg	1.21
357	sf-exg	1.26	push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
358	root	1.1	}
359			}
360			}
361
362	sf-exg	1.21	@matches;
363			}
364
365			sub command_for {
366			my ($self, $row, $col) = @_;
367
368			my @matches = $self->find_matches ($row, $col);
369			if (@matches) {
370			my @match = @{ $matches[0] };
371	sf-exg	1.26	return @match[5 .. $#match];
372	sf-exg	1.21	}
373
374	root	1.1	()
375			}
376
377			sub on_button_press {
378			my ($self, $event) = @_;
379	sf-tpope	1.5	if($self->valid_button($event)
380			&& (my @exec = $self->command_for($event->{row},$event->{col}))) {
381	root	1.1	$self->{row} = $event->{row};
382			$self->{col} = $event->{col};
383	sf-tpope	1.5	$self->{cmd} = \@exec;
384			return 1;
385	root	1.1	} else {
386			delete $self->{row};
387			delete $self->{col};
388	sf-tpope	1.5	delete $self->{cmd};
389	root	1.1	}
390
391			()
392			}
393
394			sub on_button_release {
395			my ($self, $event) = @_;
396
397			my $row = delete $self->{row};
398			my $col = delete $self->{col};
399	sf-tpope	1.5	my $cmd = delete $self->{cmd};
400	root	1.1
401	sf-tpope	1.5	return if !defined $row;
402
403			if($row == $event->{row} && abs($col-$event->{col}) < 2
404			&& join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
405	root	1.1	if($self->valid_button($event)) {
406
407	sf-exg	1.17	$self->exec_async (@$cmd);
408	root	1.1
409			}
410			}
411
412	sf-tpope	1.5	1;
413	root	1.1	}
414
415	sf-exg	1.31	sub select_enter {
416			my ($self) = @_;
417
418			$self->{view_start} = $self->view_start;
419			$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
420			$self->{cur_row} = $self->nrow - 1;
421
422			$self->enable (
423			key_press => \&select_key_press,
424			refresh_begin => \&select_refresh,
425			refresh_end => \&select_refresh,
426			);
427
428			$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
429			$self->{overlay}->set (0, 0, "match-select");
430			}
431
432			sub select_leave {
433			my ($self) = @_;
434
435			$self->disable ("key_press", "refresh_begin", "refresh_end");
436			$self->pty_ev_events ($self->{pty_ev_events});
437
438			delete $self->{overlay};
439			delete $self->{matches};
440			delete $self->{id};
441			}
442
443			sub select_search {
444			my ($self, $dir, $row) = @_;
445
446			while ($self->nrow > $row && $row >= $self->top_row) {
447			my $line = $self->line ($row)
448			or last;
449
450			my @matches = $self->find_matches ($row);
451			if (@matches) {
452			@matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
453			$self->{matches} = \@matches;
454			$self->{cur_row} = $row;
455			$self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
456	sf-exg	1.36	$self->view_start ($row - ($self->nrow >> 1));
457	sf-exg	1.31	$self->want_refresh;
458	sf-exg	1.35	return 1;
459	sf-exg	1.31	}
460
461			$row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
462			}
463
464			$self->scr_bell;
465	sf-exg	1.35
466			()
467	sf-exg	1.31	}
468
469			sub select_refresh {
470			my ($self) = @_;
471
472			return unless $self->{matches};
473
474			my $cur = $self->{matches}[$self->{id}];
475			$self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
476
477			()
478			}
479
480			sub select_key_press {
481			my ($self, $event, $keysym, $string) = @_;
482
483			if ($keysym == 0xff0d \|\| $keysym == 0xff8d) { # enter
484			if ($self->{matches}) {
485			my @match = @{ $self->{matches}[$self->{id}] };
486			$self->exec_async (@match[5 .. $#match]);
487			}
488			$self->select_leave;
489			} elsif ($keysym == 0x79) { # y
490			if ($self->{matches}) {
491			$self->selection ($self->{matches}[$self->{id}][4], 1);
492			$self->selection_grab (urxvt::CurrentTime, 1);
493			}
494			$self->select_leave;
495			} elsif ($keysym == 0xff1b) { # escape
496			$self->view_start ($self->{view_start});
497			$self->select_leave;
498			} elsif ($keysym == 0xff50) { # home
499			$self->select_search (+1, $self->top_row)
500			} elsif ($keysym == 0xff57) { # end
501			$self->select_search (-1, $self->nrow - 1)
502			} elsif ($keysym == 0xff52) { # up
503			if ($self->{id} > 0) {
504			$self->{id}--;
505			$self->want_refresh;
506			} else {
507			my $line = $self->line ($self->{cur_row});
508			$self->select_search (-1, $line->beg - 1)
509			if $line->beg > $self->top_row;
510			}
511			} elsif ($keysym == 0xff54) { # down
512			if ($self->{id} < @{ $self->{matches} } - 1) {
513			$self->{id}++;
514			$self->want_refresh;
515			} else {
516			my $line = $self->line ($self->{cur_row});
517			$self->select_search (+1, $line->end + 1)
518			if $line->end < $self->nrow;
519			}
520	sf-exg	1.35	} elsif ($self->lookup_keysym ($keysym, $event->{state}) eq "matcher:select") {
521			if ($self->{id} > 0) {
522			$self->{id}--;
523			$self->want_refresh;
524			} else {
525			my $line = $self->line ($self->{cur_row});
526			$self->select_search (-1, $self->nrow - 1)
527			unless $self->select_search (-1, $line->beg - 1);
528			}
529	sf-exg	1.31	}
530
531			1
532			}
533
534	root	1.1	# vim:set sw=3 sts=3 et: