handle_hotkeys

#!/usr/bin/env perl

use lib ($ENV{RLWRAP_FILTERDIR} or ".");
use RlwrapFilter;
use strict;
use POSIX qw(:signal_h);



# change the table below if you like, but don't forget to bind the corresponding keys  to 'rlwrap-hotkey' in your .inputrc

my $keymap =
{ '\C-y'       => \&yank_clipboard,
  '\C-n'       => \&edit_history, 
  '\C-i'       => \&peco_history, 
  '\C-r'       => \&peco_history, 
  '\C-t'       => \&date_in_echo_area,
  '\M-\C-m'    => \&date_in_echo_area # test a multi-byte hotkey (ESC-ENTER)
};  

my @tempfiles; # list of files to be cleaned on exit;

############################################ The Filter #################################################

my $filter = new RlwrapFilter;

# populate a hash %$handlers, with the actual hotkeys (not their readline key notation like '\M\C-m') as keys:
my $handlers;
foreach my $keyseq (keys %$keymap) {
    $handlers -> {translate_from_readline_keynotation($keyseq)} = $keymap -> {$keyseq};
}

my $name = $filter -> name;

$filter -> help_text("Usage: rlwrap -z $name <command>\n".
		     "handle hotkeys (but only if bound to 'rlwrap-hotkey' in your .inputrc):\n" .
                     document_all_hotkeys());


$filter -> hotkey_handler(\&hotkey);

$filter -> run;


# A hotkey handler is called with five parameters:
#   1: the key sequence that triggered rlwrap-handle-hotkey
#   2: the prefix, i.e. the input line up to (but not including) the cursor
#   3: the postfix: the rest of the input line (without a concluding newline, of course)
#   4: the whole history (all lines, oldest first, interspersed with newlines: "line 1\nline2\n ...line N")
#   5: the history position (as a line number) at the moment of the hotkey press (oldest line = 0)
#
# If the hotkey was bound to "rlwrap-hotkey-without-history" the last two parameters will be empty and can be ignored
# The return value is a similar list (where all values may be changed: the input line could be re-written, the history
# revised, etc. The first parameter makes no sense as a return value: if it is empty, or changed from its original
# value, its contents will pe put in the "echo area". If the key sequence was bound to rlwrap-hotkey-without-history the
# history is not passed to the handler, and the last two elements of the returned list are ignored.
#
# If the postfix is returned with a concluding newline, the resulting input line is accepted immediately, otherwise
# it is put in readline's input buffer again, with the cursor at the beginning of the returned postfix 
#
# Summary: ($echo, $prefix, $postfix, $history, $histpos) = handler($key, $prefix, $postfix, $history, $histpos)


# generic hotkey handler, that dispatches on the value of $key (using the hash %$keymap defined at the top of this file
sub hotkey {
    my ($keyseq, @other_params) = @_;                                  # key = e.g.  "<CTRL-Y>" 
    my $handler = $handlers -> {$keyseq};
    return ($keyseq, @other_params) unless $handler; # a filter further downstream may want to handle this hotkey 
    my @result = &$handler(0, @other_params);
    return @result;
}


############################# A few handlers ###############################################
#
# After dispatch (on the value of $key) by the hotkey() function the value of $key is not relevant anymore.
# its place is now taken by a parameter $doc :
#
# ($echo, $prefix, $postfix, $history, $histpos) = myfunc(0,  $prefix, $postfix, $history, $histpos)
# "docstring"                                    = myfunc(1, @not_interesting)



sub yank_clipboard {
  my ($doc, $prefix, $postfix, @boring) = @_;
  $doc and return "insert from clipboard";
  my $selection = safe_backtick(qw(xsel -o));
  return ("", $prefix . $selection, $postfix, @boring);
}


sub date_in_echo_area {
  my ($doc, @boring) = @_;
  $doc and return "show current time in echo area";
  my $date = safe_backtick(qw(date +%H:%M));
  return ("($date) ", @boring);
}


my $instance = 0;
sub edit_history {
  my ($doc, $prefix, $postfix, $history, $histpos) = @_;
  $doc and return "edit and/or choose from  current history";
  $histpos =~ /\d/ or die "$histpos is not a number - did you bind this key to 'rlwrap-hotkey-without-history'?";
  $instance++;
  my $editfile = ($ENV{TMP} || $ENV{TEMP} || "/tmp") . "/history.$$.$instance.txt";
  push @tempfiles, $editfile;
  my $lineno = $histpos + 1;
  my $colno = length($prefix) + 1;
  $history ||= " "; # write_file() crashes  if called on an empty string....
  write_file($editfile , $history);
  my $editor = $ENV{RLWRAP_EDITOR} || "vi +%L";
  $editor =~ s/%L/$lineno/;
  $editor =~ s/%C/$colno/;
  system("$editor $editfile");
  my @lines = read_file($editfile);
  unlink $editfile;
  my (@new_history, $counter, $empty_counter, $last_counter, $last_empty_counter);
  foreach my $line (@lines) {
    $line =~ s/\t//g;
    $line =~ s/^\s+//;
    $line =~ s/\s+$//;
    if ($line) {
      if ($empty_counter > 0) {
        # remember position of last line after an empty line,
        # and the number of empty lines:
        ($last_counter, $last_empty_counter) = ($counter, $empty_counter); 
      }
      $empty_counter = 0;
      $counter++; # We count 0-based, so increment only now
      push @new_history, $line;
    } else {
      $empty_counter++;
    }
  }
  if ($last_empty_counter) {
    $histpos = $last_counter;
    $prefix = $new_history[$histpos];
    $prefix .= $last_empty_counter > 1 ? "\n" : "";
    $postfix = "";
  }
  return ("", $prefix, $postfix, (join "\n", @new_history), $histpos);
 }   

sub peco_history {
    my ($doc, $prefix, $postfix, $history, $histpos) = @_;
    $doc and return "use peco to choose from history entries that match current input before cursor";  
    my $editfile = ($ENV{TMP} || $ENV{TEMP} || "/tmp") . "/history.$$.txt";
    my $lineno = $histpos + 1;
    my $colno = length($prefix) + 1;
    $history ||= " "; #writefile crashes  if called on an empty string....
    write_file($editfile , $history);
    my $peco = "peco";
    my $select_1 = `$peco --select-1 --query "$prefix" $editfile`;
    chomp $select_1;
    return ("", $select_1, $postfix, $history, $histpos);
}

############################## helper functions #########################################################

sub document_all_hotkeys {

    my $doclist;
    foreach my $keyseq  (sort keys %$keymap) {
        $doclist .= "$keyseq:   " . &{$keymap -> {$keyseq}}(1) . "\n";
    }
    my $inputrc = "$ENV{HOME}/.inputrc";
    $doclist .= "Currently bound hotkeys in $inputrc:\n";
    $doclist .= safe_backtick("grep", "rlwrap-hotkey", $inputrc);
    return $doclist;
}


sub safe_backtick {
    my @command_line = @_;
    my $command_line = join ' ', @command_line;
    open my $pipefh, '-|' or exec @command_line or die "$command_line failed: $!\n";
    my $result;
    { local $/;               # slurp all output in one go
      $result = <$pipefh>; 
      close $pipefh;
    }
    chomp $result;            # chop off last newline
    return $result
}



# Translate from Readline "\C-x" notation to corresponding key. E.g. translate_from_readline_keynotation("\C-m") = '\0x13'
sub translate_from_readline_keynotation {
    my ($keyseq) = @_;
    $keyseq =~ s/\\C-(.)/translate_control($1)/ge;
    $keyseq =~ s/\\M-/\e/g; # @@@ this allows nonsense like "\C-\M-"
    return $keyseq;
}

# translate_control("m") == translate_control("M") ==  '\0x13' etc. 
sub translate_control { 
    my ($ctrlkey) = @_;
    $ctrlkey =  uc $ctrlkey; # Don't discriminate between \C-M and \C-m
    return pack("c", unpack("c", $ctrlkey) - 64);
}


# Use home-grown {read,write}_file rather than depending on File::Slurp
sub read_file {
    my($file) = @_;
    open IN, "$file" or die "Cannot read $file: $!\n";
    my @result;
    while(<IN>) {
        push @result, $_;
    }
    close IN;
    return @result;
}

sub write_file {
    my ($file, $content) = @_;
    open OUT, ">$file" or die "Cannot write $file:$!\n";
    print OUT $content;
    close OUT;
}


sub END {
    foreach my $f (@tempfiles) {
        -f $f and unlink $f;
    }
}