aboutsummaryrefslogtreecommitdiff
path: root/urxvt/ext
diff options
context:
space:
mode:
authorTom Ryder <tom@sanctum.geek.nz>2016-06-19 17:04:55 +1200
committerTom Ryder <tom@sanctum.geek.nz>2016-06-19 17:04:55 +1200
commit4eebe0773d562306a5c740a2e091ebefb14a4c9c (patch)
tree4c8eeed4bb763dfb13cca0b2abf03a2923cf161d /urxvt/ext
parent61b28351d2f4fedb2cb1cb57caa22f6f0510f86e (diff)
downloaddotfiles-4eebe0773d562306a5c740a2e091ebefb14a4c9c.tar.gz
dotfiles-4eebe0773d562306a5c740a2e091ebefb14a4c9c.zip
Consolidate URxvt extensions
Diffstat (limited to 'urxvt/ext')
-rw-r--r--urxvt/ext/clip31
-rw-r--r--urxvt/ext/select (renamed from urxvt/ext/selection)54
2 files changed, 36 insertions, 49 deletions
diff --git a/urxvt/ext/clip b/urxvt/ext/clip
deleted file mode 100644
index cb2b1a27..00000000
--- a/urxvt/ext/clip
+++ /dev/null
@@ -1,31 +0,0 @@
-#!/usr/bin/env perl
-
-# Copy PRIMARY selections to the clipboard too with xsel(1).
-
-use strict;
-use warnings;
-use utf8;
-
-use 5.006;
-
-use Carp;
-
-our $VERSION = 1.0;
-
-sub on_start {
- my ($self) = @_;
- return $self->enable( sel_grab => \&clip );
-}
-
-sub clip {
- my ($self) = @_;
- my $selection = $self->selection();
- utf8::encode($selection);
- open my $clipboard, q{|-}, 'xsel -ib'
- or croak('xsel(1) not available');
- my $written = print {$clipboard} $selection
- or croak('Failed to write to xsel(1) pipe');
- close $clipboard
- or croak('Failed to close xsel(1) pipe');
- return $written;
-}
diff --git a/urxvt/ext/selection b/urxvt/ext/select
index e52815e2..b35862b2 100644
--- a/urxvt/ext/selection
+++ b/urxvt/ext/select
@@ -1,39 +1,40 @@
#!/usr/bin/env perl
-# Stripped down and tidied version of original URxvt "selection" script that
-# just observes cutchars in a locale-aware fashion.
+#
+# 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 Carp;
+# 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;
}
-
- $self->{enabled} = 1;
-
return ();
}
+# Handle multiple-clicking selection extension
sub on_sel_extend {
my ($self) = @_;
- $self->{enabled}
- or return ();
-
+ # Get attributes of the current selection
my ( $row, $col ) = $self->selection_mark;
my $line = $self->line($row);
my $text = $line->t;
@@ -42,10 +43,13 @@ sub on_sel_extend {
$line->offset_of( $self->selection_end ) -
$line->offset_of( $self->selection_beg );
+ # Find all the possible matches
my @matches;
-
if ( $markofs < $line->l ) {
- study $text; # _really_ helps, too :)
+
+ # `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 ) {
@@ -61,19 +65,33 @@ sub on_sel_extend {
}
}
- # whole line
+ # If no more clever patterns matched, just snarf the whole line
push @matches, [ 0, ( $line->end - $line->beg + 1 ) * $self->ncol ];
- for ( sort { $a->[1] <=> $b->[1] or $b->[0] <=> $a->[0] } @matches )
- { ## no critic (ProhibitReverseSortBlock)
+ # 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 if $len <= $curlen;
-
+ 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 ();
}