--- rxvt-unicode/src/perl/selection 2006/01/12 23:11:23 1.24 +++ rxvt-unicode/src/perl/selection 2006/01/22 11:57:06 1.33 @@ -14,6 +14,8 @@ 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/; } @@ -23,11 +25,14 @@ # "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, + qr{ (?[:space:]]+) \> }x, + qr{ \{ ([^{}[:space:]]+) \} }x, + qr{ \[ ([^{}[:space:]]+) \] }x, + qr{ \( ([^()[:space:]]+) \) }x, # urls, just a heuristic qr{( @@ -64,22 +69,35 @@ my @matches; - 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; - $ofs += $-[1]; + if ($markofs < $line->l) { + # convert markofs form character to UTF-8 offset space + { + my $prefix = substr $text, 0, $markofs; + utf8::encode $prefix; + $markofs = length $prefix; + } + + # 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; + + for my $regex (@simplify_patterns) { + if ($match =~ $regex) { + $match = $1; + $ofs += $-[1]; + } } - } - push @matches, [$ofs, length $match]; + push @matches, [$ofs, length $match]; + } } } } @@ -92,6 +110,18 @@ next if $len <= $curlen; + # convert back from UTF-8 offset space to character space + { + my $length = substr "$text ", $ofs, $len; + utf8::decode $length; + $len = length $length; + } + { + my $prefix = substr $text, 0, $ofs; + utf8::decode $prefix; + $ofs = length $prefix; + } + $self->selection_beg ($line->coord_of ($ofs)); $self->selection_end ($line->coord_of ($ofs + $len)); return 1;