aboutsummaryrefslogtreecommitdiff
path: root/urxvt/ext/select.pl
diff options
context:
space:
mode:
authorTom Ryder <tom@staff.inspire.net.nz>2016-08-31 11:07:00 +1200
committerTom Ryder <tom@staff.inspire.net.nz>2016-08-31 11:07:00 +1200
commitc85c08a1bd0819b4b222297e9b268688bf5b5448 (patch)
treed1e14954298afcc80d3ce6f4912e409d2eb86ea9 /urxvt/ext/select.pl
parent92e7b8cd774c9cb6cf76adde9b15e15bf93dc0cc (diff)
downloaddotfiles-c85c08a1bd0819b4b222297e9b268688bf5b5448.tar.gz
dotfiles-c85c08a1bd0819b4b222297e9b268688bf5b5448.zip
Build URxvt Perls with shb(1)
Diffstat (limited to 'urxvt/ext/select.pl')
-rw-r--r--urxvt/ext/select.pl93
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 ();
+}