#! perl -w

# Emacs keyboard selection for URXVT
# Use keyboard shortcuts to select and copy text using emacs hotkeys
# Author: Russell Adams <rladams@adamsinfoserv.com>
# Website: https://osdn.net/users/rladams/pf/emacs-kbd-select/scm/tree/tip/
# License: GPLv2 (respecting partial derivatives)

# Tested on Gentoo using rxvt-unicode (urxvt) v9.22 - released: 2016-01-23
# options: perl,xft,styles,combining,encodings=eu+vn+jp+jp-ext+kr+zh+zh-ext,fade,transparent,
#          tint,pixbuf,XIM,frills,selectionscrolling,wheel,slipwheel,cursorBlink,pointerBlank,
#          scrollbars=plain+rxvt+NeXT+xterm

# Perl API docs at http://pod.tst.eu/http://cvs.schmorp.de/rxvt-unicode/src/urxvt.pm

# Inspired from the original by:
#  Author:   Bert Muennich
#  Website:  http://www.github.com/muennich/urxvt-perls
#  License:  GPLv2

# Usage: Add to .Xdefaults:
#  URxvt.perl-ext-common: emacs-kbd-select
#  URxvt.keysym.M-Escape: emacs-kbd-select:enter
#
# Consider disabling searchable-scrollback and keyboard-select (vi) to prevent key conflicts.

# Supported keys/actions:
#  - Control-{n,p,f,b}/arrows    cursor movement across characters
#  - Meta-{f,b}                  across words/pages
#  - Meta-{n,p}                  page down/up
#  - Control-{a,e}               BOL/EOL
#  - Control-g                   Cancel
#  - Meta-{<,>}                  BOF/EOF
#  - Control-space               Set mark
#  - Control-w                   Yank from mark to point
#  - Control-k                   Quick yank from cursor to EOL
#  - M-{d,backspace}             Quick yank word forward/backward
#  - Control-{s,r}               search forward/backward

use strict;

# Note: Debugging print statements goto the stdout of the urxvt process, not to
# the open terminal. These are commented out for use.

######################################################################
# Initialization

# does not use the deprecated on_user_command function
# hook to enable our mode
sub on_action {
    my ($self, $action) = @_;

    if ($action eq 'enter') {
        enter($self);
    }

	return (); # Return false, do not consume events
}


######################################################################
# Set key mappings!

# setup keymaps on load, there is no switch/case so lets use dispatch tables
sub on_start {
    my ($self) = @_;

    # Are there concerns here with Perl and closures? I am assuming that each of these $self
    # vars will be the same valid pointer to self even though they are stored.
    # The alternative is to always pass $self on call, which may be safer.
    $self->{'navigation-key-map'} = {
        'q'   => sub { leave($self); }, # q/Q quits
        'C-g' => sub { leave($self); }, # Control-g quits
        'C-p' => sub { move_cursor_delta($self, -1,  0); }, # C-p (Up)
        'C-n' => sub { move_cursor_delta($self,  1,  0); }, # C-n (Down)
        'C-b' => sub { move_cursor_delta($self,  0, -1); }, # C-b (Left)
        'C-f' => sub { move_cursor_delta($self,  0,  1); }, # C-f (Right)
        'C-a' => sub { BOL($self); }, # BOL
        'C-e' => sub { EOL($self); }, # EOL
        'M-<' => sub { BOB($self); }, # Beginning of buffer
        'M->' => sub { EOB($self); }, # End of buffer
        'M-p' => sub { PgUp($self); }, # Page Up
        'M-n' => sub { PgDn($self); }, # Page Down
        'M-f' => sub { FwdWrd($self); }, # Forward word
        'M-b' => sub { BckWrd($self); }, # Backward word
        'C- ' => sub { SetMark($self); }, # Set mark (begin selection)
        'C-w' => sub { Kill($self); }, # Kill from mark to cursor (point) and put in clipboard
        'M-w' => sub { Kill($self); }, # Kill from mark to cursor (point) and put in clipboard
        'C-k' => sub { KillToEOL($self); }, # Kill from cursor to end of line
        'M-d' => sub { KillFwdWrd($self); }, # Kill from cursor to end of word
        'C-r' => sub { SearchBck($self); }, # Begin backward search
        'C-s' => sub { SearchFwd($self); }, # Begin forward search
    };

    $self->{'navigation-alt-keysym-map'} = {
        0xff51 => sub { BckWrd($self); }, # Alt-Left arrow back word
        0xff53 => sub { FwdWrd($self); }, # Alt-Right arrow forward word
        0xff52 => sub { PgUp($self); }, # Alt Up, page up
        0xff54 => sub { PgDn($self); }, # Alt Down, page down
        0xff08 => sub { KillBckWrd($self); }, # Alt backspace, Kill from cursor back to start of word
    };

    $self->{'navigation-keysym-map'} = {
        0xff1b => sub { leave($self); }, # ESC quits
        0xff52 => sub { move_cursor_delta($self, -1,  0); }, # Up arrow
        0xff54 => sub { move_cursor_delta($self,  1,  0); }, # Down arrow
        0xff51 => sub { move_cursor_delta($self,  0, -1); }, # Left arrow
        0xff53 => sub { move_cursor_delta($self,  0,  1); }, # Right arrow
        0xff55 => sub { PgUp($self); }, # Page Up
        0xff56 => sub { PgDn($self); }, # Page Down
    };

    $self->{'search-keysym-map'} = {
        0xff1b => sub { SearchQuit($self); }, # ESC quits back to navigation
        0xff0d => sub { SearchComplete($self); }, # Return quits leaving cursor at result
        0xff08 => sub { SearchBackspace($self); }, # Backspace deletes from the end
        0xff51 => sub { SearchComplete($self); }, # Arrows quit leaving cursor at result
        0xff52 => sub { SearchComplete($self); }, # Arrows quit leaving cursor at result
        0xff53 => sub { SearchComplete($self); }, # Arrows quit leaving cursor at result
        0xff54 => sub { SearchComplete($self); }, # Arrows quit leaving cursor at result
    };

    $self->{'search-key-map'} = {
        'C-g' => sub { SearchQuit($self); }, # Control-g quits, returning to start
        'C-r' => sub { RepeatSearchBck($self); }, # Next result backward
        'C-s' => sub { RepeatSearchFwd($self); }, # Next result forward
        'C-f' => sub { SearchComplete($self); }, # Movement completes search
        'C-b' => sub { SearchComplete($self); }, # Movement completes search
        'C-n' => sub { SearchComplete($self); }, # Movement completes search
        'C-p' => sub { SearchComplete($self); }, # Movement completes search
    };

    return (); # Return false, do not consume events
}


######################################################################
# enter the emacs keyboard selection mode
# save the current terminal state
# begin reading hotkeys and interacting with our event loop

sub enter {
    my ($self) = @_;

    # don't enable the mode twice
    return if $self->{'enabled'};

    # enable this mode, also is our modelist:
    #  1 = navigation mode
    #  2 = search backward
    #  3 = search forward
    $self->{'enabled'} = 1;

    # backup cursor location and scrollback location
    ( $self->{'savedR'}, $self->{'savedC'} ) = $self->screen_cur();
    $self->{'savedViewStart'} = $self->view_start();

    # clear selection, we intend to make one
    $self->selection_clear();

    # start overlay
    $self->{'emacsOverlay'} = $self->overlay(-1, -1, 20, 1);
    $self->{'emacsOverlay'}->set(0, 0, sprintf('%-20s', "Emacs Navigate"));

    # start our event loop
    $self->enable( key_press => \&key_press );

    # if we don't have a search term previously used, initialize our search term
    unless ($self->{'searchRE'}) {$self->{'searchRE'} = ""};

	return (); # Return false, do not consume events
}


######################################################################
# leave the emacs keyboard selection mode
# end our event loop
# restore the terminal state

sub leave {
    my ($self) = @_;

    # stop event loop
    $self->disable("key_press");

    # stop overlay
    delete $self->{'emacsOverlay'};

    # restore scroll location and cursor
    $self->screen_cur( $self->{'savedR'}, $self->{'savedC'} );
    $self->view_start( $self->{'savedViewStart'} );

    # disable our mode
    delete $self->{'enabled'};

    # refresh on exit
    $self->want_refresh();

	return (); # Return false, do not consume events
}


######################################################################
# key_press event loop
#
# Dump events:         print "@{[ %{$event} ]}\n";
#
# Example of event content when control-g pressed:
# col 106
# keycode 42
# root 256
# row 64
# send_event 0
# serial 580
# state 4 <<<<<< event state is modifier key state, so the and is a bitmask
# subwindow 0
# time 733736503
# type 2
# window 81788935
# x 636
# x_root 1279
# y 776
# y_root 799
#
# Example of event content when 'a' pressed:
# col 106
# keycode 38
# root 256
# row 64
# send_event 0
# serial 540
# state 0
# subwindow 0
# time 733782109
# type 2
# window 81788935
# x 636
# x_root 1279
# y 776
# y_root 799

sub key_press {
	my ($self, $event, $keysym, $char) = @_;
	my $key = chr($keysym);
    my ($curR, $curC) = $self->screen_cur();

    $self->{'currentEvent'} = $event;

    # Add control prefix if control key present or alt, ie: M-C-s
    my $formattedkey = ($event->{state} & urxvt::ControlMask) ? 'C-' . $key : $key;
    $formattedkey = ($event->{state} & urxvt::Mod1Mask) ? 'M-' . $formattedkey : $formattedkey;

    if ($self->{'enabled'} == 1) {
        # Enabled mode 1 is navigation by emacs bindings

        # printf( "Key: '%s', Keysym: '%#04x' State: '%d' \n", $key, $keysym, $event->{state} );
        # printf( "%d %d\n" , urxvt::ControlMask, urxvt::Mod1Mask);

        # Dispatch formatted key (ie: 'C-g'), or keysym value
        if ($self->{'navigation-key-map'}->{$formattedkey}) {
            $self->{'navigation-key-map'}->{$formattedkey}->();
        } elsif (($event->{state} & urxvt::Mod1Mask) && ($self->{'navigation-alt-keysym-map'}->{$keysym})) {
            $self->{'navigation-alt-keysym-map'}->{$keysym}->();
        } elsif ($self->{'navigation-keysym-map'}->{$keysym}) {
            $self->{'navigation-keysym-map'}->{$keysym}->();
        }
    } elsif ($self->{'enabled'} > 1) {
        # Searching backward or forward

        # Dispath keys with different table for alt
        if (($event->{state} & urxvt::Mod1Mask) && ($self->{'search-alt-keysym-map'}->{$keysym})) {
            $self->{'search-alt-keysym-map'}->{$keysym}->();
        } elsif ($self->{'search-keysym-map'}->{$keysym}) {
            $self->{'search-keysym-map'}->{$keysym}->();
        } elsif ($self->{'search-key-map'}->{$formattedkey}) {
            $self->{'search-key-map'}->{$formattedkey}->();
        } else {
            # While searching, capture all inputs
            if ($key =~ /[\x20-\x7e]/) { # only basic ascii
                $self->{'searchRE'} .= $key;
            }
            SearchRefresh($self);
        }
    }

    delete $self->{'currentEvent'};
    return 1; # Consume keypress event
}


######################################################################
# move_cursor and handle screen updates via delta coords
sub move_cursor_delta {
    my ($self, $deltaR, $deltaC) = @_;
    my ($curR, $curC) = $self->screen_cur();

    move_cursor( $self, $curR + $deltaR, $curC + $deltaC );
}


# move to absolute coords and refresh
sub move_cursor {
    my ($self, $newR, $newC) = @_;

    $self->screen_cur( clamp( $newR, $self->top_row(), $self->nrow() - 1 ),
                       clamp( $newC,                0, $self->ncol() ));

    # Scroll buffer to keep cursor visible
    # TODO: Add padding above/below cursor for context
    # $self->{'emacsOverlay'}->set(0, 0, sprintf("r%dc%dnc%dnr%dtr%d", $curR, $curC, $self->ncol(), $self->nrow(), $self->top_row()));

    my ($curR, $curC) = $self->screen_cur();
    if ($curR < $self->view_start()) {
        $self->view_start($curR);
    } elsif ($curR >= $self->view_start() + $self->nrow()) {
        $self->view_start($curR - $self->nrow() + 1);
    };

    $self->want_refresh();
}

######################################################################
# Utility functions

sub clamp {
    my ($x, $min, $max) = @_;

    if      ($x < $min) { return $min;
    } elsif ($x > $max) { return $max;
    } else              { return $x;   }
}


sub BOL {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();

    move_cursor($self, $curR, 0);
}


sub EOL {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();

    move_cursor($self, $curR, $self->ROW_l($curR) );
}


sub BOB {
    my ($self) = @_;

    move_cursor($self, $self->top_row(), 0);
}


sub EOB {
    my ($self) = @_;

    move_cursor($self, $self->nrow(), $self->ncol());
}


sub PgUp {
    my ($self) = @_;

    move_cursor_delta($self, int( $self->nrow() / -2), 0);
}


sub PgDn {
    my ($self) = @_;

    move_cursor_delta($self, int( $self->nrow() /  2), 0);
}


sub FwdWrd {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();
    my $line = $self->line($curR);

    # search forward w/ regexp for end of non-space (\S+) and use position to jump
    my $cursorLineOffset = $line->offset_of($curR, $curC);
    my $textPastCursor = substr($line->t(), $cursorLineOffset);
    $textPastCursor =~ m/\S+/g;
    my $endOfWordOffset = pos($textPastCursor);
    move_cursor_delta($self, 0, $endOfWordOffset);

    # printf("Line: '%s'\n Col:%d Cursor offset:%d\nText after cursor: '%s'\n ",
    #        $line->t(), $curC, $cursorLineOffset, $textPastCursor);
}

sub BckWrd {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();
    my $line = $self->line($curR);

    # search forward w/ regexp for end of non-space (\S+) and use position to jump, after reversing
    my $cursorLineOffset = $line->offset_of($curR, $curC);
    my $textBeforeCursor = reverse(substr($line->t(), 0, $cursorLineOffset));
    $textBeforeCursor =~ m/\S+/g;
    my $endOfWordOffset = pos($textBeforeCursor);
    move_cursor_delta($self, 0, -$endOfWordOffset);

    # printf("Line: '%s'\n Col:%d Cursor offset:%d\nText after cursor: '%s'\n ",
    #        $line->t(), $curC, $cursorLineOffset, $textBeforeCursor);
}


sub SetMark {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();

    $self->selection_beg( $curR, $curC );
    $self->{'emacsOverlay'}->set(0, 0, sprintf('%-20s', "Mark set"));
}


sub Kill {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();

    $self->selection_end( $curR, $curC );
    $self->selection_make($self->{'currentEvent'}->{time});
    # print($self->selection());
    leave($self);
}


sub KillToEOL {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();

    $self->selection_beg( $curR, $curC );
    $self->selection_end( $curR, $self->ROW_l($curR) );
    $self->selection_make($self->{'currentEvent'}->{time});
    # print($self->selection());
    leave($self);
}


sub KillFwdWrd {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();
    my $line = $self->line($curR);

    # search forward w/ regexp for end of non-space (\S+) and use position to jump
    my $cursorLineOffset = $line->offset_of($curR, $curC);
    my $textPastCursor = substr($line->t(), $cursorLineOffset);
    $textPastCursor =~ m/\S+/g;
    my $endOfWordOffset = pos($textPastCursor);

    $self->selection_beg( $curR, $curC );
    $self->selection_end( $curR, $curC + $endOfWordOffset );
    $self->selection_make($self->{'currentEvent'}->{time});
    # print($self->selection());
    leave($self);
}


