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

82
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,15 +76,17 @@ sub line_update {
my $text = $line->t;
my $rend = $line->r;
while ($text =~ /$url_matcher/g) {
my $url = $1;
my ($beg, $end) = ($-[1], $+[1] - 1);
--$end if $url =~ /["')]$/;
for my $pattern (@{$self->{pattern}}) {
while ($text =~ /$pattern/g) {
my $url = $&;
my ($beg, $end) = ($-[1], $+[1] - 1);
--$end if $url =~ /["')]$/;
for (@{$rend}[$beg .. $end]) {
$_ |= urxvt::RS_Uline;
for (@{$rend}[$beg .. $end]) {
$_ |= urxvt::RS_Uline;
}
$line->r($rend);
}
$line->r($rend);
}
()
@ -154,13 +170,15 @@ 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]);
--$end if $url =~ s/["')]$//;
for my $pattern (@{$self->{pattern}}) {
while ($text =~ /$pattern/g) {
my ($url, $beg, $end) = ($&, $-[0], $+[0]);
--$end if $url =~ s/["')]$//;
if ($col >= $beg && $col <= $end) {
$self->exec_async(@{$self->{browser}}, $url);
return 1;
if ($col >= $beg && $col <= $end) {
$self->exec_async(@{$self->{browser}}, $url);
return 1;
}
}
}
}
@ -190,20 +208,22 @@ sub select_next {
$line = $self->line($row);
my $text = $line->t;
if ($text =~ /$url_matcher/g) {
delete $self->{found};
for my $pattern (@{$self->{pattern}}) {
if ($text =~ /$pattern/g) {
delete $self->{found};
do {
my ($beg, $end) = ($-[0], $+[0]);
--$end if $& =~ /['")]$/;
push @{$self->{found}}, [$line->coord_of($beg),
$line->coord_of($end), substr($text, $beg, $end - $beg)];
} while ($text =~ /$url_matcher/g);
do {
my ($beg, $end) = ($-[0], $+[0]);
--$end if $& =~ /['")]$/;
push @{$self->{found}}, [$line->coord_of($beg),
$line->coord_of($end), substr($text, $beg, $end - $beg)];
} while ($text =~ /$pattern/g);
$self->{row} = $row;
$self->{n} = $dir < 0 ? $#{$self->{found}} : 0;
hilight($self);
return;
$self->{row} = $row;
$self->{n} = $dir < 0 ? $#{$self->{found}} : 0;
hilight($self);
return;
}
}
}