From 4eebe0773d562306a5c740a2e091ebefb14a4c9c Mon Sep 17 00:00:00 2001 From: Tom Ryder Date: Sun, 19 Jun 2016 17:04:55 +1200 Subject: Consolidate URxvt extensions --- urxvt/ext/clip | 31 ----------------- urxvt/ext/select | 97 +++++++++++++++++++++++++++++++++++++++++++++++++++++ urxvt/ext/selection | 79 ------------------------------------------- 3 files changed, 97 insertions(+), 110 deletions(-) delete mode 100644 urxvt/ext/clip create mode 100644 urxvt/ext/select delete mode 100644 urxvt/ext/selection (limited to 'urxvt/ext') 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/select b/urxvt/ext/select new file mode 100644 index 00000000..b35862b2 --- /dev/null +++ b/urxvt/ext/select @@ -0,0 +1,97 @@ +#!/usr/bin/env perl + +# +# 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 (); +} diff --git a/urxvt/ext/selection b/urxvt/ext/selection deleted file mode 100644 index e52815e2..00000000 --- a/urxvt/ext/selection +++ /dev/null @@ -1,79 +0,0 @@ -#!/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:]]+) }msx; - } - - $self->{enabled} = 1; - - return (); -} - -sub on_sel_extend { - my ($self) = @_; - - $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 =~ 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 ]; - } - } - } - } - - # 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) - 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 (); -} -- cgit v1.2.3