#! perl -w
# Author:   Bert Muennich
# Website:  http://www.github.com/muennich/urxvt-perls
# Version:  git-20100819
# License:  GPLv2

# Use keyboard shortcuts to select and copy text.

# Usage: put the following lines in your .Xdefaults:
#   URxvt.perl-ext-common: ...,keyboard-select
#   URxvt.keysym.M-Escape: perl:keyboard-select:activate

# Use Meta-Escape to activate selection mode, then use the following keys:
#   h/j/k/l:    Move cursor left/down/up/right (also with arrow keys)
#   g/G/0/^/$/H/M/L: More vi-like cursor movement keys
#   Ctrl-f/b:   Scroll down/up one screen
#   Ctrl-d/u:   Scroll down/up half a screen
#   v/V/Ctrl-v: Toggle normal/linewise/blockwise selection
#   y/Return:   Copy selection to primary buffer, Return: deactivate afterwards
#   q/Escape:   Deactivate keyboard selection mode


use strict;

sub on_user_command {
	my ($self, $cmd) = @_;

	if ($cmd eq 'keyboard-select:activate') {
		if (not $self->{active}) {
			activate($self);
		}
	}

	()
}


sub key_press {
	my ($self, $event, $keysym) = @_;
	my $char = chr($keysym);

	if ($keysym == 0xff1b || lc($char) eq 'q') {
		deactivate($self);
	} elsif ($char eq 'y' || $keysym == 0xff0d) {
		if ($self->{select}) {
			if ($self->{select} eq 'b') {
				$self->selection($self->{selection});
				$self->selection_grab($event->{time});
			} else {
				my ($br, $bc, $er, $ec) = calc_span($self);
				$ec = $self->line($er)->l if $self->{select} eq 'l';
				$self->selection_beg($br, $bc);
				$self->selection_end($er, $ec);
				$self->selection_make($event->{time});
			}
			if ($char eq 'y') {
				if ($self->{select} ne 'b') {
					$self->selection_beg(1, 0);
					$self->selection_end(1, 0);
				}
				$self->{select} = '';
				$self->want_refresh();
			} else {
				deactivate($self);
			}
		}
	} elsif ($char eq 'V') {
		toggle_select($self, 'l');
	} elsif ($char eq 'v') {
		if ($event->{state} & urxvt::ControlMask) {
			toggle_select($self, 'b');
		} else {
			toggle_select($self, 'n');
		}
	} elsif ($char eq 'k' || $keysym == 0xff52) {
		move_cursor($self, 'k');
	} elsif ($char eq 'j' || $keysym == 0xff54) {
		move_cursor($self, 'j');
	} elsif ($char eq 'h' || $keysym == 0xff51) {
		move_cursor($self, 'h');
	} elsif ($char eq 'l' || $keysym == 0xff53) {
		move_cursor($self, 'l');
	} elsif ('gG0^$HML' =~ m/\Q$char\E/ ||
			('fbdu' =~ m/\Q$char\E/ && $event->{state} & urxvt::ControlMask)) {
		move_cursor($self, $char);
	}

	return 1;
}


sub move_cursor {
	my ($self, $key) = @_;
	my ($cr, $cc) = $self->screen_cur();
	my $line = $self->line($cr);

	if ($key eq 'k' && $line->beg > $self->top_row) {
		$cr = $line->beg - 1;
	} elsif ($key eq 'j' && $line->end < $self->nrow - 1) {
		$cr = $line->end + 1;
	} elsif ($key eq 'h' && $self->{offset} > 0) {
		$self->{offset} = $line->l - 1 if $self->{offset} >= $line->l;
		--$self->{offset};
		$self->{dollar} = 0;
	} elsif ($key eq 'l' && $self->{offset} < $line->l - 1) {
		++$self->{offset};
	} elsif ($key eq 'f' || $key eq 'd') {
		my $vs = $self->view_start() +
				($key eq 'd' ? $self->nrow / 2 : $self->nrow - 1);
		$vs = 0 if $vs > 0;
		$cr += $vs - $self->view_start($vs);
	} elsif ($key eq 'b' || $key eq 'u') {
		my $vs = $self->view_start() -
				($key eq 'u' ? $self->nrow / 2 : $self->nrow - 1);
		$vs = $self->top_row if $vs < $self->top_row;
		$cr += $vs - $self->view_start($vs);
	} elsif ($key eq 'g') {
		($cr, $self->{offset}) = ($self->top_row, 0);
		$self->{dollar} = 0;
	} elsif ($key eq 'G') {
		($cr, $self->{offset}) = ($self->nrow - 1, 0);
		$self->{dollar} = 0;
	} elsif ($key eq '0') {
		$self->{offset} = 0;
		$self->{dollar} = 0;
	} elsif ($key eq '^') {
		my $ltxt = $self->special_decode($line->t);
		while ($ltxt =~ s/^( *)\t/$1 . " " x (8 - length($1) % 8)/e) {}
		$self->{offset} = $ltxt =~ m/^ +/ ? $+[0] : 0;
		$self->{dollar} = 0;
	} elsif ($key eq '$') {
		$self->{offset} = $line->l - 1;
		$self->{dollar} = 1;
	} elsif ($key eq 'H') {
		$cr = $self->view_start();
	} elsif ($key eq 'M') {
		$cr = $self->view_start() + $self->nrow / 2;
	} elsif ($key eq 'L') {
		$cr = $self->view_start() + $self->nrow - 1;
	}

	$line = $self->line($cr);
	$self->{offset} = $line->l - 1 if $self->{dollar};
	($cr, $cc) = $line->coord_of($self->{offset} < $line->l ? $self->{offset} :
			$line->l - 1);
	$self->screen_cur($cr, $cc);

	# scroll the current cursor position into visible area
	if ($cr < $self->view_start()) {
		$self->view_start($cr);
	} elsif ($cr >= $self->view_start() + $self->nrow) {
		$self->view_start($cr - $self->nrow + 1);
	}

	status_area($self);
	$self->want_refresh();
	
	()
}


sub tt_write {
	return 1;
}


sub refresh {
	my ($self) = @_;
	my $reverse_cursor = $self->{select} ne 'l';
	my ($cr, $cc) = $self->screen_cur();

	if ($self->{select}) {
		my ($br, $bc, $er, $ec) = calc_span($self);

		if ($self->{select} eq 'b') {
			delete $self->{selection} if $self->{selection};
			my $r = $br;
			while ($r <= $er) {
				my $line = $self->line($r);
				if ($bc < $line->l) {
					$ec = $line->l if $self->{dollar};
					$self->{selection} .= substr($line->t, $bc, $ec - $bc);
					my ($br, $bc) = $line->coord_of($bc);
					my ($er, $ec) = $line->coord_of($ec <= $line->l ? $ec : $line->l);
					$self->scr_xor_span($br, $bc, $er, $ec, urxvt::RS_RVid);
				} elsif ($r == $cr) {
					$reverse_cursor = 0;
				}
				$self->{selection} .= "\n" if $line->end < $er;
				$r = $line->end + 1;
			}
		} else {
			$self->scr_xor_span($br, $bc, $er, $ec, urxvt::RS_RVid);
		}

		if ($reverse_cursor) {
			# make the cursor visible again
			$self->scr_xor_span($cr, $cc, $cr, $cc + 1, urxvt::RS_RVid);
		}
	}

	()
}


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

	$self->{active} = 1;

	$self->{select} = "";
	$self->{dollar} = 0;

	($self->{oldcr}, $self->{oldcc}) = $self->screen_cur();
	$self->{old_view_start} = $self->view_start();
	$self->{old_pty_ev_events} = $self->pty_ev_events(urxvt::EV_NONE);

	my $line = $self->line($self->{oldcr});
	$self->{offset} = $line->offset_of($self->{oldcr}, $self->{oldcc});

	$self->selection_beg(1, 0);
	$self->selection_end(1, 0);

	$self->enable(
		key_press     => \&key_press,
		refresh_begin => \&refresh,
		refresh_end   => \&refresh,
		tt_write      => \&tt_write,
	);

	$self->{overlay_len} = 0;
	status_area($self);

	()
}


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

	$self->selection_beg(1, 0);
	$self->selection_end(1, 0);

	delete $self->{overlay} if $self->{overlay};
	delete $self->{selection} if $self->{selection};

	$self->disable("key_press", "refresh_begin", "refresh_end", "tt_write");
	$self->screen_cur($self->{oldcr}, $self->{oldcc});
	$self->view_start($self->{old_view_start});
	$self->pty_ev_events($self->{old_pty_ev_events});

	$self->want_refresh();

	$self->{active} = 0;

	()
}


sub status_area {
	my ($self) = @_;
	my ($stat, $stat_len);

	if ($self->{select}) {
		$stat = "V";
		if ($self->{select} ne 'n') {
			$stat .= uc($self->{select});
		}
		$stat .= " -- ";
	}
		
	if ($self->top_row == 0) {
		$stat .= "All";
	} elsif ($self->view_start() == $self->top_row) {
		$stat .= "Top";
	} elsif ($self->view_start() == 0) {
		$stat .= "Bot";
	} else {
		$stat .= sprintf("%2d%%",
				($self->top_row - $self->view_start) * 100 / $self->top_row);
	}
	
	$stat_len = length($stat);

	if (!$self->{overlay} || $self->{overlay_len} != $stat_len) {
		delete $self->{overlay} if $self->{overlay};
		$self->{overlay} = $self->overlay(-1, -1, $stat_len, 1,
				urxvt::OVERLAY_RSTYLE, 0);
		$self->{overlay_len} = $stat_len;
	}

	$self->{overlay}->set(0, 0, $self->special_encode($stat));
	$self->{overlay}->show();

	()
}


sub toggle_select {
	my ($self, $mode) = @_;

	if ($self->{select} eq $mode) {
		$self->{select} = '';
	} else {
		if (not $self->{select}) {
			($self->{ar}, $self->{ac}) = $self->screen_cur();
		}
		$self->{select} = $mode;
	}

	status_area($self);
	$self->want_refresh();

	()
}


sub calc_span {
	my ($self) = @_;
	my ($cr, $cc) = $self->screen_cur();
	my ($br, $bc, $er, $ec);
	
	if ($self->{select} eq 'b') {
		$br = $self->line($cr)->beg;
		$bc = $self->line($cr)->offset_of($cr, $cc);
		$er = $self->line($self->{ar})->beg;
		$ec = $self->line($self->{ar})->offset_of($self->{ar}, $self->{ac});
		($br, $er) = ($er, $br) if $br > $er;
		($bc, $ec) = ($ec, $bc) if $bc > $ec;
	} else {
		if ($cr < $self->{ar}) {
			($br, $bc, $er, $ec) = ($cr, $cc, $self->{ar}, $self->{ac});
		} elsif ($cr > $self->{ar}) {
			($br, $bc, $er, $ec) = ($self->{ar}, $self->{ac}, $cr, $cc);
		} else {
			($br, $er) = ($cr, $cr);
			($bc, $ec) = $cc < $self->{ac} ? ($cc, $self->{ac}) : ($self->{ac}, $cc);
		}
	}

	if ($self->{select} eq 'l') {
		($br, $er) = ($self->line($br)->beg, $self->line($er)->end);
		($bc, $ec) = (0, $self->ncol);
	} else {
		++$ec;
	}

	return ($br, $bc, $er, $ec);
}