#! 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: