url-select: support matcher configurations

This commit is contained in:
meh 2012-03-01 21:14:12 +01:00 committed by Bert Münnich
parent b438097350
commit b5631d1d90

View File

@ -28,11 +28,6 @@
use strict; use strict;
my $url_matcher = qr{(
(?:https?://|ftp://|news://|mailto:|file://|www\.)
[\w\-\@;\/?:&=%\$_.+!*\x27(),~#]+[\w\-\@;\/?&=%\$_+!*\x27()~]
)}x;
sub on_start { sub on_start {
my ($self) = @_; my ($self) = @_;
@ -45,12 +40,31 @@ sub on_start {
if ($self->x_resource('underlineURLs') eq 'true') { if ($self->x_resource('underlineURLs') eq 'true') {
$self->enable(line_update => \&line_update); $self->enable(line_update => \&line_update);
} }
if($self->x_resource('urlButton') =~ /^\d+$/) { if ($self->x_resource('urlButton') =~ /^\d+$/) {
$self->{button} = $self->x_resource('urlButton'); $self->{button} = $self->x_resource('urlButton');
} elsif ($self->x_resource('matcher.button') =~ /^\d+$/) {
$self->{button} = $self->x_resource('matcher.button');
} else { } else {
$self->{button} = 2; $self->{button} = 2;
} }
if ($self->x_resource('matcher.pattern')) {
@{$self->{pattern}} = ($self->x_resource('matcher.pattern'));
} elsif ($self->x_resource('matcher.pattern.1')) {
my $current = 1;
while ($self->x_resource("matcher.pattern.$current")) {
push @{$self->{pattern}}, $self->x_resource("matcher.pattern.$current");
$current++;
}
} else {
@{$self->{pattern}} = (qr{
(?:https?://|ftp://|news://|mailto:|file://|www\.)
[\w\-\@;\/?:&=%\$_.+!*\x27(),~#]+[\w\-\@;\/?&=%\$_+!*\x27()~]
}x);
}
() ()
} }
@ -62,8 +76,9 @@ sub line_update {
my $text = $line->t; my $text = $line->t;
my $rend = $line->r; my $rend = $line->r;
while ($text =~ /$url_matcher/g) { for my $pattern (@{$self->{pattern}}) {
my $url = $1; while ($text =~ /$pattern/g) {
my $url = $&;
my ($beg, $end) = ($-[1], $+[1] - 1); my ($beg, $end) = ($-[1], $+[1] - 1);
--$end if $url =~ /["')]$/; --$end if $url =~ /["')]$/;
@ -72,6 +87,7 @@ sub line_update {
} }
$line->r($rend); $line->r($rend);
} }
}
() ()
} }
@ -154,8 +170,9 @@ sub on_button_release {
my $line = $self->line($row); my $line = $self->line($row);
my $text = $line->t; my $text = $line->t;
while ($text =~ /$url_matcher/g) { for my $pattern (@{$self->{pattern}}) {
my ($url, $beg, $end) = ($1, $-[0], $+[0]); while ($text =~ /$pattern/g) {
my ($url, $beg, $end) = ($&, $-[0], $+[0]);
--$end if $url =~ s/["')]$//; --$end if $url =~ s/["')]$//;
if ($col >= $beg && $col <= $end) { if ($col >= $beg && $col <= $end) {
@ -165,6 +182,7 @@ sub on_button_release {
} }
} }
} }
}
() ()
} }
@ -190,7 +208,8 @@ sub select_next {
$line = $self->line($row); $line = $self->line($row);
my $text = $line->t; my $text = $line->t;
if ($text =~ /$url_matcher/g) { for my $pattern (@{$self->{pattern}}) {
if ($text =~ /$pattern/g) {
delete $self->{found}; delete $self->{found};
do { do {
@ -198,7 +217,7 @@ sub select_next {
--$end if $& =~ /['")]$/; --$end if $& =~ /['")]$/;
push @{$self->{found}}, [$line->coord_of($beg), push @{$self->{found}}, [$line->coord_of($beg),
$line->coord_of($end), substr($text, $beg, $end - $beg)]; $line->coord_of($end), substr($text, $beg, $end - $beg)];
} while ($text =~ /$url_matcher/g); } while ($text =~ /$pattern/g);
$self->{row} = $row; $self->{row} = $row;
$self->{n} = $dir < 0 ? $#{$self->{found}} : 0; $self->{n} = $dir < 0 ? $#{$self->{found}} : 0;
@ -206,6 +225,7 @@ sub select_next {
return; return;
} }
} }
}
deactivate($self) unless $self->{found}; deactivate($self) unless $self->{found};