--- rxvt-unicode/src/perl/selection 2006/01/22 11:57:06 1.33 +++ rxvt-unicode/src/perl/selection 2009/12/26 10:50:46 1.52 @@ -1,6 +1,6 @@ #! perl -sub on_keyboard_command { +sub on_user_command { my ($self, $cmd) = @_; $cmd eq "selection:rot13" @@ -12,36 +12,56 @@ sub on_init { my ($self) = @_; + if (defined (my $res = $self->resource ("cutchars"))) { + $res = $self->locale_decode ($res); + push @{ $self->{patterns} }, qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x; + } + for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) { - no re 'eval'; # just to be sure $res = $self->locale_decode ($res); utf8::encode $res; push @{ $self->{patterns} }, qr/$res/; } + $self->{enabled} = 1; + + push @{ $self->{term}{option_popup_hook} }, sub { + ("new selection" => $self->{enabled}, sub { $self->{enabled} = shift }) + }; + () } -# "find interetsing things"-patterns +# "find interesting things"-patterns my @mark_patterns = ( +# qr{ ([[:word:]]+) }x, + qr{ ([^[:space:]]+) }x, + # common types of "parentheses" - qr{ (?[:space:]]+) \> }x, - qr{ \{ ([^{}[:space:]]+) \} }x, - qr{ \[ ([^{}[:space:]]+) \] }x, - qr{ \( ([^()[:space:]]+) \) }x, + qr{ (?]+) \> }x, # urls, just a heuristic qr{( - (?:https?|ftp|news|mailto|file)://[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~]+ - [ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27()~] # exclude some trailing characters (heuristic) + (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+ + [ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~] # exclude some trailing characters (heuristic) )}x, # shell-like argument quoting, basically always matches - qr{\G [\ \t|&;<>()] *( + qr{\G [\ \t|&;<>()]* ( (?: [^\\"'\ \t|&;<>()]+ | \\. @@ -60,6 +80,9 @@ sub on_sel_extend { my ($self, $time) = @_; + $self->{enabled} + or return; + my ($row, $col) = $self->selection_mark; my $line = $self->line ($row); my $text = $line->t; @@ -70,7 +93,7 @@ my @matches; if ($markofs < $line->l) { - # convert markofs form character to UTF-8 offset space + # convert markofs from character to UTF-8 offset space { my $prefix = substr $text, 0, $markofs; utf8::encode $prefix;