[ViewVC] Annotation of: cvs/rxvt-unicode/src/perl/matcher

#! perl

# Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.info>
#          Bob Farrell <robertanthonyfarrell@gmail.com>

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_key_press {
   my ($self, $event, $keysym, $octets) = @_;

   if (! $self->{showing} ) {
      return;
   }

   my $i = ($keysym == 96 ? 0 : $keysym - 48);
   if (($i > scalar(@{$self->{urls}})) || ($i < 0)) {
      $self->matchlist();
      return;
   }

   my @args = ($self->{urls}[ -$i-1 ]);
   $self->matchlist();

   $self->exec_async( $self->{launcher}, @args );
}

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

   if($cmd =~ s/^matcher:list\b//) {
      $self->matchlist();
   } else {
      if($cmd =~ s/^matcher:last\b//) {
         $self->most_recent;
      }
   # For backward compatibility
    else {
      if($cmd =~ s/^matcher\b//) {
         $self->most_recent;
      }
   }
  }
   ()
}

sub matchlist {
   my ($self) = @_;
   if ( $self->{showing} ) {
     $self->{url_overlay}->hide();
     $self->{showing} = 0;
     return;
   }
  @{$self->{urls}} = ();
  my $line;
  for (my $i = 0; $i < $self->nrow; $i ++) {
     $line = $self->line($i);
     next if ($line->beg != $i);
     for my $url ($self->get_urls_from_line($line->t)) {
        if (scalar(@{$self->{urls}}) == 10) {
            shift @{$self->{urls}};
        }
        push @{$self->{urls}}, $url;
     }
  }

  if (! scalar(@{$self->{urls}})) {
    return;
  }

  my $max = 0;
  my $i = scalar( @{$self->{urls}} ) - 1 ;;

  my @temp = ();

  for my $url (@{$self->{urls}}) {
     my $url = "$i-$url";
     my $xpos = 0;

     if ($self->ncol + (length $url) >= $self->ncol) {
        $url = substr( $url, 0, $self->ncol );
     }

     push @temp, $url;

     if( length $url > $max ) {
        $max = length $url;
     }

     $i--;
  }

  @temp = reverse @temp;

  $self->{url_overlay} = $self->overlay(0, 0, $max, scalar( @temp ), urxvt::OVERLAY_RSTYLE, 2);
  my $i = 0;
  for my $url (@temp) {
     $self->{url_overlay}->set( 0, $i, $url, [(urxvt::OVERLAY_RSTYLE) x length $url]);
        $self->{showing} = 1;
     $i++;
  }

}

sub most_recent {
   my ($self) = shift;
   my $row = $self->nrow;
   my @exec;
   while($row-- > $self->top_row) {
      @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->{urls} = [];
   $self->{showing} = 0;
   $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 get_urls_from_line {
   my ($self, $line) = @_;
   my @urls;
   for my $matcher (@{$self->{matchers}}) {
     while ($line =~ /$matcher->[0]/g) {
        push @urls, substr( $line, $-[0], $+[0] - $-[0] );
     }
   }
   return @urls;
}

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)
      && (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;
}

# vim:set sw=3 sts=3 et:
Revision:	1.6
Committed:	Fri Aug 19 23:08:35 2011 UTC (12 years, 8 months ago) by sf-tpope
Branch:	MAIN
Changes since 1.5:	+105 -5 lines
Log Message:	Keyboard accessible list of recent matches in matcher
#	User	Rev	Content
1	root	1.1	#! perl
2
3			# Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.info>
4	sf-tpope	1.6	# Bob Farrell <robertanthonyfarrell@gmail.com>
5	root	1.1
6			my $url =
7			qr{
8	tpope	1.2	(?:https?://\|ftp://\|news://\|mailto:\|file://\|\bwww\.)
9			[a-zA-Z0-9\-\@;\/?:&=%\$_.+!\x27,~#]
10			(
11			\([a-zA-Z0-9\-\@;\/?:&=%\$_.+!\x27,~#]\)\| # Allow a pair of matched parentheses
12			[a-zA-Z0-9\-\@;\/?:&=%\$_+*~] # exclude some trailing characters (heuristic)
13			)+
14	root	1.1	}x;
15
16	sf-tpope	1.6	sub on_key_press {
17			my ($self, $event, $keysym, $octets) = @_;
18
19			if (! $self->{showing} ) {
20			return;
21			}
22
23			my $i = ($keysym == 96 ? 0 : $keysym - 48);
24			if (($i > scalar(@{$self->{urls}})) \|\| ($i < 0)) {
25			$self->matchlist();
26			return;
27			}
28
29			my @args = ($self->{urls}[ -$i-1 ]);
30			$self->matchlist();
31
32			$self->exec_async( $self->{launcher}, @args );
33			}
34
35	tpope	1.4	sub on_user_command {
36			my ($self, $cmd) = @_;
37	sf-tpope	1.6
38			if($cmd =~ s/^matcher:list\b//) {
39			$self->matchlist();
40			} else {
41			if($cmd =~ s/^matcher:last\b//) {
42			$self->most_recent;
43			}
44			# For backward compatibility
45			else {
46			if($cmd =~ s/^matcher\b//) {
47			$self->most_recent;
48			}
49	tpope	1.4	}
50	sf-tpope	1.6	}
51	tpope	1.4	()
52			}
53
54	sf-tpope	1.6	sub matchlist {
55			my ($self) = @_;
56			if ( $self->{showing} ) {
57			$self->{url_overlay}->hide();
58			$self->{showing} = 0;
59			return;
60			}
61			@{$self->{urls}} = ();
62			my $line;
63			for (my $i = 0; $i < $self->nrow; $i ++) {
64			$line = $self->line($i);
65			next if ($line->beg != $i);
66			for my $url ($self->get_urls_from_line($line->t)) {
67			if (scalar(@{$self->{urls}}) == 10) {
68			shift @{$self->{urls}};
69			}
70			push @{$self->{urls}}, $url;
71			}
72			}
73
74			if (! scalar(@{$self->{urls}})) {
75			return;
76			}
77
78			my $max = 0;
79			my $i = scalar( @{$self->{urls}} ) - 1 ;;
80
81			my @temp = ();
82
83			for my $url (@{$self->{urls}}) {
84			my $url = "$i-$url";
85			my $xpos = 0;
86
87			if ($self->ncol + (length $url) >= $self->ncol) {
88			$url = substr( $url, 0, $self->ncol );
89			}
90
91			push @temp, $url;
92
93			if( length $url > $max ) {
94			$max = length $url;
95			}
96
97			$i--;
98			}
99
100			@temp = reverse @temp;
101
102			$self->{url_overlay} = $self->overlay(0, 0, $max, scalar( @temp ), urxvt::OVERLAY_RSTYLE, 2);
103			my $i = 0;
104			for my $url (@temp) {
105			$self->{url_overlay}->set( 0, $i, $url, [(urxvt::OVERLAY_RSTYLE) x length $url]);
106			$self->{showing} = 1;
107			$i++;
108			}
109
110			}
111
112	tpope	1.4	sub most_recent {
113			my ($self) = shift;
114			my $row = $self->nrow;
115			my @exec;
116			while($row-- > $self->top_row) {
117			@exec = $self->command_for($row);
118			last if(@exec);
119			}
120			if(@exec) {
121			return $self->exec_async (@exec);
122			}
123			()
124			}
125	tpope	1.2
126	root	1.1	sub my_resource {
127			my $self = shift;
128	root	1.3	$self->x_resource ("$self->{name}.$_[0]");
129	root	1.1	}
130
131	tpope	1.2	# turn a rendition spec in the resource into a sub that implements it on $_
132			sub parse_rend {
133			my ($self, $str) = @_;
134	sf-tpope	1.6	my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
135	tpope	1.2	: (urxvt::RS_Uline, undef, undef, []);
136			warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
137			my @rend;
138			push @rend, sub { $_ \|= $mask } if $mask;
139			push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
140			push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
141			sub {
142			for my $s ( @rend ) { &$s };
143			}
144			}
145
146	root	1.1	sub on_start {
147			my ($self) = @_;
148
149			($self->{name} = __PACKAGE__) =~ s/.*:://;
150			$self->{name} =~ tr/_/-/;
151			$self->{launcher} = $self->my_resource("launcher") \|\|
152			$self->x_resource("urlLauncher") \|\|
153			"sensible-browser";
154
155	sf-tpope	1.6	$self->{urls} = [];
156			$self->{showing} = 0;
157	root	1.1	$self->{button} = 2;
158			$self->{state} = 0;
159			if($self->{argv}[0] \|\| $self->my_resource("button")) {
160			my @mods = split('', $self->{argv}[0] \|\| $self->my_resource("button"));
161			for my $mod (@mods) {
162			if($mod =~ /^\d+$/) {
163			$self->{button} = $mod;
164			} elsif($mod eq "C") {
165			$self->{state} \|= urxvt::ControlMask;
166			} elsif($mod eq "S") {
167			$self->{state} \|= urxvt::ShiftMask;
168			} elsif($mod eq "M") {
169			$self->{state} \|= $self->ModMetaMask;
170			} elsif($mod ne "-" && $mod ne " ") {
171			warn("$mod is invalid in $self->{name}<$self->{argv}[0]>\n");
172			}
173			}
174			}
175
176			my @defaults = ($url);
177			my @matchers;
178			for (my $idx = 0; defined (my $res = $self->my_resource("pattern.$idx") \|\| $defaults[$idx]); $idx++) {
179			$res = $self->locale_decode ($res);
180			utf8::encode $res;
181			my $launcher = $self->my_resource("launcher.$idx");
182			$launcher =~ s/\$&\|\$\{&\}/\${0}/g if ($launcher);
183	tpope	1.2	my $rend = $self->parse_rend($self->my_resource("rend.$idx"));
184			unshift @matchers, [qr($res)x,$launcher,$rend];
185	root	1.1	}
186			$self->{matchers} = \@matchers;
187
188			()
189			}
190
191	sf-tpope	1.6	sub get_urls_from_line {
192			my ($self, $line) = @_;
193			my @urls;
194			for my $matcher (@{$self->{matchers}}) {
195			while ($line =~ /$matcher->[0]/g) {
196			push @urls, substr( $line, $-[0], $+[0] - $-[0] );
197			}
198			}
199			return @urls;
200			}
201
202	root	1.1	sub on_line_update {
203			my ($self, $row) = @_;
204
205			# fetch the line that has changed
206			my $line = $self->line ($row);
207			my $text = $line->t;
208			my $i = 0;
209
210			# find all urls (if any)
211			for my $matcher (@{$self->{matchers}}) {
212			while ($text =~ /$matcher->[0]/g) {
213	tpope	1.2	#print "$&\n";
214	root	1.1	my $rend = $line->r;
215
216			# mark all characters as underlined. we _must_ not toggle underline,
217			# as we might get called on an already-marked url.
218	tpope	1.2	&{$matcher->[2]}
219	root	1.1	for @{$rend}[ $-[0] .. $+[0] - 1];
220
221			$line->r ($rend);
222			}
223			}
224
225			()
226			}
227
228			sub valid_button {
229			my ($self, $event) = @_;
230			my $mask = $self->ModLevel3Mask \| $self->ModMetaMask
231			\| urxvt::ShiftMask \| urxvt::ControlMask;
232			return ($event->{button} == $self->{button} &&
233			($event->{state} & $mask) == $self->{state});
234			}
235
236			sub command_for {
237			my ($self, $row, $col) = @_;
238			my $line = $self->line ($row);
239			my $text = $line->t;
240
241			for my $matcher (@{$self->{matchers}}) {
242			my $launcher = $matcher->[1] \|\| $self->{launcher};
243			while (($text =~ /$matcher->[0]/g)) {
244			my $match = $&;
245			my @begin = @-;
246			my @end = @+;
247	tpope	1.2	if (!defined($col) \|\| ($-[0] <= $col && $+[0] >= $col)) {
248	root	1.1	if ($launcher !~ /\$/) {
249			return ($launcher,$match);
250			} else {
251			# It'd be nice to just access a list like ($&,$1,$2...),
252			# but alas, m//g behaves differently in list context.
253			my @exec = map { s/\$(\d+)\|\$\{(\d+)\}/
254			substr($text,$begin[$1\|\|$2],$end[$1\|\|$2]-$begin[$1\|\|$2])
255			/egx; $_ } split(/\s+/, $launcher);
256			return @exec;
257			}
258			}
259			}
260			}
261
262			()
263			}
264
265			sub on_button_press {
266			my ($self, $event) = @_;
267	sf-tpope	1.5	if($self->valid_button($event)
268			&& (my @exec = $self->command_for($event->{row},$event->{col}))) {
269	root	1.1	$self->{row} = $event->{row};
270			$self->{col} = $event->{col};
271	sf-tpope	1.5	$self->{cmd} = \@exec;
272			return 1;
273	root	1.1	} else {
274			delete $self->{row};
275			delete $self->{col};
276	sf-tpope	1.5	delete $self->{cmd};
277	root	1.1	}
278
279			()
280			}
281
282			sub on_button_release {
283			my ($self, $event) = @_;
284
285			my $row = delete $self->{row};
286			my $col = delete $self->{col};
287	sf-tpope	1.5	my $cmd = delete $self->{cmd};
288	root	1.1
289	sf-tpope	1.5	return if !defined $row;
290
291			if($row == $event->{row} && abs($col-$event->{col}) < 2
292			&& join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
293	root	1.1	if($self->valid_button($event)) {
294
295	sf-tpope	1.5	$self->exec_async (@$cmd);
296	root	1.1
297			}
298			}
299
300	sf-tpope	1.5	1;
301	root	1.1	}
302
303			# vim:set sw=3 sts=3 et: