ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/selection
(Generate patch)

Comparing rxvt-unicode/src/perl/selection (file contents):
Revision 1.24 by root, Thu Jan 12 23:11:23 2006 UTC vs.
Revision 1.62 by root, Wed Jun 23 12:45:30 2021 UTC

1#! perl 1#! perl
2 2
3#:META:RESOURCE:%.pattern-0:string:first selection pattern
4
5=head1 NAME
6
7selection - more intelligent selection
8
9=head1 DESCRIPTION
10
11This extension tries to be more intelligent when the user extends
12selections (double-click and further clicks). Right now, it tries to
13select words, urls and complete shell-quoted arguments, which is very
14convenient, too, if your F<ls> supports C<--quoting-style=shell>.
15
16A double-click usually selects the word under the cursor, further clicks
17will enlarge the selection.
18
19The selection works by trying to match a number of regexes and displaying
20them in increasing order of length. You can add your own regexes by
21specifying resources of the form:
22
23 URxvt.selection.pattern-0: perl-regex
24 URxvt.selection.pattern-1: perl-regex
25 ...
26
27The index number (0, 1...) must not have any holes, and each regex must
28contain at least one pair of capturing parentheses, which will be used for
29the match. For example, the following adds a regex that matches everything
30between two vertical bars:
31
32 URxvt.selection.pattern-0: \\|([^|]+)\\|
33
34Another example: Programs I use often output "absolute path: " at the
35beginning of a line when they process multiple files. The following
36pattern matches the filename (note, there is a single space at the very
37end):
38
39 URxvt.selection.pattern-0: ^(/[^:]+):\
40
41You can look at the source of the selection extension to see more
42interesting uses, such as parsing a line from beginning to end.
43
44This extension also offers the following actions:
45
46=over 4
47
48=item rot13
49
50Rot-13 the selection when activated.
51
52Example:
53
54 URxvt.keysym.C-M-r: selection:rot13
55
56=back
57
58=cut
59
3sub on_keyboard_command { 60sub on_user_command {
4 my ($self, $cmd) = @_; 61 my ($self, $cmd) = @_;
5 62
6 $cmd eq "selection:rot13" 63 $cmd eq "selection:rot13"
7 and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection); 64 and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection);
8 65
9 () 66 ()
10} 67}
11 68
12sub on_init { 69sub on_action {
13 my ($self) = @_; 70 my ($self, $action) = @_;
14 71
15 for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) { 72 $action eq "rot13"
16 no re 'eval'; # just to be sure 73 and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection);
17 push @{ $self->{patterns} }, qr/$res/;
18 }
19 74
20 () 75 ()
21} 76}
22 77
78sub on_init {
79 my ($self) = @_;
80
81 if (defined (my $res = $self->resource ("cutchars"))) {
82 $res = $self->locale_decode ($res);
83 push @{ $self->{patterns} }, qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x;
84 }
85
86 for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) {
87 $res = $self->locale_decode ($res);
88 push @{ $self->{patterns} }, qr/$res/;
89 }
90
91 $self->{enabled} = 1;
92
93 push @{ $self->{term}{option_popup_hook} }, sub {
94 ("new selection" => $self->{enabled}, sub { $self->{enabled} = shift })
95 };
96
97 ()
98}
99
23# "find interetsing things"-patterns 100# "find interesting things"-patterns
24my @mark_patterns = ( 101my @mark_patterns = (
102# qr{ ([[:word:]]+) }x,
103 qr{ ([^[:space:]]+) }x,
104
25 # common types of "parentheses" 105 # common types of "parentheses"
26 qr{(?:^|\s) ‘ ([^‘’]+?) ’ (?:\s|\)|$)}x, 106 qr{ (?<![^[:space:]]) [`'] ([^`']+) [`'] (?![^[:space:]]) }x,
27 qr{(?:^|\s) ` ([^`']+?) ' (?:\s|\)|$)}x, 107 qr{ (?<![^[:space:]]) ‘ ([^‘’]+) ’ (?![^[:space:]]) }x,
108 qr{ (?<![^[:space:]]) “ ([^“”]+) ” (?![^[:space:]]) }x,
109
110 qr{ (?<![^[:space:]]) (' [^[:space:]] [^']* ') }x,
111 qr{ (' [^']* [^[:space:]] ') (?![^[:space:]]) }x,
112 qr{ (?<![^[:space:]]) (` [^[:space:]] [^']* ') }x,
113 qr{ (` [^']* [^[:space:]] ') (?![^[:space:]]) }x,
114 qr{ (?<![^[:space:]]) (" [^[:space:]] [^"]* ") }x,
115 qr{ (" [^"]* [^[:space:]] ") (?![^[:space:]]) }x,
116
28 qr{ \{ ([^{}]+?) \} }x, 117 qr{ \{ ([^\{\}]+) \} }x,
29 qr{ \[ ([^{}]+?) \] }x,
30 qr{ \( ([^()]+?) \) }x, 118 qr{ \( ([^\(\)]+) \) }x,
119 qr{ \[ ([^\[\]]+) \] }x,
120 qr{ \< ([^\<\>]+) \> }x,
31 121
32 # urls, just a heuristic 122 # urls, just a heuristic
33 qr{( 123 qr{(
34 (?:https?|ftp|news|mailto|file)://[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~]+ 124 (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+
35 [ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27()~] # exclude some trailing characters (heuristic) 125 [ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~] # exclude some trailing characters (heuristic)
36 )}x, 126 )}x,
37 127
38 # shell-like argument quoting, basically always matches 128 # shell-like argument quoting, basically always matches
39 qr{\G [\ \t|&;<>()] *( 129 qr{\G [\ \t|&;<>()]* (
40 (?: 130 (?:
41 [^\\"'\ \t|&;<>()]+ 131 [^\\"'\ \t|&;<>()]+
42 | \\. 132 | \\.
43 | " (?: [^\\"]+ | \\. )* " 133 | " (?: [^\\"]+ | \\. )* "
44 | ' [^']* ' 134 | ' [^']* '
53); 143);
54 144
55sub on_sel_extend { 145sub on_sel_extend {
56 my ($self, $time) = @_; 146 my ($self, $time) = @_;
57 147
148 $self->{enabled}
149 or return;
150
58 my ($row, $col) = $self->selection_mark; 151 my ($row, $col) = $self->selection_mark;
59 my $line = $self->line ($row); 152 my $line = $self->line ($row);
60 my $text = $line->t; 153 my $text = $line->t;
61 my $markofs = $line->offset_of ($row, $col); 154 my $markofs = $line->offset_of ($row, $col);
62 my $curlen = $line->offset_of ($self->selection_end) 155 my $curlen = $line->offset_of ($self->selection_end)
63 - $line->offset_of ($self->selection_beg); 156 - $line->offset_of ($self->selection_beg);
64 157
65 my @matches; 158 my @matches;
66 159
67 for my $regex (@mark_patterns, @{ $self->{patterns} }) { 160 if ($markofs < $line->l) {
68 while ($text =~ /$regex/g) { 161 study $text; # _really_ helps, too :)
69 if ($-[1] <= $markofs and $markofs <= $+[1]) {
70 my $ofs = $-[1];
71 my $match = $1;
72 162
73 push @matches, [$ofs, length $match]; 163 for my $regex (@mark_patterns, @{ $self->{patterns} }) {
164 while ($text =~ /$regex/g) {
165 if ($-[1] <= $markofs and $markofs <= $+[1]) {
166 my $ofs = $-[1];
167 my $match = $1;
74 168
75 for my $regex (@simplify_patterns) { 169 for my $regex (@simplify_patterns) {
76 if ($match =~ $regex) { 170 if ($match =~ $regex) {
77 $match = $1; 171 $match = $1;
78 $ofs += $-[1]; 172 $ofs += $-[1];
173 }
79 } 174 }
175
176 push @matches, [$ofs, length $match];
80 } 177 }
81
82 push @matches, [$ofs, length $match];
83 } 178 }
84 } 179 }
85 } 180 }
86 181
87 # whole line 182 # whole line

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines