aboutsummaryrefslogblamecommitdiff
path: root/urxvt/ext/selection
blob: d465d326c475fdd67984a646b265dc70a4c3d7d8 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11
12
13
                   
 










                                                     
                               


                   
             
                    
 
                                                             



                                                                
 
                         
 
              

 
                   
                             
 
                    
                   
 






                                                 
 
                
 

                                                
 

                                                  



                                                        
                                   
 

                                                           
             

         
 

                                                                        
 

                                                                          
 
                                
 



                                                               
 
              
 
#!/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;
use English qw(-no_match_vars);

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 (    $LAST_MATCH_START[1] <= $markofs
                    and $markofs <= $LAST_MATCH_END[1] )
                {
                    my $ofs   = $LAST_MATCH_START[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 ();
}