*** empty log message ***

diff --git a/src/perl/matcher b/src/perl/matcher
new file mode 100644 (file)
index 0000000..772ddaa
--- /dev/null
+++ b/src/perl/matcher
@@ -0,0 +1,153 @@
+#! perl
+
+# Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.info>
+
+my $url =
+   qr{
+      (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+
+      [ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~]   # exclude some trailing characters (heuristic)
+   }x;
+
+sub my_resource {
+   my $self = shift;
+   $self->x_resource("$self->{name}.$_[0]");
+}
+
+sub on_start {
+   my ($self) = @_;
+
+   ($self->{name} = __PACKAGE__) =~ s/.*:://;
+   $self->{name} =~ tr/_/-/;
+   $self->{launcher} = $self->my_resource("launcher") ||
+                      $self->x_resource("urlLauncher") ||
+                      "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);
+      push @matchers, [qr($res)x,$launcher];
+   }
+   $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 $i = 0;
+
+   # find all urls (if any)
+   for my $matcher (@{$self->{matchers}}) {
+      while ($text =~ /$matcher->[0]/g) {
+         my $rend = $line->r;
+
+         # mark all characters as underlined. we _must_ not toggle underline,
+         # as we might get called on an already-marked url.
+         $_ |= urxvt::RS_Uline
+         for @{$rend}[ $-[0] .. $+[0] - 1];
+
+         $line->r ($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 command_for {
+   my ($self, $row, $col) = @_;
+   my $line = $self->line ($row);
+   my $text = $line->t;
+
+   for my $matcher (@{$self->{matchers}}) {
+      my $launcher = $matcher->[1] || $self->{launcher};
+      while (($text =~ /$matcher->[0]/g)) {
+         my $match = $&;
+         my @begin = @-;
+         my @end = @+;
+         if ($-[0] <= $col && $+[0] >= $col) {
+            if ($launcher !~ /\$/) {
+               return ($launcher,$match);
+            } else {
+               # It'd be nice to just access a list like ($&,$1,$2...),
+               # but alas, m//g behaves differently in list context.
+               my @exec = map { s/\$(\d+)|\$\{(\d+)\}/
+                  substr($text,$begin[$1||$2],$end[$1||$2]-$begin[$1||$2])
+                  /egx; $_ } split(/\s+/, $launcher);
+               return @exec;
+            }
+         }
+      }
+   }
+
+   ()
+}
+
+sub on_button_press {
+   my ($self, $event) = @_;
+   if($self->valid_button($event)) {
+      $self->{row} = $event->{row};
+      $self->{col} = $event->{col};
+   } else {
+      delete $self->{row};
+      delete $self->{col};
+   }
+
+   ()
+}
+
+sub on_button_release {
+   my ($self, $event) = @_;
+
+   my $row = delete $self->{row};
+   my $col = delete $self->{col};
+
+   if(defined($row) && $row == $event->{row} && abs($col-$event->{col}) < 2) {
+      if($self->valid_button($event)) {
+
+         my @exec = $self->command_for($row,$col);
+         if(@exec) {
+            return $self->exec_async (@exec);
+         }
+
+      }
+   }
+
+   ()
+}
+
+# vim:set sw=3 sts=3 et: