--- rxvt-unicode/src/perl/selection 2006/01/08 01:32:38 1.16 +++ rxvt-unicode/src/perl/selection 2006/01/12 23:11:23 1.24 @@ -9,18 +9,33 @@ () } +sub on_init { + my ($self) = @_; + + for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) { + no re 'eval'; # just to be sure + push @{ $self->{patterns} }, qr/$res/; + } + + () +} + # "find interetsing things"-patterns my @mark_patterns = ( + # common types of "parentheses" + qr{(?:^|\s) ‘ ([^‘’]+?) ’ (?:\s|\)|$)}x, + qr{(?:^|\s) ` ([^`']+?) ' (?:\s|\)|$)}x, + qr{ \{ ([^{}]+?) \} }x, + qr{ \[ ([^{}]+?) \] }x, + qr{ \( ([^()]+?) \) }x, + # urls, just a heuristic qr{( (?: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 + [ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27()~] # exclude some trailing characters (heuristic) )}x, - # common forms of quoting - qr{(?:^|\s) [‘`] ([^‘`’']+) [’'] (?:\s|$)}x, - - # shell-like argument quoting + # shell-like argument quoting, basically always matches qr{\G [\ \t|&;<>()] *( (?: [^\\"'\ \t|&;<>()]+ @@ -38,19 +53,25 @@ ); sub on_sel_extend { - my ($self) = @_; + my ($self, $time) = @_; my ($row, $col) = $self->selection_mark; my $line = $self->line ($row); - my $offset = $line->offset_of ($row, $col); my $text = $line->t; + my $markofs = $line->offset_of ($row, $col); + my $curlen = $line->offset_of ($self->selection_end) + - $line->offset_of ($self->selection_beg); + + my @matches; - for my $regex (@mark_patterns) { + for my $regex (@mark_patterns, @{ $self->{patterns} }) { while ($text =~ /$regex/g) { - if ($-[1] <= $offset and $offset <= $+[1]) { + if ($-[1] <= $markofs and $markofs <= $+[1]) { my $ofs = $-[1]; my $match = $1; + push @matches, [$ofs, length $match]; + for my $regex (@simplify_patterns) { if ($match =~ $regex) { $match = $1; @@ -58,12 +79,23 @@ } } - $self->selection_beg ($line->coord_of ($ofs)); - $self->selection_end ($line->coord_of ($ofs + length $match)); - return 1; + push @matches, [$ofs, length $match]; } } } + # whole line + push @matches, [0, ($line->end - $line->beg + 1) * $self->ncol]; + + for (sort { $a->[1] <=> $b->[1] or $b->[0] <=> $a->[0] } @matches) { + my ($ofs, $len) = @$_; + + next if $len <= $curlen; + + $self->selection_beg ($line->coord_of ($ofs)); + $self->selection_end ($line->coord_of ($ofs + $len)); + return 1; + } + () }