ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/selection
Revision: 1.14
Committed: Fri Jan 6 20:50:58 2006 UTC (18 years, 4 months ago) by root
Branch: MAIN
Changes since 1.13: +6 -1 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #! perl
2
3 sub on_keyboard_command {
4 my ($self, $cmd) = @_;
5
6 $cmd eq "selection:rot13"
7 and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection);
8
9 ()
10 }
11
12 my @patterns = (
13 # urls, just a heuristic
14 qr{(
15 (?:https?|ftp|news|mailto|file)://[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~]+
16 [ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27(),~] # do not include a trailing dot, its wrong too often
17 )}x,
18
19 # common forms of quoting
20 qr{(?:^|\s) [‘`] ([^‘`’']+) [’'] (?:\s|$)}x,
21
22 # shell-like argument quoting
23 qr{\G [\ \t|&;<>()] *(
24 (?:
25 [^\\"'\ \t|&;<>()]+
26 | \\.
27 | " (?: [^\\"]+ | \\. )* "
28 | ' [^']* '
29 )+
30 )}x,
31 );
32
33 my $x = "‘hallole’";
34
35 sub on_sel_extend {
36 my ($self) = @_;
37
38 my ($row, $col) = $self->selection_mark;
39 my $line = $self->line ($row);
40 my $offset = $line->offset_of ($row, $col);
41 my $text = $line->t;
42
43 for my $regex (@patterns) {
44 while ($text =~ /$regex/g) {
45 if ($-[1] <= $offset and $offset <= $+[1]) {
46 $self->selection_beg ($line->coord_of ($-[1]));
47 $self->selection_end ($line->coord_of ($+[1]));
48 return 1;
49 }
50 }
51 }
52
53 ()
54 }