Added custom perl extensions

1 files changed, 653 insertions, 0 deletions

diff --git a/.urxvt/mark-and-yank b/.urxvt/mark-and-yank
new file mode 100644
index 0000000..e888507
--- /dev/null
+++ b/.urxvt/mark-and-yank
@@ -0,0 +1,653 @@
+#! 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: