blob: d09eaf19a8676705e57b8c802793d05182e63b96 (
plain) (
tree)
|
|
#!/usr/bin/env perl
# Stripped down and tidied version of original URxvt
# "selection" script that just observes cutchars in a
# locale-aware fashion.
use strict;
use warnings;
use utf8;
use 5.006;
use Carp;
our $VERSION = 1.0;
sub on_init {
my ($self) = @_;
if ( defined( my $res = $self->resource("cutchars") ) ) {
$res = $self->locale_decode($res);
push @{ $self->{patterns} },
qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x;
}
$self->{enabled} = 1;
return ();
}
sub on_sel_extend {
my ( $self, $time ) = @_;
$self->{enabled}
or return;
my ( $row, $col ) = $self->selection_mark;
my $line = $self->line($row);
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;
if ( $markofs < $line->l ) {
study $text; # _really_ helps, too :)
for my $regex ( @{ $self->{patterns} } ) {
while ( $text =~ /$regex/g ) {
if ( $-[1] <= $markofs and $markofs <= $+[1] ) {
my $ofs = $-[1];
my $match = $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;
}
return ();
}
|