ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/matcher
Revision: 1.1
Committed: Sat Nov 11 20:06:34 2006 UTC (17 years, 6 months ago) by root
Branch: MAIN
CVS Tags: rel-8_1
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3     # Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.info>
4    
5     my $url =
6     qr{
7     (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+
8     [ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~] # exclude some trailing characters (heuristic)
9     }x;
10    
11     sub my_resource {
12     my $self = shift;
13     $self->x_resource("$self->{name}.$_[0]");
14     }
15    
16     sub on_start {
17     my ($self) = @_;
18    
19     ($self->{name} = __PACKAGE__) =~ s/.*:://;
20     $self->{name} =~ tr/_/-/;
21     $self->{launcher} = $self->my_resource("launcher") ||
22     $self->x_resource("urlLauncher") ||
23     "sensible-browser";
24    
25     $self->{button} = 2;
26     $self->{state} = 0;
27     if($self->{argv}[0] || $self->my_resource("button")) {
28     my @mods = split('', $self->{argv}[0] || $self->my_resource("button"));
29     for my $mod (@mods) {
30     if($mod =~ /^\d+$/) {
31     $self->{button} = $mod;
32     } elsif($mod eq "C") {
33     $self->{state} |= urxvt::ControlMask;
34     } elsif($mod eq "S") {
35     $self->{state} |= urxvt::ShiftMask;
36     } elsif($mod eq "M") {
37     $self->{state} |= $self->ModMetaMask;
38     } elsif($mod ne "-" && $mod ne " ") {
39     warn("$mod is invalid in $self->{name}<$self->{argv}[0]>\n");
40     }
41     }
42     }
43    
44     my @defaults = ($url);
45     my @matchers;
46     for (my $idx = 0; defined (my $res = $self->my_resource("pattern.$idx") || $defaults[$idx]); $idx++) {
47     $res = $self->locale_decode ($res);
48     utf8::encode $res;
49     my $launcher = $self->my_resource("launcher.$idx");
50     $launcher =~ s/\$&|\$\{&\}/\${0}/g if ($launcher);
51     push @matchers, [qr($res)x,$launcher];
52     }
53     $self->{matchers} = \@matchers;
54    
55     ()
56     }
57    
58     sub on_line_update {
59     my ($self, $row) = @_;
60    
61     # fetch the line that has changed
62     my $line = $self->line ($row);
63     my $text = $line->t;
64     my $i = 0;
65    
66     # find all urls (if any)
67     for my $matcher (@{$self->{matchers}}) {
68     while ($text =~ /$matcher->[0]/g) {
69     my $rend = $line->r;
70    
71     # mark all characters as underlined. we _must_ not toggle underline,
72     # as we might get called on an already-marked url.
73     $_ |= urxvt::RS_Uline
74     for @{$rend}[ $-[0] .. $+[0] - 1];
75    
76     $line->r ($rend);
77     }
78     }
79    
80     ()
81     }
82    
83     sub valid_button {
84     my ($self, $event) = @_;
85     my $mask = $self->ModLevel3Mask | $self->ModMetaMask
86     | urxvt::ShiftMask | urxvt::ControlMask;
87     return ($event->{button} == $self->{button} &&
88     ($event->{state} & $mask) == $self->{state});
89     }
90    
91     sub command_for {
92     my ($self, $row, $col) = @_;
93     my $line = $self->line ($row);
94     my $text = $line->t;
95    
96     for my $matcher (@{$self->{matchers}}) {
97     my $launcher = $matcher->[1] || $self->{launcher};
98     while (($text =~ /$matcher->[0]/g)) {
99     my $match = $&;
100     my @begin = @-;
101     my @end = @+;
102     if ($-[0] <= $col && $+[0] >= $col) {
103     if ($launcher !~ /\$/) {
104     return ($launcher,$match);
105     } else {
106     # It'd be nice to just access a list like ($&,$1,$2...),
107     # but alas, m//g behaves differently in list context.
108     my @exec = map { s/\$(\d+)|\$\{(\d+)\}/
109     substr($text,$begin[$1||$2],$end[$1||$2]-$begin[$1||$2])
110     /egx; $_ } split(/\s+/, $launcher);
111     return @exec;
112     }
113     }
114     }
115     }
116    
117     ()
118     }
119    
120     sub on_button_press {
121     my ($self, $event) = @_;
122     if($self->valid_button($event)) {
123     $self->{row} = $event->{row};
124     $self->{col} = $event->{col};
125     } else {
126     delete $self->{row};
127     delete $self->{col};
128     }
129    
130     ()
131     }
132    
133     sub on_button_release {
134     my ($self, $event) = @_;
135    
136     my $row = delete $self->{row};
137     my $col = delete $self->{col};
138    
139     if(defined($row) && $row == $event->{row} && abs($col-$event->{col}) < 2) {
140     if($self->valid_button($event)) {
141    
142     my @exec = $self->command_for($row,$col);
143     if(@exec) {
144     return $self->exec_async (@exec);
145     }
146    
147     }
148     }
149    
150     ()
151     }
152    
153     # vim:set sw=3 sts=3 et: