1#! perl -w
2# Author:   Bert Muennich
3# Website:  http://www.github.com/muennich/urxvt-perls
4# Based on: http://www.jukie.net/~bart/blog/urxvt-url-yank
5# Version:  2.0
6# License:  GPLv2
7
8# Use keyboard shortcuts to select URLs.
9# This should be used as a replacement for the default matcher extension,
10# it also makes URLs clickable with the middle mouse button.
11
12# Usage: put the following lines in your .Xdefaults/.Xresources:
13#   URxvt.perl-ext-common: ...,url-select
14#   URxvt.keysym.M-u: perl:url-select:select_next
15
16# Use Meta-u to activate URL selection mode, then use the following keys:
17#   j/k:      Select next downward/upward URL (also with arrow keys)
18#   g/G:      Select first/last URL (also with home/end key)
19#   o/Return: Open selected URL in browser, Return: deactivate afterwards
20#   y:        Copy (yank) selected URL and deactivate selection mode
21#   q/Escape: Deactivate URL selection mode
22
23# Options:
24#   URxvt.url-select.autocopy:  If true, selected URLs are copied to PRIMARY
25#   URvxt.url-select.button:    Mouse button to click-open URLs (default: 2)
26#   URxvt.url-select.launcher:  Browser/command to open selected URL with
27#   URxvt.url-select.underline: If set to true, all URLs get underlined
28
29use strict;
30
31sub on_start {
32	my ($self) = @_;
33
34	# read resource settings
35	if ($self->x_resource('url-select.launcher')) {
36		@{$self->{browser}} = split /\s+/, $self->x_resource('url-select.launcher');
37	} else {
38		@{$self->{browser}} = ('x-www-browser');
39	}
40	if ($self->x_resource('url-select.underline') eq 'true') {
41		$self->enable(line_update => \&line_update);
42	}
43	if ($self->x_resource('url-select.autocopy') eq 'true') {
44		$self->{autocopy} = 1;
45	}
46	if ($self->x_resource('url-select.button') =~ /^\d+$/) {
47		$self->{button} = $self->x_resource('url-select.button');
48	} elsif ($self->x_resource('matcher.button') =~ /^\d+$/) {
49		$self->{button} = $self->x_resource('matcher.button');
50	} else {
51		$self->{button} = 2;
52	}
53
54	if ($self->x_resource('matcher.pattern')) {
55		@{$self->{pattern}} = ($self->x_resource('matcher.pattern'));
56	} elsif ($self->x_resource('matcher.pattern.1')) {
57		my $current = 1;
58
59		while ($self->x_resource("matcher.pattern.$current")) {
60			push @{$self->{pattern}}, $self->x_resource("matcher.pattern.$current");
61			$current++;
62		}
63	} else {
64		@{$self->{pattern}} = qr{(
65			(?:https?://|ftp://|news://|mailto:|file://|www\.)
66			[\w\-\@;\/?:&=%\$_.+!*\x27(),~#]+[\w\-\@;\/?&=%\$_+!*\x27()~]
67		)}x;
68	}
69
70	()
71}
72
73
74sub line_update {
75	my ($self, $row) = @_;
76
77	my $line = $self->line($row);
78	my $text = $line->t;
79	my $rend = $line->r;
80
81	for my $pattern (@{$self->{pattern}}) {
82		while ($text =~ /$pattern/g) {
83			my $url = $&;
84			my ($beg, $end) = ($-[1], $+[1] - 1);
85			--$end if $url =~ /["')]$/;
86
87			for (@{$rend}[$beg .. $end]) {
88				$_ |= urxvt::RS_Uline;
89			}
90			$line->r($rend);
91		}
92	}
93
94	()
95}
96
97
98sub on_user_command {
99	my ($self, $cmd) = @_;
100
101	if ($cmd eq 'url-select:select_next') {
102		if (not $self->{active}) {
103			activate($self);
104		}
105		select_next($self, -1);
106	}
107
108	()
109}
110
111
112sub key_press {
113	my ($self, $event, $keysym) = @_;
114	my $char = chr($keysym);
115
116	if ($keysym == 0xff1b || lc($char) eq 'q') {
117		deactivate($self);
118	} elsif ($keysym == 0xff0d || $char eq 'o') {
119		$self->exec_async(@{$self->{browser}}, ${$self->{found}[$self->{n}]}[4]);
120		deactivate($self) unless $char eq 'o';
121	} elsif ($char eq 'y') {
122		my $found = $self->{found}[$self->{n}];
123		$self->selection_beg(${$found}[0], ${$found}[1]);
124		$self->selection_end(${$found}[2], ${$found}[3]);
125		$self->selection_make($event->{time});
126		$self->selection_beg(1, 0);
127		$self->selection_end(1, 0);
128		deactivate($self);
129	} elsif ($char eq 'k' || $keysym == 0xff52 || $keysym == 0xff51) {
130		select_next($self, -1, $event);
131	} elsif ($char eq 'j' || $keysym == 0xff54 || $keysym == 0xff53) {
132		select_next($self, 1, $event);
133	} elsif ($char eq 'g' || $keysym == 0xff50) {
134		$self->{row} = $self->top_row - 1;
135		delete $self->{found};
136		select_next($self, 1, $event);
137	} elsif ($char eq 'G' || $keysym == 0xff57) {
138		$self->{row} = $self->nrow;
139		delete $self->{found};
140		select_next($self, -1, $event);
141	}
142
143	return 1;
144}
145
146
147sub on_button_press {
148	my ($self, $event) = @_;
149
150	my $mask = $self->ModLevel3Mask | $self->ModMetaMask |
151	           urxvt::ShiftMask | urxvt::ControlMask;
152
153	if ($event->{button} == $self->{button} && ($event->{state} & $mask) == 0) {
154		$self->{button_pressed} = 1;
155		$self->{button_col} = $event->{col};
156		$self->{button_row} = $event->{row};
157	}
158
159	()
160}
161
162sub on_button_release {
163	my ($self, $event) = @_;
164
165	if ($self->{button_pressed} && $event->{button} == $self->{button}) {
166		my $col = $event->{col};
167		my $row = $event->{row};
168
169		$self->{button_pressed} = 0;
170
171		if ($col == $self->{button_col} && $row == $self->{button_row}) {
172			my $line = $self->line($row);
173			my $text = $line->t;
174
175			for my $pattern (@{$self->{pattern}}) {
176				while ($text =~ /$pattern/g) {
177					my ($url, $beg, $end) = ($&, $-[0], $+[0]);
178					--$end if $url =~ s/["')]$//;
179
180					if ($col >= $beg && $col <= $end) {
181						$self->exec_async(@{$self->{browser}}, $url);
182						return 1;
183					}
184				}
185			}
186		}
187	}
188
189	()
190}
191
192
193sub select_next {
194	# $dir < 0: up, > 0: down
195	my ($self, $dir, $event) = @_;
196	my $row = $self->{row};
197
198	if (($dir < 0 && $self->{n} > 0) ||
199			($dir > 0 && $self->{n} < $#{ $self->{found} })) {
200		# another url on current line
201		$self->{n} += $dir;
202		hilight($self);
203		if ($self->{autocopy}) {
204			my $found = $self->{found}[$self->{n}];
205			$self->selection_beg(${$found}[0], ${$found}[1]);
206			$self->selection_end(${$found}[2], ${$found}[3]);
207			$self->selection_make($event->{time});
208			$self->selection_beg(1, 0);
209			$self->selection_end(1, 0);
210		}
211		return;
212	}
213
214	while (($dir < 0 && $row > $self->top_row) ||
215		   ($dir > 0 && $row < $self->nrow - 1)) {
216		my $line = $self->line($row);
217		$row = ($dir < 0 ? $line->beg : $line->end) + $dir;
218		$line = $self->line($row);
219		my $text = $line->t;
220
221		for my $pattern (@{$self->{pattern}}) {
222			if ($text =~ /$pattern/g) {
223				delete $self->{found};
224
225				do {
226					my ($beg, $end) = ($-[0], $+[0]);
227					--$end if $& =~ /['")]$/;
228					push @{$self->{found}}, [$line->coord_of($beg),
229							$line->coord_of($end), substr($text, $beg, $end - $beg)];
230				} while ($text =~ /$pattern/g);
231
232				$self->{row} = $row;
233				$self->{n} = $dir < 0 ? $#{$self->{found}} : 0;
234				hilight($self);
235				if ($self->{autocopy}) {
236					my $found = $self->{found}[$self->{n}];
237					$self->selection_beg(${$found}[0], ${$found}[1]);
238					$self->selection_end(${$found}[2], ${$found}[3]);
239					$self->selection_make($event->{time});
240					$self->selection_beg(1, 0);
241					$self->selection_end(1, 0);
242				}
243				return;
244			}
245		}
246	}
247
248	deactivate($self) unless $self->{found};
249
250	()
251}
252
253
254sub hilight {
255	my ($self) = @_;
256
257	if ($self->{found}) {
258		if ($self->{row} < $self->view_start() ||
259				$self->{row} >= $self->view_start() + $self->nrow) {
260			# scroll selected url into visible area
261			my $top = $self->{row} - ($self->nrow >> 1);
262			$self->view_start($top < 0 ? $top : 0);
263		}
264
265		status_area($self);
266		$self->want_refresh();
267	}
268
269	()
270}
271
272
273sub refresh {
274	my ($self) = @_;
275
276	if ($self->{found}) {
277		$self->scr_xor_span(@{$self->{found}[$self->{n}]}[0 .. 3], urxvt::RS_RVid);
278	}
279
280	()
281}
282
283
284sub status_area {
285	my ($self) = @_;
286
287	my $row = $self->{row} < 0 ?
288			$self->{row} - $self->top_row : abs($self->top_row) + $self->{row};
289	my $text = sprintf("%d,%d ", $row + 1, $self->{n} + 1);
290
291	if ($self->top_row == 0) {
292		$text .= "All";
293	} elsif ($self->view_start() == $self->top_row) {
294		$text .= "Top";
295	} elsif ($self->view_start() == 0) {
296		$text .= "Bot";
297	} else {
298		$text .= sprintf("%2d%",
299				($self->top_row - $self->view_start) * 100 / $self->top_row);
300	}
301
302	my $text_len = length($text);
303
304	if ($self->{overlay_len} != $text_len) {
305		delete $self->{overlay} if $self->{overlay};
306		$self->{overlay} = $self->overlay(-1, -1, $text_len, 1,
307				urxvt::OVERLAY_RSTYLE, 0);
308		$self->{overlay_len} = $text_len;
309	}
310
311	$self->{overlay}->set(0, 0, $self->special_encode($text));
312	$self->{overlay}->show();
313
314	()
315}
316
317
318sub tt_write {
319	return 1;
320}
321
322
323sub activate {
324	my ($self) = @_;
325
326	$self->{active} = 1;
327
328	$self->{row} = $self->view_start() + $self->nrow;
329	$self->{n} = 0;
330	$self->{overlay_len} = 0;
331	$self->{button_pressed} = 0;
332
333	$self->{view_start} = $self->view_start();
334	$self->{pty_ev_events} = $self->pty_ev_events(urxvt::EV_NONE);
335
336	$self->enable(
337		key_press     => \&key_press,
338		refresh_begin => \&refresh,
339		refresh_end   => \&refresh,
340		tt_write      => \&tt_write,
341	);
342
343	()
344}
345
346
347sub deactivate {
348	my ($self) = @_;
349
350	$self->disable("key_press", "refresh_begin", "refresh_end", "tt_write");
351	$self->view_start($self->{view_start});
352	$self->pty_ev_events($self->{pty_ev_events});
353
354	delete $self->{overlay} if $self->{overlay};
355	delete $self->{found} if $self->{found};
356
357	$self->want_refresh();
358
359	$self->{active} = 0;
360
361	()
362}
363