#!/usr/bin/perl
#
# excallback: Another test harness for the readline callback interface.
#
#   Copyright (C) 2024 Hiroo Hayashi
#
# Derived from: examples/excallback.c in the GNU Readline Library
#   Author: Jeff Solomon <jsolomon@stanford.edu>

# This little examples demonstrates the alternate interface to using readline.
# In the alternate interface, the user maintains control over program flow and
# only calls readline when STDIN is readable. Using the alternate interface,
# you can do anything else while still using readline (like talking to a
# network or another program) without blocking.
#
# Specifically, this program highlights two importants features of the
# alternate interface. The first is the ability to interactively change the
# prompt, which can't be done using the regular interface since rl_prompt is
# read-only.
#
# The second feature really highlights a subtle point when using the alternate
# interface. That is, readline will not alter the terminal when inside your
# callback handler. So let's so, your callback executes a user command that
# takes a non-trivial amount of time to complete (seconds). While your
# executing the command, the user continues to type keystrokes and expects them
# to be re-echoed on the new prompt when it returns. Unfortunately, the default
# terminal configuration doesn't do this. After the prompt returns, the user
# must hit one additional keystroke and then will see all of his previous
# keystrokes. To illustrate this, compile and run this program. Type "sleep" at
# the prompt and then type "bar" before the prompt returns (you have 3
# seconds). Notice how "bar" is re-echoed on the prompt after the prompt
# returns? This is what you expect to happen. Now comment out the 4 lines below
# the line that says COMMENT LINE BELOW. Recompile and rerun the program and do
# the same thing. When the prompt returns, you should not see "bar". Now type
# "f", see how "barf" magically appears? This behavior is un-expected and not
# desired.

use strict;
use warnings;
use Term::ReadLine;
use IO::Pty;
use POSIX qw(termios_h _POSIX_VDISABLE);

my $t = new Term::ReadLine 'rlptytest';
my $a = $t->Attribs;

my $prompt = 1;
my $old_lflag;
my $old_vtime;
my $term;

# main program

sub main {
    # Adjust the terminal slightly before the handler is installed. Disable
    # canonical mode processing and set the input character time flag to be
    # non-blocking.
    $term = POSIX::Termios->new;
    if (!defined($term->getattr(fileno(STDIN)))) {
        die "tcgetattr: $!\n";
    }
    $old_lflag = $term->getlflag();
    $old_vtime = $term->getcc(VTIME);
    $term->setlflag($old_lflag & ~ICANON);
    $term->setcc(1, VTIME);

    # COMMENT LINE BELOW - see above
    if (!defined($term->setattr(fileno(STDIN), TCSANOW))) {
        die "tcsetattr: $!\n";
    }

    $t->add_defun("change-prompt", \&change_prompt, ord "\cT");
    $t->callback_handler_install(get_prompt(), \&process_line);
    while (1) {
        my $fds = '';
        vec($fds, fileno(STDIN), 1) = 1;
        if (select($fds, undef, undef, undef) < 0) {
            die "select: $!\n";
        }
        $t->callback_read_char() if (vec($fds, fileno(STDIN), 1));
    }
    exit 0;
}

sub process_line {
    my ($line) = @_;
    if (!$line) {
        printf STDERR "\n";

        # reset the old terminal setting before exiting
        $term->setlflag($old_lflag);
        $term->setcc($old_vtime, VTIME);
        if (!defined($term->setattr(fileno(STDIN), TCSANOW))) {
            die "tcsetattr: $!\n";
        }
        exit(0);
    }
    if ($line eq "sleep") {
        sleep(3);
    } else {
        print STDERR "|$line|\n";
    }
}
sub change_prompt {
    # toggle the prompt variable
    $prompt = !$prompt;
    $t->set_prompt(get_prompt());
}

# The original implementation of change_prompt before rl_set_prompt was introduced.
sub change_prompt_original {
    # toggle the prompt variable
    $prompt = !$prompt;

    # save away the current contents of the line
    my $line_buf = $a->{line_buffer};

    # install a new handler which will change the prompt and erase the current line
    $t->callback_handler_install(get_prompt(), \&process_line);

    # insert the old text on the new line
    $t->insert_text($line_buf);

    # redraw the current line - this is an undocumented function. It invokes the
    # redraw-current-line command.
    # $t->refresh_line(0, 0);
    # $t->forced_update_display();
    # $t->reset_line_state();
    $t->redisplay();
}

sub get_prompt {
    # The prompts can even be different lengths!
    return $prompt ? "Hit ctrl-t to toggle prompt> " : "Pretty cool huh?> ";
}

main();
