matcher changes

diff --git a/Changes b/Changes
index e9151ec94626e16fff68718808451d4a279df38e..89e2292c0b90914db6618e5f93cf0b9970d6db9a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -28,6 +28,10 @@ TODO: fix rounding of colors when !xft (#aaaaaa => #a9a900) (do not use correct,
         - unbundled iom perl interface somewhat.
         - scrollbar-xterm now uses the selected scrollColor instead of fg
           (found by Aiviru).
+        - urxvt::rend2mask perl function, and utilization of it by matcher
+          (patch by Moshe Kamensky)
+        - use perl:matcher on a keysym to open most recently displayed URL
+        - with matcher, when multiple patterns match, last wins, not first
 
 8.1  Thu Dec  7 22:27:25 CET 2006
         - ｹﾘｽﾏｽﾌ゚ﾚｾ゙ﾝﾄ - zomg!!1, it's too early!!!

diff --git a/src/perl/matcher b/src/perl/matcher
index 772ddaa74de87f3b1ac855a741f3a53df540ed16..81a837181f661c54be276c5b0686f141d570cdf7 100644 (file)
--- a/src/perl/matcher
+++ b/src/perl/matcher
@@ -4,15 +4,58 @@
 
 my $url =
    qr{
-      (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+
-      [ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~]   # exclude some trailing characters (heuristic)
+      (?: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;
+   }
+   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 most_recent {
+   my ($self) = shift;
+   ()
+}
+
 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) = @_;
 
@@ -48,7 +91,8 @@ sub on_start {
       utf8::encode $res;
       my $launcher = $self->my_resource("launcher.$idx");
       $launcher =~ s/\$&|\$\{&\}/\${0}/g if ($launcher);
-      push @matchers, [qr($res)x,$launcher];
+      my $rend = $self->parse_rend($self->my_resource("rend.$idx"));
+      unshift @matchers, [qr($res)x,$launcher,$rend];
    }
    $self->{matchers} = \@matchers;
 
@@ -66,11 +110,12 @@ sub on_line_update {
    # 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.
-         $_ |= urxvt::RS_Uline
+         &{$matcher->[2]}
          for @{$rend}[ $-[0] .. $+[0] - 1];
 
          $line->r ($rend);
@@ -99,7 +144,7 @@ sub command_for {
          my $match = $&;
          my @begin = @-;
          my @end = @+;
-         if ($-[0] <= $col && $+[0] >= $col) {
+         if (!defined($col) || ($-[0] <= $col && $+[0] >= $col)) {
             if ($launcher !~ /\$/) {
                return ($launcher,$match);
             } else {

diff --git a/src/urxvt.pm b/src/urxvt.pm
index ace36aadec93426a3df6b8b1db27d7d30a23c913..bb8879a33b6182ccf3577d1dfc257b5beb6000c6 100644 (file)
--- a/src/urxvt.pm
+++ b/src/urxvt.pm
@@ -262,6 +262,7 @@ Example configuration:
 
     URxvt.perl-ext:           default,matcher
     URxvt.urlLauncher:        sensible-browser
+    URxvt.keysym.C-Delete:    perl:matcher
     URxvt.matcher.button:     1
     URxvt.matcher.pattern.1:  \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-]
     URxvt.matcher.pattern.2:  \\B(/\\S+?):(\\d+)(?=:|$)
@@ -992,6 +993,31 @@ sub SET_COLOR($$$) {
    SET_BGCOLOR (SET_FGCOLOR ($_[0], $_[1]), $_[2])
 }
 
+sub rend2mask {
+   no strict 'refs';
+   my ($str, $mask) = (@_, 0);
+   my %color = ( fg => undef, bg => undef );
+   my @failed;
+   for my $spec ( split /\s+/, $str ) {
+      if ( $spec =~ /^([fb]g)[_:-]?(\d+)/i ) {
+         $color{lc($1)} = $2;
+      } else {
+         my $neg = $spec =~ s/^[-^]//;
+         unless ( exists &{"RS_$spec"} ) {
+            push @failed, $spec;
+            next;
+         }
+         my $cur = &{"RS_$spec"};
+         if ( $neg ) {
+            $mask &= ~$cur;
+         } else {
+            $mask |= $cur;
+         }
+      }
+   }
+   ($mask, @color{qw(fg bg)}, \@failed)
+}
+
 # urxvt::term::extension
 
 package urxvt::term::extension;
@@ -2150,3 +2176,5 @@ numbers indicate more verbose output.
 =cut
 
 1
+
+# vim: sw=3: