#! 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: