applications/urxvt-perls
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

url-select: support matcher configurations

Browse Source
This commit is contained in:
meh 2012-03-01 21:14:12 +01:00 committed by Bert Münnich
parent b438097350
commit b5631d1d90
1 changed files with 51 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
url-select
View File

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