sub KillBckWrd {
    my ($self) = @_;
    my ($curR, $curC) = $self->screen_cur();
    my $line = $self->line($curR);

    # search forward w/ regexp for end of non-space (\S+) and use position to jump, after reversing
    my $cursorLineOffset = $line->offset_of($curR, $curC);
    my $textBeforeCursor = reverse(substr($line->t(), 0, $cursorLineOffset));
    $textBeforeCursor =~ m/\S+/g;
    my $endOfWordOffset = pos($textBeforeCursor);
    move_cursor_delta($self, 0, -$endOfWordOffset);

    $self->selection_beg( $curR, $curC - $endOfWordOffset );
    $self->selection_end( $curR, $curC );
    $self->selection_make($self->{'currentEvent'}->{time});
    # print($self->selection());
    leave($self);
}


sub SearchBck {
    my ($self) = @_;

    $self->{'enabled'} = 2; # 2 = search backward
    $self->{'emacsOverlay'}->set(0, 0, sprintf('%-20s', "?"));

    # Save cursor to where search starts
    $self->{'searchSavedStart'} = $self->screen_cur();

    $self->enable( tt_write => \&search_tt_write );

    # current search position is current cursor row.
    my ($curR, $curC) = $self->screen_cur();
    $self->{'lastMatchingLine'} = $curR;
}


sub SearchFwd {
    my ($self) = @_;

    SearchBck($self); #cheating calling other function for hook setups, etc

    $self->{'enabled'} = 3; # 3 = search forward
    $self->{'emacsOverlay'}->set(0, 0, sprintf('%-20s', "/"));
}


sub SearchComplete {
    my ($self) = @_;

    $self->disable("tt_write");
    $self->{'enabled'} = 1; # 1 = navigation
    $self->{'emacsOverlay'}->set(0, 0, sprintf('%-20s', "Emacs Navigate"));
}


sub SearchQuit {
    my ($self) = @_;

    SearchComplete($self);

    # Restore cursor to where search started if we aborted
    $self->screen_cur( $self->{'searchSavedStart'} );
}


sub RepeatSearchBck {
    my ($self) = @_;

    $self->{'lastMatchingLine'}--;
    SearchRefresh($self);

    1; # Consume event
}


sub RepeatSearchFwd {
    my ($self) = @_;

    $self->{'lastMatchingLine'}++;
    SearchRefresh($self);

    1; # Consume event
}


sub SearchRefresh {
    my ($self) = @_;

    my $prefix = $self->{'enabled'} == 2 ? "?" : "/";
    $self->{'emacsOverlay'}->set(0, 0, sprintf('%-20s', $prefix . $self->{'searchRE'} ));

    no re 'eval'; # only allowing simple string searches anyway, maybe overkill?
    my $encodedSearch = $self->special_encode($self->{'searchRE'});
    my $localSearch = qr/$encodedSearch/;
    if ($self->{'enabled'} == 2 ) { # search backward

        # we use the search cursor, we only move the real cursor to a match
        my $curR = $self->{'lastMatchingLine'};

        do {
            my $line = $self->line($curR);
            my $text = $line->t();

            if ($text =~ $localSearch)
            {
                $self->{'lastMatchingLine'} = $curR;
                move_cursor($self, $self->{'lastMatchingLine'}, 0);
                last;
            } else {
                $curR--;
            }
        } until ($curR <= $self->top_row);
    } else { # search forward

        # we use the search cursor, we only move the real cursor to a match
        my $curR = $self->{'lastMatchingLine'};

        do {
            my $line = $self->line($curR);
            my $text = $line->t();

            if ($text =~ $localSearch)
            {
                $self->{'lastMatchingLine'} = $curR;
                move_cursor($self, $self->{'lastMatchingLine'}, 0);
                last;
            } else {
                $curR++;
            }
        } until ($curR >= $self->nrow);
    }

    1; # Consume event
}


sub SearchBackspace {
    my ($self) = @_;

    my $RElength = length($self->{'searchRE'});

    if ($RElength > 0) {
        $self->{'searchRE'} = substr($self->{'searchRE'}, 0, $RElength - 1);
    }

    SearchRefresh($self);
}


# This is a discarding replacement during the search mode
# otherwise it spams the terminal with our search terms as we type
sub search_tt_write {
    my ($self, $discard) = @_;

    1;
}
