[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

=cut

my $url =
   qr{
      (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
      [\w\-\@;\/?:&=%\$.+!*\x27,~#]*
      (
         \([\w\-\@;\/?:&=%\$.+!*\x27,~#]*\)| # Allow a pair of matched parentheses
         [\w\-\@;\/?:&=%\$+*~]  # exclude some trailing characters (heuristic)
      )+
   }x;

sub matchlist_key_press {
   my ($self, $event, $keysym, $octets) = @_;

   delete $self->{overlay};
   $self->disable ("key_press");

   my $i = ($keysym == 96 ? 0 : $keysym - 48);
   if ($i >= 0 && $i < @{ $self->{matches} }) {
      my @exec = @{ $self->{matches}[$i] };
      $self->exec_async (@exec[5 .. $#exec]);
   }

   1
}

# backwards compat
sub on_user_command {
   my ($self, $cmd) = @_;

   if ($cmd eq "matcher:list") {
      $self->matchlist;
   } elsif ($cmd eq "matcher:last") {
      $self->most_recent;
   } elsif ($cmd eq "matcher:select") {
      $self->select_enter;
   } elsif ($cmd eq "matcher") {
      # for backward compatibility
      $self->most_recent;
   }

   ()
}

sub on_action {
   my ($self, $action) = @_;

   if ($action eq "list") {
      $self->matchlist;
   } elsif ($action eq "last") {
      $self->most_recent;
   } elsif ($action eq "select") {
      $self->select_enter;
   }

   ()
}

sub matchlist {
   my ($self) = @_;

   $self->{matches} = [];
   my $row = $self->nrow - 1;
   while ($row >= 0 && @{ $self->{matches} } < 10) {
      my $line = $self->line ($row);
      my @matches = $self->find_matches ($row);

      for (sort { $b->[0] <=> $a->[0] or $b->[1] <=> $a->[1] } @matches) {
         push @{ $self->{matches} }, $_;
         last if @{ $self->{matches} } == 10;
      }

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

   return unless @{ $self->{matches} };

   my $width = 0;

   my $i = 0;
   for my $match (@{ $self->{matches} }) {
      my $text = $match->[4];
      my $w = $self->strwidth ("$i-$text");

      $width = $w if $w > $width;
      $i++;
   }

   $width = $self->ncol - 2 if $width > $self->ncol - 2;

   $self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2);
   my $i = 0;
   for my $match (@{ $self->{matches} }) {
      my $text = $match->[4];

      $self->{overlay}->set (0, $i, "$i-$text");
      $i++;
   }

   $self->enable (key_press => \&matchlist_key_press);
}

sub most_recent {
   my ($self) = shift;
   my $row = $self->nrow - 1;
   my @exec;
   while ($row >= $self->top_row) {
      my $line = $self->line ($row);
      @exec = $self->command_for($row);
      last if(@exec);

      $row = $line->beg - 1;
   }
   if(@exec) {
      return $self->exec_async (@exec);
   }
   ()
}

sub my_resource {
   $_[0]->x_resource ("%.$_[1]")
}

# turn a rendition spec in the resource into a sub that implements it on $_
sub parse_rend {
   my ($self, $str) = @_;
   my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
                                        : (urxvt::RS_Uline, undef, undef, []);
   warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
   my @rend;
   push @rend, sub { $_ |= $mask } if $mask;
   push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
   push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
   sub {
      for my $s ( @rend ) { &$s };
   }
}

sub on_start {
   my ($self) = @_;

   $self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser";

   $self->{button}  = 2;
   $self->{state}   = 0;
   if($self->{argv}[0] || $self->my_resource ("button")) {
      my @mods = split '', $self->{argv}[0] || $self->my_resource ("button");
      for my $mod (@mods) {
         if($mod =~ /^\d+$/) {
            $self->{button} = $mod;
         } elsif($mod eq "C") {
            $self->{state} |= urxvt::ControlMask;
         } elsif($mod eq "S") {
            $self->{state} |= urxvt::ShiftMask;
         } elsif($mod eq "M") {
            $self->{state} |= $self->ModMetaMask;
         } elsif($mod ne "-" && $mod ne " ") {
            warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
         }
      }
   }

   my @defaults = ($url);
   my @matchers;
   for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") || $defaults[$idx]); $idx++) {
      $res = $self->locale_decode ($res);
      utf8::encode $res;
      my $launcher = $self->my_resource ("launcher.$idx");
      $launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher;
      my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
      unshift @matchers, [qr($res)x,$launcher,$rend];
   }
   $self->{matchers} = \@matchers;

   ()
}

sub on_line_update {
   my ($self, $row) = @_;

   # fetch the line that has changed
   my $line = $self->line ($row);
   my $text = $line->t;
   my $rend;

   # find all urls (if any)
   for my $matcher (@{$self->{matchers}}) {
      while ($text =~ /$matcher->[0]/g) {
         #print "$&\n";
         $rend ||= $line->r;

         # mark all characters as underlined. we _must_ not toggle underline,
         # as we might get called on an already-marked url.
         &{$matcher->[2]}
            for @{$rend}[$-[0] .. $+[0] - 1];
      }
   }

   $line->r ($rend) if $rend;

   ()
}

sub valid_button {
   my ($self, $event) = @_;
   my $mask = $self->ModLevel3Mask | $self->ModMetaMask
   | urxvt::ShiftMask | urxvt::ControlMask;
   return ($event->{button} == $self->{button} &&
      ($event->{state} & $mask) == $self->{state});
}

sub find_matches {
   my ($self, $row, $col) = @_;
   my $line = $self->line ($row);
   my $text = $line->t;
   my $off = $line->offset_of ($row, $col) if defined $col;

   my @matches;
   for my $matcher (@{$self->{matchers}}) {
      my $launcher = $matcher->[1] || $self->{launcher};
      while ($text =~ /$matcher->[0]/g) {
         my $match = substr $text, $-[0], $+[0] - $-[0];
         my @begin = @-;
         my @end = @+;
         my @exec;

         if (!defined($off) || ($-[0] <= $off && $+[0] >= $off)) {
            if ($launcher !~ /\$/) {
               @exec = ($launcher, $match);
            } else {
               # It'd be nice to just access a list like ($&,$1,$2...),
               # but alas, m//g behaves differently in list context.
               @exec = map { s/\$(\d+)|\$\{(\d+)\}/
                  substr $text, $begin[$1 || $2], $end[$1 || $2] - $begin[$1 || $2]
                  /egx; $_ } split /\s+/, $launcher;
            }

            push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
         }
      }
   }

   @matches;
}

sub command_for {
   my ($self, $row, $col) = @_;

   my @matches = $self->find_matches ($row, $col);
   if (@matches) {
      my @match = @{ $matches[0] };
      return @match[5 .. $#match];
   }

   ()
}

sub on_button_press {
   my ($self, $event) = @_;
   if($self->valid_button($event)
      && (my @exec = $self->command_for($event->{row},$event->{col}))) {
      $self->{row} = $event->{row};
      $self->{col} = $event->{col};
      $self->{cmd} = \@exec;
      return 1;
   } else {
      delete $self->{row};
      delete $self->{col};
      delete $self->{cmd};
   }

   ()
}

sub on_button_release {
   my ($self, $event) = @_;

   my $row = delete $self->{row};
   my $col = delete $self->{col};
   my $cmd = delete $self->{cmd};

   return if !defined $row;

   if($row == $event->{row} && abs($col-$event->{col}) < 2
      && join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
      if($self->valid_button($event)) {

         $self->exec_async (@$cmd);

      }
   }

   1;
}

sub select_enter {
   my ($self) = @_;

   $self->{view_start} = $self->view_start;
   $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
   $self->{cur_row} = $self->nrow - 1;

   $self->enable (
      key_press     => \&select_key_press,
      refresh_begin => \&select_refresh,
      refresh_end   => \&select_refresh,
   );

   $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
   $self->{overlay}->set (0, 0, "match-select");
}

sub select_leave {
   my ($self) = @_;

   $self->disable ("key_press", "refresh_begin", "refresh_end");
   $self->pty_ev_events ($self->{pty_ev_events});

   delete $self->{overlay};
   delete $self->{matches};
   delete $self->{id};
}

sub select_search {
   my ($self, $dir, $row) = @_;

   while ($self->nrow > $row && $row >= $self->top_row) {
      my $line = $self->line ($row)
          or last;

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