--- rxvt-unicode/src/perl/selection 2006/01/12 03:32:56 1.20 +++ rxvt-unicode/src/perl/selection 2006/01/17 16:53:47 1.30 @@ -9,15 +9,29 @@ () } +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 + $res = utf8::encode $self->locale_decode ($res); + push @{ $self->{patterns} }, qr/$res/; + } + + () +} + # "find interetsing things"-patterns my @mark_patterns = ( - qr{([[:alnum:]]+)}, - - # common "parentheses" - qr{(?:^|\s) ‘ ([^‘’]+?) ’ (?:\s|\)|$)}x, - qr{(?:^|\s) ` ([^`']+?) ' (?:\s|\)|$)}x, - qr{ \{ ([^{}]+?) \} }x, - qr{ \[ ([^{}]+?) \] }x, + # common types of "parentheses" + qr{ (?[:space:]]+) \> }x, + qr{ \{ ([^{}[:space:]]+) \} }x, + qr{ \[ ([^{}[:space:]]+) \] }x, + qr{ \( ([^()[:space:]]+) \) }x, # urls, just a heuristic qr{( @@ -43,7 +57,7 @@ ); sub on_sel_extend { - my ($self) = @_; + my ($self, $time) = @_; my ($row, $col) = $self->selection_mark; my $line = $self->line ($row); @@ -54,14 +68,18 @@ my @matches; - for my $regex (@mark_patterns) { + # not doing matches in unicode mode helps speed + # enourmously here. working in utf-8 should be + # equivalent due to the magic of utf-8 encoding. + utf8::encode $text; + study $text; # _really_ helps, too :) + + for my $regex (@mark_patterns, @{ $self->{patterns} }) { while ($text =~ /$regex/g) { 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; @@ -74,6 +92,9 @@ } } + # 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) = @$_; @@ -84,9 +105,5 @@ return 1; } - # whole line - $self->selection_beg ($line->beg, 0); - $self->selection_end ($line->end, $self->ncol); - - return 1; + () }