--- rxvt-unicode/src/perl/selection 2006/01/04 20:43:38 1.11 +++ rxvt-unicode/src/perl/selection 2006/01/09 01:06:55 1.18 @@ -9,22 +9,35 @@ () } -my @patterns = ( +# "find interetsing things"-patterns +my @mark_patterns = ( # urls, just a heuristic qr{( - (?:https?|ftp|news|mailto|file)://[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),]+ - [^.] # do not include a trailing dot, its wrong too often + (?:https?|ftp|news|mailto|file)://[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~]+ + [ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27(),~] # do not include a trailing dot, its wrong too often )}x, - # shell-like argument quoting + # 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|&;<>()]+ | \\. - | " ([^\\"]+ | \\. )* " + | " (?: [^\\"]+ | \\. )* " | ' [^']* ' )+ - )}xs, + )}x, +); + +# "correct obvious? crap"-patterns +my @simplify_patterns = ( + qr{^"([^\\"'\ \t|&;<>()*?]+)"$}, # "simple" => simple + qr{^(.*)[,\-]$}, # strip off trailing , and - ); sub on_sel_extend { @@ -35,11 +48,21 @@ my $offset = $line->offset_of ($row, $col); my $text = $line->t; - for my $regex (@patterns) { + for my $regex (@mark_patterns) { while ($text =~ /$regex/g) { if ($-[1] <= $offset and $offset <= $+[1]) { - $self->selection_beg ($line->coord_of ($-[1])); - $self->selection_end ($line->coord_of ($+[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; } }