1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
#!/usr/bin/env 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();
|
