ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/selection
Revision: 1.17
Committed: Sun Jan 8 05:50:27 2006 UTC (18 years, 4 months ago) by root
Branch: MAIN
Changes since 1.16: +6 -3 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 # "find interetsing things"-patterns
13 my @mark_patterns = (
14 # urls, just a heuristic
15 qr{(
16 (?:https?|ftp|news|mailto|file)://[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~]+
17 [ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27(),~] # do not include a trailing dot, its wrong too often
18 )}x,
19
20 # common "parentheses"
21 qr{(?:^|\s) ‘ ([^‘’]+?) ’ (?:\s|$)}x,
22 qr{(?:^|\s) ` ([^`']+?) ' (?:\s|$)}x,
23 qr{ \{ ([^{}]+?) \} }x,
24 qr{ \[ ([^{}]+?) \] }x,
25
26 # shell-like argument quoting, basically always matches
27 qr{\G [\ \t|&;<>()] *(
28 (?:
29 [^\\"'\ \t|&;<>()]+
30 | \\.
31 | " (?: [^\\"]+ | \\. )* "
32 | ' [^']* '
33 )+
34 )}x,
35 );
36
37 # "correct obvious? crap"-patterns
38 my @simplify_patterns = (
39 qr{^"([^\\"'\ \t|&;<>()*?]+)"$}, # "simple" => simple
40 qr{^(.*)[,\-]$}, # strip off trailing , and -
41 );
42
43 sub on_sel_extend {
44 my ($self) = @_;
45
46 my ($row, $col) = $self->selection_mark;
47 my $line = $self->line ($row);
48 my $offset = $line->offset_of ($row, $col);
49 my $text = $line->t;
50
51 for my $regex (@mark_patterns) {
52 while ($text =~ /$regex/g) {
53 if ($-[1] <= $offset and $offset <= $+[1]) {
54 my $ofs = $-[1];
55 my $match = $1;
56
57 for my $regex (@simplify_patterns) {
58 if ($match =~ $regex) {
59 $match = $1;
60 $ofs += $-[1];
61 }
62 }
63
64 $self->selection_beg ($line->coord_of ($ofs));
65 $self->selection_end ($line->coord_of ($ofs + length $match));
66 return 1;
67 }
68 }
69 }
70
71 ()
72 }