#! perl

# Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.info>

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

sub on_user_command {
   my ($self, $cmd) = @_;
   if($cmd =~ s/^matcher\b//) {
      $self->most_recent;
   }
   ()
}

sub most_recent {
   my ($self) = shift;
   my $row = $self->nrow;
   my @exec;
   while($row-- > $self->top_row) {
      #my $line = $self->line ($row);
      #my $text = $line->t;
      @exec = $self->command_for($row);
      last if(@exec);
   }
   if(@exec) {
      return $self->exec_async (@exec);
   }
   ()
}

sub my_resource {
   my $self = shift;
   $self->x_resource ("$self->{name}.$_[0]");
}

# 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->{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);
      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 $i = 0;

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

   ()
}

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 (!defined($col) || ($-[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:
