[ViewVC] Annotation of: cvs/cvsroot/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) = @_;
   my $row = $self->nrow - 1;

   while ($row >= $self->top_row) {
      my $line = $self->line ($row);
      my @exec = $self->command_for ($row);
      if (@exec) {
         return $self->exec_async (@exec);
      }

      $row = $line->beg - 1;
   }

   ()
}

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.41
Committed:	Sun May 28 10:40:41 2023 UTC (3 years, 4 months ago) by sf-exg
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.40:	+5 -8 lines
Log Message:	matcher: simplify
#	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	sf-exg	1.41	my ($self) = @_;
226	sf-exg	1.32	my $row = $self->nrow - 1;
227	root	1.40
228	sf-exg	1.32	while ($row >= $self->top_row) {
229			my $line = $self->line ($row);
230	sf-exg	1.41	my @exec = $self->command_for ($row);
231			if (@exec) {
232			return $self->exec_async (@exec);
233			}
234	sf-exg	1.32
235			$row = $line->beg - 1;
236	tpope	1.4	}
237	root	1.40
238	tpope	1.4	()
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	root	1.40	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	root	1.40	@exec = map {
353			s{\$(\d+)\|\$\{(\d+)\}}{
354			substr $text, $begin[$1 \|\| $2], $end[$1 \|\| $2] - $begin[$1 \|\| $2]
355			}egx;
356			$_
357			} split /\s+/, $launcher;
358	root	1.1	}
359	sf-exg	1.21
360	sf-exg	1.26	push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
361	root	1.1	}
362			}
363			}
364
365	root	1.40	@matches
366	sf-exg	1.21	}
367
368			sub command_for {
369			my ($self, $row, $col) = @_;
370
371			my @matches = $self->find_matches ($row, $col);
372			if (@matches) {
373			my @match = @{ $matches[0] };
374	sf-exg	1.26	return @match[5 .. $#match];
375	sf-exg	1.21	}
376
377	root	1.1	()
378			}
379
380			sub on_button_press {
381			my ($self, $event) = @_;
382	root	1.40
383			if (
384			$self->valid_button ($event)
385			&& (my @exec = $self->command_for ($event->{row}, $event->{col}))
386			) {
387	root	1.1	$self->{row} = $event->{row};
388			$self->{col} = $event->{col};
389	sf-tpope	1.5	$self->{cmd} = \@exec;
390			return 1;
391	root	1.1	} else {
392			delete $self->{row};
393			delete $self->{col};
394	sf-tpope	1.5	delete $self->{cmd};
395	root	1.1	}
396
397			()
398			}
399
400			sub on_button_release {
401			my ($self, $event) = @_;
402
403			my $row = delete $self->{row};
404			my $col = delete $self->{col};
405	sf-tpope	1.5	my $cmd = delete $self->{cmd};
406	root	1.1
407	sf-tpope	1.5	return if !defined $row;
408
409	root	1.40	if (
410			$row == $event->{row}
411			&& (abs $col-$event->{col}) < 2
412			&& (join "\x00", @$cmd) eq (join "\x00", $self->command_for ($row, $col))
413			) {
414			if ($self->valid_button ($event)) {
415	sf-exg	1.17	$self->exec_async (@$cmd);
416	root	1.1	}
417			}
418
419	sf-tpope	1.5	1;
420	root	1.1	}
421
422	sf-exg	1.31	sub select_enter {
423			my ($self) = @_;
424
425			$self->{view_start} = $self->view_start;
426			$self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
427			$self->{cur_row} = $self->nrow - 1;
428
429			$self->enable (
430			key_press => \&select_key_press,
431			refresh_begin => \&select_refresh,
432			refresh_end => \&select_refresh,
433			);
434
435			$self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
436			$self->{overlay}->set (0, 0, "match-select");
437			}
438
439			sub select_leave {
440			my ($self) = @_;
441
442			$self->disable ("key_press", "refresh_begin", "refresh_end");
443			$self->pty_ev_events ($self->{pty_ev_events});
444
445			delete $self->{overlay};
446			delete $self->{matches};
447			delete $self->{id};
448			}
449
450			sub select_search {
451			my ($self, $dir, $row) = @_;
452
453			while ($self->nrow > $row && $row >= $self->top_row) {
454			my $line = $self->line ($row)
455			or last;
456
457			my @matches = $self->find_matches ($row);
458			if (@matches) {
459			@matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
460			$self->{matches} = \@matches;
461			$self->{cur_row} = $row;
462			$self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
463	sf-exg	1.36	$self->view_start ($row - ($self->nrow >> 1));
464	sf-exg	1.31	$self->want_refresh;
465	sf-exg	1.35	return 1;
466	sf-exg	1.31	}
467
468			$row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
469			}
470
471			$self->scr_bell;
472	sf-exg	1.35
473			()
474	sf-exg	1.31	}
475
476			sub select_refresh {
477			my ($self) = @_;
478
479			return unless $self->{matches};
480
481			my $cur = $self->{matches}[$self->{id}];
482			$self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
483
484			()
485			}
486
487			sub select_key_press {
488			my ($self, $event, $keysym, $string) = @_;
489
490			if ($keysym == 0xff0d \|\| $keysym == 0xff8d) { # enter
491			if ($self->{matches}) {
492			my @match = @{ $self->{matches}[$self->{id}] };
493			$self->exec_async (@match[5 .. $#match]);
494			}
495			$self->select_leave;
496			} elsif ($keysym == 0x79) { # y
497			if ($self->{matches}) {
498			$self->selection ($self->{matches}[$self->{id}][4], 1);
499			$self->selection_grab (urxvt::CurrentTime, 1);
500			}
501			$self->select_leave;
502			} elsif ($keysym == 0xff1b) { # escape
503			$self->view_start ($self->{view_start});
504			$self->select_leave;
505			} elsif ($keysym == 0xff50) { # home
506			$self->select_search (+1, $self->top_row)
507			} elsif ($keysym == 0xff57) { # end
508			$self->select_search (-1, $self->nrow - 1)
509			} elsif ($keysym == 0xff52) { # up
510			if ($self->{id} > 0) {
511			$self->{id}--;
512			$self->want_refresh;
513			} else {
514			my $line = $self->line ($self->{cur_row});
515			$self->select_search (-1, $line->beg - 1)
516			if $line->beg > $self->top_row;
517			}
518			} elsif ($keysym == 0xff54) { # down
519			if ($self->{id} < @{ $self->{matches} } - 1) {
520			$self->{id}++;
521			$self->want_refresh;
522			} else {
523			my $line = $self->line ($self->{cur_row});
524			$self->select_search (+1, $line->end + 1)
525			if $line->end < $self->nrow;
526			}
527	sf-exg	1.35	} elsif ($self->lookup_keysym ($keysym, $event->{state}) eq "matcher:select") {
528			if ($self->{id} > 0) {
529			$self->{id}--;
530			$self->want_refresh;
531			} else {
532			my $line = $self->line ($self->{cur_row});
533			$self->select_search (-1, $self->nrow - 1)
534			unless $self->select_search (-1, $line->beg - 1);
535			}
536	sf-exg	1.31	}
537
538			1
539			}
540
541	root	1.1	# vim:set sw=3 sts=3 et: