[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.40
Committed:	Fri Dec 9 05:06:46 2022 UTC (17 months ago) by root
Branch:	MAIN
Changes since 1.39:	+27 -17 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.40	with the matched text as first argument. The default configuration is
25	root	1.10	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	root	1.40	from the keyboard. Simply bind a keysym to "matcher:last" or
35	sf-exg	1.20	"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	root	1.40
229	sf-exg	1.32	while ($row >= $self->top_row) {
230			my $line = $self->line ($row);
231	root	1.40	@exec = $self->command_for ($row);
232			last if @exec;
233	sf-exg	1.32
234			$row = $line->beg - 1;
235	tpope	1.4	}
236	root	1.40
237			if (@exec) {
238	tpope	1.4	return $self->exec_async (@exec);
239			}
240	root	1.40
241	tpope	1.4	()
242			}
243	tpope	1.2
244	root	1.1	sub my_resource {
245	root	1.9	$_[0]->x_resource ("%.$_[1]")
246	root	1.1	}
247
248	tpope	1.2	# turn a rendition spec in the resource into a sub that implements it on $_
249			sub parse_rend {
250			my ($self, $str) = @_;
251	sf-tpope	1.6	my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
252	tpope	1.2	: (urxvt::RS_Uline, undef, undef, []);
253			warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
254			my @rend;
255			push @rend, sub { $_ \|= $mask } if $mask;
256			push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
257			push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
258			sub {
259			for my $s ( @rend ) { &$s };
260			}
261			}
262
263	root	1.1	sub on_start {
264			my ($self) = @_;
265
266	root	1.8	$self->{launcher} = $self->my_resource ("launcher") \|\| $self->x_resource("url-launcher") \|\| "sensible-browser";
267	root	1.1
268			$self->{button} = 2;
269			$self->{state} = 0;
270	root	1.8	if($self->{argv}[0] \|\| $self->my_resource ("button")) {
271			my @mods = split '', $self->{argv}[0] \|\| $self->my_resource ("button");
272	root	1.1	for my $mod (@mods) {
273			if($mod =~ /^\d+$/) {
274			$self->{button} = $mod;
275			} elsif($mod eq "C") {
276			$self->{state} \|= urxvt::ControlMask;
277			} elsif($mod eq "S") {
278			$self->{state} \|= urxvt::ShiftMask;
279			} elsif($mod eq "M") {
280			$self->{state} \|= $self->ModMetaMask;
281			} elsif($mod ne "-" && $mod ne " ") {
282	root	1.9	warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
283	root	1.1	}
284			}
285			}
286
287			my @defaults = ($url);
288			my @matchers;
289	sf-exg	1.38	for (my $idx = 0; defined (my $res = $self->locale_decode ($self->my_resource ("pattern.$idx")) \|\| $defaults[$idx]); $idx++) {
290	root	1.8	my $launcher = $self->my_resource ("launcher.$idx");
291			$launcher =~ s/\$&\|\$\{&\}/\${0}/g if $launcher;
292			my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
293	tpope	1.2	unshift @matchers, [qr($res)x,$launcher,$rend];
294	root	1.1	}
295			$self->{matchers} = \@matchers;
296
297			()
298			}
299
300			sub on_line_update {
301			my ($self, $row) = @_;
302
303			# fetch the line that has changed
304			my $line = $self->line ($row);
305			my $text = $line->t;
306	sf-exg	1.33	my $rend;
307	root	1.1
308			# find all urls (if any)
309			for my $matcher (@{$self->{matchers}}) {
310			while ($text =~ /$matcher->[0]/g) {
311	tpope	1.2	#print "$&\n";
312	sf-exg	1.33	$rend \|\|= $line->r;
313	root	1.1
314			# mark all characters as underlined. we _must_ not toggle underline,
315			# as we might get called on an already-marked url.
316	tpope	1.2	&{$matcher->[2]}
317	sf-exg	1.30	for @{$rend}[$-[0] .. $+[0] - 1];
318	root	1.1	}
319			}
320
321	sf-exg	1.33	$line->r ($rend) if $rend;
322
323	root	1.1	()
324			}
325
326			sub valid_button {
327			my ($self, $event) = @_;
328			my $mask = $self->ModLevel3Mask \| $self->ModMetaMask
329			\| urxvt::ShiftMask \| urxvt::ControlMask;
330			return ($event->{button} == $self->{button} &&
331			($event->{state} & $mask) == $self->{state});
332			}
333
334	sf-exg	1.21	sub find_matches {
335	root	1.1	my ($self, $row, $col) = @_;
336			my $line = $self->line ($row);
337			my $text = $line->t;
338	sf-exg	1.29	my $off = $line->offset_of ($row, $col) if defined $col;
339	root	1.1
340	sf-exg	1.21	my @matches;
341	root	1.1	for my $matcher (@{$self->{matchers}}) {
342			my $launcher = $matcher->[1] \|\| $self->{launcher};
343	sf-exg	1.22	while ($text =~ /$matcher->[0]/g) {
344	sf-exg	1.21	my $match = substr $text, $-[0], $+[0] - $-[0];
345	root	1.1	my @begin = @-;
346			my @end = @+;
347	sf-exg	1.21	my @exec;
348
349	root	1.40	if (!(defined $off) \|\| ($-[0] <= $off && $+[0] >= $off)) {
350	root	1.1	if ($launcher !~ /\$/) {
351	sf-exg	1.21	@exec = ($launcher, $match);
352	root	1.1	} else {
353			# It'd be nice to just access a list like ($&,$1,$2...),
354			# but alas, m//g behaves differently in list context.
355	root	1.40	@exec = map {
356			s{\$(\d+)\|\$\{(\d+)\}}{
357			substr $text, $begin[$1 \|\| $2], $end[$1 \|\| $2] - $begin[$1 \|\| $2]
358			}egx;
359			$_
360			} split /\s+/, $launcher;
361	root	1.1	}
362	sf-exg	1.21
363	sf-exg	1.26	push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
364	root	1.1	}
365			}
366			}
367
368	root	1.40	@matches
369	sf-exg	1.21	}
370
371			sub command_for {
372			my ($self, $row, $col) = @_;
373
374			my @matches = $self->find_matches ($row, $col);
375			if (@matches) {
376			my @match = @{ $matches[0] };
377	sf-exg	1.26	return @match[5 .. $#match];
378	sf-exg	1.21	}
379
380	root	1.1	()
381			}
382
383			sub on_button_press {
384			my ($self, $event) = @_;
385	root	1.40
386			if (
387			$self->valid_button ($event)
388			&& (my @exec = $self->command_for ($event->{row}, $event->{col}))
389			) {
390	root	1.1	$self->{row} = $event->{row};
391			$self->{col} = $event->{col};
392	sf-tpope	1.5	$self->{cmd} = \@exec;
393			return 1;
394	root	1.1	} else {
395			delete $self->{row};
396			delete $self->{col};
397	sf-tpope	1.5	delete $self->{cmd};
398	root	1.1	}
399
400			()
401			}
402
403			sub on_button_release {
404			my ($self, $event) = @_;
405
406			my $row = delete $self->{row};
407			my $col = delete $self->{col};
408	sf-tpope	1.5	my $cmd = delete $self->{cmd};
409	root	1.1
410	sf-tpope	1.5	return if !defined $row;
411
412	root	1.40	if (
413			$row == $event->{row}
414			&& (abs $col-$event->{col}) < 2
415			&& (join "\x00", @$cmd) eq (join "\x00", $self->command_for ($row, $col))
416			) {
417			if ($self->valid_button ($event)) {
418	sf-exg	1.17	$self->exec_async (@$cmd);
419	root	1.1	}
420			}
421
422	sf-tpope	1.5	1;
423	root	1.1	}
424
425	sf-exg	1.31	sub select_enter {
426			my ($self) = @_;
427
428			$self->{view_start} = $self->view_start;
429			$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
430			$self->{cur_row} = $self->nrow - 1;
431
432			$self->enable (
433			key_press => \&select_key_press,
434			refresh_begin => \&select_refresh,
435			refresh_end => \&select_refresh,
436			);
437
438			$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
439			$self->{overlay}->set (0, 0, "match-select");
440			}
441
442			sub select_leave {
443			my ($self) = @_;
444
445			$self->disable ("key_press", "refresh_begin", "refresh_end");
446			$self->pty_ev_events ($self->{pty_ev_events});
447
448			delete $self->{overlay};
449			delete $self->{matches};
450			delete $self->{id};
451			}
452
453			sub select_search {
454			my ($self, $dir, $row) = @_;
455
456			while ($self->nrow > $row && $row >= $self->top_row) {
457			my $line = $self->line ($row)
458			or last;
459
460			my @matches = $self->find_matches ($row);
461			if (@matches) {
462			@matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
463			$self->{matches} = \@matches;
464			$self->{cur_row} = $row;
465			$self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
466	sf-exg	1.36	$self->view_start ($row - ($self->nrow >> 1));
467	sf-exg	1.31	$self->want_refresh;
468	sf-exg	1.35	return 1;
469	sf-exg	1.31	}
470
471			$row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
472			}
473
474			$self->scr_bell;
475	sf-exg	1.35
476			()
477	sf-exg	1.31	}
478
479			sub select_refresh {
480			my ($self) = @_;
481
482			return unless $self->{matches};
483
484			my $cur = $self->{matches}[$self->{id}];
485			$self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
486
487			()
488			}
489
490			sub select_key_press {
491			my ($self, $event, $keysym, $string) = @_;
492
493			if ($keysym == 0xff0d \|\| $keysym == 0xff8d) { # enter
494			if ($self->{matches}) {
495			my @match = @{ $self->{matches}[$self->{id}] };
496			$self->exec_async (@match[5 .. $#match]);
497			}
498			$self->select_leave;
499			} elsif ($keysym == 0x79) { # y
500			if ($self->{matches}) {
501			$self->selection ($self->{matches}[$self->{id}][4], 1);
502			$self->selection_grab (urxvt::CurrentTime, 1);
503			}
504			$self->select_leave;
505			} elsif ($keysym == 0xff1b) { # escape
506			$self->view_start ($self->{view_start});
507			$self->select_leave;
508			} elsif ($keysym == 0xff50) { # home
509			$self->select_search (+1, $self->top_row)
510			} elsif ($keysym == 0xff57) { # end
511			$self->select_search (-1, $self->nrow - 1)
512			} elsif ($keysym == 0xff52) { # up
513			if ($self->{id} > 0) {
514			$self->{id}--;
515			$self->want_refresh;
516			} else {
517			my $line = $self->line ($self->{cur_row});
518			$self->select_search (-1, $line->beg - 1)
519			if $line->beg > $self->top_row;
520			}
521			} elsif ($keysym == 0xff54) { # down
522			if ($self->{id} < @{ $self->{matches} } - 1) {
523			$self->{id}++;
524			$self->want_refresh;
525			} else {
526			my $line = $self->line ($self->{cur_row});
527			$self->select_search (+1, $line->end + 1)
528			if $line->end < $self->nrow;
529			}
530	sf-exg	1.35	} elsif ($self->lookup_keysym ($keysym, $event->{state}) eq "matcher:select") {
531			if ($self->{id} > 0) {
532			$self->{id}--;
533			$self->want_refresh;
534			} else {
535			my $line = $self->line ($self->{cur_row});
536			$self->select_search (-1, $self->nrow - 1)
537			unless $self->select_search (-1, $line->beg - 1);
538			}
539	sf-exg	1.31	}
540
541			1
542			}
543
544	root	1.1	# vim:set sw=3 sts=3 et: