1 files changed, 93 insertions, 0 deletions
diff --git a/urxvt/ext/select.pl b/urxvt/ext/select.pl
new file mode 100644
index 00000000..90b13960
--- /dev/null
+++ b/urxvt/ext/select.pl
@@ -0,0 +1,93 @@
+# Tom Ryder's choice of selection behaviours for urxvt, butchered from included
+# URxvt extension scripts.
+
+# Force me to write this properly
+use strict;
+use warnings;
+use utf8;
+
+# Require at least this version of Perl
+use 5.006;
+
+# Use plain-English variable names
+use English qw(-no_match_vars);
+
+# Set version of this extension
+our $VERSION = 1.0;
+
+# On creation, read all of cutchars into a list of regex-quoted patterns
+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:]]+) }msx;
+    }
+    return ();
+}
+
+# Handle multiple-clicking selection extension
+sub on_sel_extend {
+    my ($self) = @_;
+
+    # Get attributes of the current selection
+    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 );
+
+    # Find all the possible matches
+    my @matches;
+    if ( $markofs < $line->l ) {
+
+        # `perldoc -f study` says this does nothing useful anymore since
+        # version 5.16
+        study $text;
+
+        for my $regex ( @{ $self->{patterns} } ) {
+            while ( $text =~ m{$regex}gmsx ) {
+                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 ];
+                }
+            }
+        }
+    }
+
+    # If no more clever patterns matched, just snarf the whole line
+    push @matches, [ 0, ( $line->end - $line->beg + 1 ) * $self->ncol ];
+
+    # Iterate over the matches to choose the shortest one
+  MATCH:
+    for (
+        sort {    ## no critic (ProhibitReverseSortBlock)
+            $a->[1] <=> $b->[1]
+              or $b->[0] <=> $a->[0]
+        } @matches
+      )
+    {
+        my ( $ofs, $len ) = @{$_};
+        next MATCH if $len <= $curlen;
+        $self->selection_beg( $line->coord_of($ofs) );
+        $self->selection_end( $line->coord_of( $ofs + $len ) );
+        return 1;
+    }
+
+    # Done
+    return ();
+}
+
+# Copy selections to CLIPBOARD as well as PRIMARY.
+sub on_sel_grab {
+    my ( $self, $time ) = @_;
+    $self->selection( $self->selection, 1 );
+    $self->selection_grab( $time, 1 );
+    return ();
+}