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
|
#!/usr/bin/env perl
#
# rl-callbacktest3: rl-callbacktest + sigint_handler() + rl_getc_function
#
# Copyright (C) 2024 Hiroo Hayashi
#
# Derived from: examples/rl-callbacktest3.c in the GNU Readline Library
use strict;
use warnings;
use Term::ReadLine;
my $t = new Term::ReadLine 'rl-callbacktest';
my $a = $t->Attribs;
my $sigwinch_received = 0;
my $sigint_received = 0;
my $running = 0;
my $prompt = 'rltest$ ';
# Handle window size changes when readline is not active and reading
# characters.
sub sigwinch_handler {
my $sig = shift;
$sigwinch_received = 1;
}
# Handle SIGINT when readline is not active and reading a character.
sub sigint_handler {
my $sig = shift;
$sigint_received = 1;
}
# Callback function called for each line when accept-line executed, EOF
# seen, or EOF character read. This sets a flag and returns; it could
# also call exit(3).
sub cb_linehandler {
my $line = shift;
# Can use ^D (stty eof) or `exit' to exit.
if (!$line || $line eq "exit") {
print "\n" unless $line;
print "exit\n";
# This function needs to be called to reset the terminal settings,
# and calling it from the line handler keeps one extra prompt from
# being displayed.
$t->callback_handler_remove();
$running = 0;
} else {
$t->add_history($line) if $line;
print "input line: $line\n";
}
}
# replace with something more complex if desired
sub my_getc {
# my $stream = shift;
# my $ch = $t->getc($stream);
my $ch = $t->getc($a->{instream});
return $ch;
}
# Handle SIGWINCH
$SIG{WINCH} = \&sigwinch_handler;
# Handle SIGINT
$SIG{INT} = \&sigint_handler;
# Install the getc function.
$a->{getc_function} = \&my_getc;
# Install the line handler.
$t->callback_handler_install($prompt, \&cb_linehandler);
# Enter a simple event loop. This waits until something is available
# to read on readline's input stream (defaults to standard input) and
# calls the builtin character read callback to read it. It does not
# have to modify the user's terminal settings.
$running = 1;
while ($running) {
my $fds = '';
vec($fds, fileno($a->{instream}), 1) = 1;
my $r = select($fds, undef, undef, undef);
if ($r < 0 && $! && !$!{EINTR}) { # EINTR is not an error
warn "$0: select: $!\n";
$t->callback_handler_remove();
last;
}
if ($sigwinch_received) {
warn "$0: SIGWINCH received\n";
$t->resize_terminal();
$sigwinch_received = 0;
}
if ($sigint_received) {
print "Quit\n";
$t->callback_handler_remove();
$t->callback_handler_install($prompt, \&cb_linehandler);
$sigint_received = 0;
next;
}
next if $r < 0; # select returns EINTR (interrupted system call)
if (vec($fds, fileno($a->{instream}), 1)) {
$t->callback_read_char();
}
}
print "$0: Event loop has exited\n";
exit 0;
|
