--- rxvt-unicode/src/perl/selection 2006/01/03 19:42:53 1.7 +++ rxvt-unicode/src/perl/selection 2006/01/10 21:20:53 1.19 @@ -9,8 +9,64 @@ () } +# "find interetsing things"-patterns +my @mark_patterns = ( + # 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) + )}x, + + # common "parentheses" + qr{(?:^|\s) ‘ ([^‘’]+?) ’ (?:\s|\)|$)}x, + qr{(?:^|\s) ` ([^`']+?) ' (?:\s|\)|$)}x, + qr{ \{ ([^{}]+?) \} }x, + qr{ \[ ([^{}]+?) \] }x, + + # shell-like argument quoting, basically always matches + qr{\G [\ \t|&;<>()] *( + (?: + [^\\"'\ \t|&;<>()]+ + | \\. + | " (?: [^\\"]+ | \\. )* " + | ' [^']* ' + )+ + )}x, +); + +# "correct obvious? crap"-patterns +my @simplify_patterns = ( + qr{^"([^\\"'\ \t|&;<>()*?]+)"$}, # "simple" => simple + qr{^(.*)[,\-]$}, # strip off trailing , and - +); + sub on_sel_extend { my ($self) = @_; - warn $self->selection; + + my ($row, $col) = $self->selection_mark; + my $line = $self->line ($row); + my $offset = $line->offset_of ($row, $col); + my $text = $line->t; + + for my $regex (@mark_patterns) { + while ($text =~ /$regex/g) { + if ($-[1] <= $offset and $offset <= $+[1]) { + my $ofs = $-[1]; + my $match = $1; + + for my $regex (@simplify_patterns) { + if ($match =~ $regex) { + $match = $1; + $ofs += $-[1]; + } + } + + $self->selection_beg ($line->coord_of ($ofs)); + $self->selection_end ($line->coord_of ($ofs + length $match)); + return 1; + } + } + } + () }