ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/mark-urls
Revision: 1.4
Committed: Tue Jan 10 21:20:53 2006 UTC (18 years, 4 months ago) by root
Branch: MAIN
Changes since 1.3: +22 -3 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3     # same url as used in "selection"
4     my $url =
5     qr{(
6 root 1.2 (?:https?|ftp|news|mailto|file)://[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~]+
7 root 1.4 [ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27()~] # exclude some trailing characters (heuristic)
8 root 1.1 )}x;
9    
10 root 1.3 sub on_line_update {
11 root 1.4 my ($self, $row) = @_;
12 root 1.1
13 root 1.3 # fetch the line that has changed
14 root 1.4 my $line = $self->line ($row);
15 root 1.3 my $text = $line->t;
16    
17     # find all urls (if any)
18     while ($text =~ /$url/g) {
19     my $rend = $line->r;
20    
21     # mark all characters as underlined. we _must_ not toggle underline,
22     # as we might get called on an already-marked url.
23     $_ |= urxvt::RS_Uline
24     for @{$rend}[ $-[1] .. $+[1] - 1];
25    
26     $line->r ($rend);
27 root 1.1 }
28    
29 root 1.3 ()
30 root 1.1 }
31    
32 root 1.4 # needs confgiurability TODO
33     #sub on_button_press {
34     # my ($self, $event) = @_;
35     # my $row = $event->{row};
36     # my $col = $event->{col};
37     #
38     # my $line = $self->line ($row);
39     # my $text = $line->t;
40     #
41     # while($text =~ /$url/g) {
42     # #print "... " . ($-[0]
43     # if ($-[0] <= $col && $+[0] >= $col) {
44     # system "firefox \Q$1\E &";
45     # return 1;
46     # }
47     # }
48     # ()
49     #}
50