aboutsummaryrefslogtreecommitdiff
path: root/urxvt/ext/selection
blob: 1fdcc575f4d8f482595c85846e6a101bf471d6c2 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
#!/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;

   ()
}

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;
   }

   ()
}