#! perl
# ------------------------------------------------------------------------
# Author: Bart Trojanowski <bart@jukie.net>
#
# This script intends to provide functionality similar to screen's
# copy-mode, but instead copy to the X clipboard. In order to copy to
# the clipboard we need either the Clipboard.pm from CPAN or the xclip
# command line utility.
#
# More details here: http://www.jukie.net/~bart/blog/tag/urxvt
#
# This script is based on the mark-urls script from the rxvt-unicode
# distribution.
#
# ------------------------------------------------------------------------
# configuration
#
# Put this in your .Xdefaults
#
# URxvt.keysym.M-y: perl:mark-and-yank:activate_mark_mode
# URxvt.keysym.M-u: perl:mark-and-yank:activate_mark_url_mode
# URxvt.perl-lib: /home/jukie/bart/.urxvt/
# URxvt.perl-ext: mark-and-yank
# URxvt.urlLauncher: firefox
#
# you might have to edit the perl-lib line.
#
# ------------------------------------------------------------------------
use List::Util qw(first max maxstr min minstr reduce shuffle sum);
# same url as used in "selection"
my $url_matcher =
qr{(
(?:https?://|ftp://|news://|mailto:|file://)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+
[ab-zA-Z0-9\-\@;\/?:&=%\$_+!*\x27()~] # exclude some trailing characters (heuristic)
)}x;
sub canonicalise_coordinates {
if ($_[0] > $_[2] || ($_[0] == $_[2] && $_[1] > $_[3])) {
(@_[2,3],@_[0,1])
} else {
(@_);
}
}
sub clamp { min( max( $_[0], $_[1] ), $_[2] ) }
sub on_start {
my ($term) = @_;
$term->{have_Clipboard} = eval { require Clipboard; };
if ($term->{have_Clipboard}) {
import Clipboard;
}
$term->{browser} = $term->x_resource ("urlLauncher") || "x-www-browser";
()
}
sub open_url {
my ($term, $url) = @_;
$term->exec_async (split(/[[:blank:]]/, $term->{browser}), $url);
}
sub on_line_update {
my ($term, $row) = @_;
return unless ($term->x_resource ("underlineURLs") eq "true");
# fetch the line that has changed
my $line = $term->line ($row);
my $text = $line->t;
# find all urls (if any)
while ($text =~ /$url_matcher/g) {
my $rend = $line->r;
# mark all characters as underlined. we _must_ not toggle underline,
# as we might get called on an already-marked url.
$_ |= urxvt::RS_Uline
for @{$rend}[ $-[1] .. $+[1] - 1];
$line->r ($rend);
}
()
}
sub on_button_release {
my ($term, $event) = @_;
my $mask = $term->ModLevel3Mask | $term->ModMetaMask
| urxvt::ShiftMask | urxvt::ControlMask;
if ($event->{button} == 2 && ($event->{state} & $mask) == 0) {
my $row = $event->{row};
my $col = $event->{col};
my $line = $term->line ($row);
my $text = $line->t;
while ($text =~ /$url_matcher/g) {
if ($-[1] <= $col && $+[1] >= $col) {
open_url($term, $1);
return 1;
}
}
}
()
}
# ------------------------------------------------------------------------
my %key2mod = (
65505 => urxvt::ShiftMask,
65507 => urxvt::ControlMask,
65513 => urxvt::Mod1Mask, # Alt
65514 => urxvt::Mod1Mask, # Alt
65515 => urxvt::Mod4Mask, # Super
65516 => urxvt::Mod4Mask, # Super
);
my $mod = 0;
#my %mod = ( 'control' => 0, 'shift' => 0 );
my $mark_mode_active = 0;
my @backup_cursor = ();
my @visual_start = ();
my $visual_mode = 0; # 'v', 'V', or '^v'
my @cursor = ();
my $url_selected = -1;
my @url_db = ();
my $first_mark_set = 0;
my $msg_timeout = 2;
# ------------------------------------------------------------------------
sub do_scan_for_urls {
my ($term) = @_;
@url_db = ();
my $row_start = $term->top_row;
my $row_end = $term->nrow;
for (my $row=$row_start; $row<=$row_end; $row++) {
# fetch the line that has changed
my $line = $term->line ($row);
my $text = $line->t;
# find all urls (if any)
while ($text =~ /$url_matcher/g) {
my $url = $1;
my %h = ( 'row' => $row,
'col_from' => $-[1],
'col_to' => $+[1] - 1,
'url' => $url);
push @url_db, \%h;
}
}
# 0 for none, positive count otherwise
return $#url_db + 1;
}
sub status_message {
my ($self, $text, $timeout) = @_;
$timeout = $msg_timeout unless defined $timeout;
$self->{msg} = {
ov => $self->overlay (0, -1, length($text)+1, 1, urxvt::OVERLAY_RSTYLE, 1),
to => urxvt::timer
->new
->start (urxvt::NOW + $timeout)
->cb (sub {
delete $self->{msg};
}),
};
$self->{msg}{ov}->set(0,0,$text);
}
sub on_user_command {
my ($term, $cmd) = @_;
if ($cmd eq "mark-and-yank:activate_mark_mode") {
activate_mark_mode($term);
} elsif ($cmd eq "mark-and-yank:activate_mark_url_mode") {
activate_mark_url_mode($term);
}
status_message ($term, "urxvt copy mode started");
()
}
# ------------------------------------------------------------------------
sub on_key_press {
my ($term, $event, $keysym, $octets) = @_;
foreach my $key (keys %key2mod) {
if ($keysym == $key) {
$mod |= $key2mod{$key};
return ();
}
}
# ignore all input when we are active
$mark_mode_active && return 1;
()
}
sub on_key_release {
my ($term, $event, $keysym) = @_;
foreach my $key (keys %key2mod) {
if ($keysym == $key) {
$mod &= ~$key2mod{$key};
return ();
}
}
return () unless ($mark_mode_active);
my $ch = chr($keysym);
if ($mod & urxvt::ShiftMask && $ch =~ m/[[:alpha:]]/) {
$ch = uc $ch;
$mod &= ~urxvt::ShiftMask;
}
if (!$mod && $keysym == 65307) { # <esc>
deactivate_mark_mode ($term);
visual_mode_disable ($term, @cursor);
} elsif (($mod & urxvt::ControlMask) && $ch eq 'c') {# ^c - abort
deactivate_mark_mode ($term);
visual_mode_disable ($term, @cursor);
} elsif (!$mod && $keysym == 65293) { # <enter>
if ($first_mark_set) {
do_copy($term, @visual_start, @cursor);
deactivate_mark_mode ($term);
visual_mode_disable ($term, @cursor);
} else {
my %url = get_active_url($term);
if (not %url) {
$first_mark_set = 1;
visual_mode_enable ($term, 'v', @cursor);
} else {
my $urltext = $url{url};
$urltext =~ s/\(["|><&()]\)/\\$1/;
open_url($term, $urltext);
deactivate_mark_mode ($term);
visual_mode_disable ($term, @cursor);
}
}
} elsif (!$mod && $keysym == 32) { # <space>
if ($first_mark_set) {
do_copy($term, @visual_start, @cursor);
deactivate_mark_mode ($term);
visual_mode_disable ($term, @cursor);
} else {
$first_mark_set = 1;
visual_mode_enable ($term, 'v', @cursor);
}
} elsif (!$mod && $ch eq 'o') { # o - go to other end of region
if ($first_mark_set) {
my @dest = @visual_start;
@visual_start = @cursor;
@cursor = @dest;
$term->screen_cur (@dest);
$term->want_refresh;
}
} elsif (($mod & urxvt::ControlMask) && $ch eq 'w') {# w - copy the word under the cursor
my ($y1, $x1, $y2, $x2) = (@cursor, @cursor);
--$x1 while substr($term->ROW_t($y1), $x1 - 1, 1) =~ m/\w/;
++$x2 while substr($term->ROW_t($y2), $x2 + 1, 1) =~ m/\w/;
do_copy($term, $y1, $x1, $y2, $x2);
deactivate_mark_mode ($term);
visual_mode_disable ($term, @cursor);
} elsif ($ch eq 'Y') { # Y - yank from cursor to EOL
do_copy($term, @cursor, $cursor[0], $term->ROW_l($cursor[0]) - $cursor[0]);
deactivate_mark_mode ($term);
visual_mode_disable ($term, @cursor);
} elsif (!$mod && $ch eq 'y') { # y - yank selected
my %url = get_active_url ($term);
do_copy($term, $url{row}, $url{col_from}, $url{row}, $url{col_to}) if %url;
deactivate_mark_mode ($term);
visual_mode_disable ($term, @cursor);
} elsif (($mod & urxvt::ControlMask) && (($ch eq 'n') || ($ch eq 'p'))) {
# ^n and ^p to cycle list
my $dir = ($ch eq 'n') ? 1 : -1;
move_url_highlight ($term, $dir);
visual_mode_disable ($term, @cursor);
} elsif (($mod & urxvt::ControlMask) && (($ch eq 'f') || ($ch eq 'b'))) {
# ^f and ^b to scroll
my $ofs = ($ch eq 'f') ? 1 : -1;
visual_mode_update ($term, \@cursor, [$cursor[0] + $ofs*($term->nrow - 1), $cursor[1]]);
} elsif (!$mod && $ch eq 'h') { # left
if ($cursor[1] > 0) {
visual_mode_update ($term, \@cursor, [$cursor[0], $cursor[1] - 1]);
}
} elsif (!$mod && $ch eq 'j') { # down
if ($cursor[0] < $term->nrow) {
visual_mode_update ($term, \@cursor, [$cursor[0] + 1, $cursor[1]]);
}
} elsif (!$mod && $ch eq 'k') { # up
if ($cursor[0] > $term->top_row) {
visual_mode_update ($term, \@cursor, [$cursor[0] - 1, $cursor[1]]);
}
} elsif (!$mod && $ch eq 'l') { # right
if ($cursor[1] < ($term->ncol - 1)) {
visual_mode_update ($term, \@cursor, [$cursor[0], $cursor[1] + 1]);
}
} elsif ($ch eq 'H') {
visual_mode_update ($term, \@cursor, [0, $cursor[1]]);
} elsif ($ch eq 'M') {
visual_mode_update ($term, \@cursor, [$term->nrow / 2, $cursor[1]]);
} elsif ($ch eq 'L') {
visual_mode_update ($term, \@cursor, [$term->nrow, $cursor[1]]);
} elsif ($ch eq '^') {
$term->ROW_t($cursor[0]) =~ m/^\s*/;
visual_mode_update ($term, \@cursor, [$cursor[0], $+[0]]);
} elsif ($ch eq '0') {
visual_mode_update ($term, \@cursor, [$cursor[0], 0]);
} elsif ($ch eq '$') {
visual_mode_update ($term, \@cursor, [$cursor[0], $term->ROW_l($cursor[0]) - 1]);
} elsif ($ch eq 'g') {
visual_mode_update ($term, \@cursor, [$term->top_row, 0]);
} elsif ($ch eq 'G') {
visual_mode_update ($term, \@cursor, [$term->nrow - 1, $term->ROW_l($term->nrow - 1) - 1]);
} elsif ($ch eq 'w') {
my @dest = @cursor;
my $line = $term->ROW_t($dest[0]);
++$dest[1] while substr($line, $dest[1], 1) =~ m/\w/;
until (substr($line, $dest[1], 1) =~ m/\w/) {
++$dest[1];
next if $dest[1] <= $term->ROW_l($dest[0]);
++$dest[0];
return 1 if $dest[0] >= $term->nrow;
$dest[1] = 0;
$line = $term->ROW_t($dest[0]);
}
visual_mode_update ($term, \@cursor, \@dest);
} elsif ($ch eq 'e') {
my @dest = @cursor;
my $line = $term->ROW_t($dest[0]);
++$dest[1];
++$dest[1] while substr($line, $dest[1], 1) =~ m/\W/;
until (substr($line, $dest[1], 1) =~ m/\w/) {
++$dest[1];
next if $dest[1] <= $term->ROW_l($dest[0]);
++$dest[0];
return 1 if $dest[0] >= $term->nrow;
$dest[1] = 0;
$line = $term->ROW_t($dest[0]);
}
++$dest[1] while substr($line, $dest[1] + 1, 1) =~ m/\w/;
visual_mode_update ($term, \@cursor, \@dest);
} elsif ($ch eq 'b') {
my @dest = @cursor;
my $line = $term->ROW_t($dest[0]);
# unless at the beginning of a word, jump to the beginning
--$dest[1] while ($dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\w/);
if ($dest[1] == $cursor[1]) { # at beginning of a word
# skip non-word characters
until ($dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\w/) {
--$dest[1];
next if $dest[1] > 0;
--$dest[0];
return 1 if $dest[0] < 0;
$dest[1] = $term->ROW_l($dest[0]);
$line = $term->ROW_t($dest[0]);
}
--$dest[1] while $dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\w/;
}
visual_mode_update ($term, \@cursor, \@dest);
} elsif ($ch eq 'W') {
my @dest = @cursor;
my $line = $term->ROW_t($dest[0]);
++$dest[1] while substr($line, $dest[1], 1) =~ m/\S/;
until (substr($line, $dest[1], 1) =~ m/\S/) {
++$dest[1];
next if $dest[1] <= $term->ROW_l($dest[0]);
++$dest[0];
return 1 if $dest[0] >= $term->nrow;
$dest[1] = 0;
$line = $term->ROW_t($dest[0]);
}
visual_mode_update ($term, \@cursor, \@dest);
} elsif ($ch eq 'E') {
my @dest = @cursor;
my $line = $term->ROW_t($dest[0]);
++$dest[1];
++$dest[1] while substr($line, $dest[1], 1) =~ m/\s/;
until (substr($line, $dest[1], 1) =~ m/\S/) {
++$dest[1];
next if $dest[1] <= $term->ROW_l($dest[0]);
++$dest[0];
return 1 if $dest[0] >= $term->nrow;
$dest[1] = 0;
$line = $term->ROW_t($dest[0]);
}
++$dest[1] while substr($line, $dest[1] + 1, 1) =~ m/\S/;
visual_mode_update ($term, \@cursor, \@dest);
} elsif ($ch eq 'B') {
my @dest = @cursor;
my $line = $term->ROW_t($dest[0]);
--$dest[1] while ($dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\S/);
until ($dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\S/) {
--$dest[1];
next if $dest[1] > 0;
--$dest[0];
return 1 if $dest[0] < 0;
$dest[1] = $term->ROW_l($dest[0]);
$line = $term->ROW_t($dest[0]);
}
--$dest[1] while $dest[1] >= 1 && substr($line, $dest[1] - 1, 1) =~ m/\S/;
visual_mode_update ($term, \@cursor, \@dest);
}
return 1;
}
# ------------------------------------------------------------------------
sub get_active_url {
my ($term) = @_;
my $max = $#url_db + 1;
return if $url_selected < 0 || $url_selected >= $max;
return if not defined $url_db[$url_selected];
return %{$url_db[$url_selected]};
}
sub do_copy {
my $term = shift;
my ($y1, $x1, $y2, $x2) = canonicalise_coordinates(@_);
$term->selection_beg($y1, $x1);
$term->selection_end($y2, 1 + $x2);
$term->selection_make(urxvt::CurrentTime);
my $text = $term->selection();
if ($term->{have_Clipboard}) {
Clipboard->copy($text);
} else {
my $pid = open(XCLIP, "|xclip -i");
print XCLIP $text;
close(XCLIP)
}
status_message ($term, "copied ".length($text)." characters into clipboard");
}
# ------------------------------------------------------------------------
sub move_url_highlight {
my ($term, $dir) = @_;
my $max = $#url_db + 1;
do_highlight ($term, 0);
$url_selected = ($max + $url_selected + $dir) % $max;
do_highlight ($term, 1);
$term->want_refresh;
}
sub do_highlight {
my ($term, $enable) = @_;
my $max = $#url_db + 1;
return if $url_selected < 0 || $url_selected >= $max;
return if not defined $url_db[$url_selected];
my $o = $url_db[$url_selected];
my %h = %$o;
my $row = $h{row};
my $line = $term->line ($row);
my $text = $line->t;
my $rend = $line->r;
if ($enable) {
$_ |= urxvt::RS_RVid
for @{$rend}[ $h{col_from} .. $h{col_to}];
# make it visible
$term->view_start ( $row < 0 ? $row : 0 );
} else {
$_ &= ~urxvt::RS_RVid
for @{$rend}[ $h{col_from} .. $h{col_to}];
}
$line->r ($rend);
}
# ------------------------------------------------------------------------
sub visual_mode_enable {
my ($term, $mode, @cur) = @_;
$visual_mode = $mode;
@visual_start = @cur;
}
sub visual_mode_disable {
my ($term, @cursor) = @_;
if ($visual_mode) {
$term->scr_xor_span(canonicalise_coordinates(@visual_start, @cursor));
$visual_mode = 0;
$term->want_refresh;
}
}
sub visual_mode_update {
my ($term, $oldref, $newref) = @_;
my @old = @$oldref;
my @new = @$newref;
@cursor = @new;
$cursor[0] = clamp $term->top_row, $cursor[0], $term->nrow - 1;
if ($visual_mode eq 'v') {
$term->scr_xor_span(canonicalise_coordinates(@old, @new));
}
$term->screen_cur (@cursor);
$term->view_start (clamp $cursor[0] - $term->nrow + 1,
$term->view_start,
min 0, $cursor[0]);
$term->want_refresh;
}
# ------------------------------------------------------------------------
sub activate_mark_mode {
my ($term) = @_;
print "title: " . ($term->resource("title")) . "\n";
print "name: " . ($term->resource("name")) . "\n";
print "term_name: " . ($term->resource("term_name")) . "\n";
print "color: " . ($term->resource("color")) . "\n";
my ($row, $col) = $term->screen_cur;
print "cursor: $row / $col \n";
$mark_mode_active = 1;
@backup_cursor = @cursor = $term->screen_cur;
}
sub activate_mark_url_mode {
my ($term) = @_;
if ($mark_mode_active) {
move_url_highlight ($term, -1);
} elsif ( do_scan_for_urls ($term) ) {
$term->{save_view_start} = $term->view_start;
move_url_highlight ($term, 0);
if ($url_selected > -1) {
$mark_mode_active = 1;
@backup_cursor = @cursor = $term->screen_cur;
}
}
}
sub deactivate_mark_mode {
my ($term) = @_;
do_highlight ($term, 0);
$mark_mode_active = 0;
$term->screen_cur (@backup_cursor);
$first_mark_set = 0;
$url_selected = -1;
$term->view_start ($term->{save_view_start});
$term->want_refresh;
}
# vim: set et ts=4 sw=4:
