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
|
#!/usr/bin/env perl
#
# rl-callbacktest2: Provides readline()-like interface using the alternate interface
#
# Copyright (C) 2024 Hiroo Hayashi
#
# Derived from: examples/rl-callbacktest2.c in the GNU Readline Library
use strict;
use warnings;
use Term::ReadLine;
BEGIN {
import Term::ReadLine::Gnu qw(RL_STATE_ISEARCH RL_STATE_NSEARCH);
}
my $t = new Term::ReadLine 'rl-callbacktest2';
my $a = $t->Attribs;
my $saw_signal = 0;
my $running = 0;
my $prompt = 'rltest$ ';
my $input_string;
# 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;
$t->add_history($line) if $line;
print "input line: ", ($line or ""), "\n";
$input_string = $line;
$t->callback_handler_remove();
}
sub cb_readline {
my $not_done = "";
# Install the line handler.
$t->callback_handler_install($prompt, \&cb_linehandler);
# printf STDERR ("readline_state = 0x%lx\n", $a->{readline_state});
if ($t->ISSTATE(RL_STATE_ISEARCH)) {
printf STDERR (
"cb_readline: after handler install, state (ISEARCH) = %lx\n",
$a->{readline_state}
);
} elsif ($t->ISSTATE(RL_STATE_NSEARCH)) {
printf STDERR (
"cb_readline: after handler install, state (NSEARCH) = %lx\n",
$a->{readline_state}
);
}
# MULTIKEY VIMOTION NUMERICARG _rl_callback_func
my $fds = '';
vec($fds, fileno($a->{instream}), 1) = 1;
$input_string = $not_done;
while (defined($input_string) and $input_string eq $not_done) {
my $r = 0;
my $err = 0;
# 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.
while ($r == 0) {
vec($fds, fileno($a->{instream}), 1) = 1;
$r = select($fds, undef, undef, 0.1);
$err = $!;
}
if ($saw_signal) {
sigint_handler($saw_signal);
}
if ($r < 0) {
warn "rltest: select: $!\n";
$t->callback_handler_remove();
last;
}
if ($r > 0) {
$t->callback_read_char();
}
}
return $input_string;
}
sub sigint_sighandler {
$saw_signal = shift;
}
sub sigint_handler {
my $s = shift;
$t->free_line_state();
$t->callback_sigcleanup();
$t->cleanup_after_signal();
$t->callback_handler_remove();
$saw_signal = 0;
return $s;
}
$running = 1;
$a->{catch_signals} = 1;
$t->bind_key(ord 'r', 'history-search-backward', 'emacs-meta');
$t->bind_key(ord 's', 'history-search-forward', 'emacs-meta');
$SIG{INT} = \&sigint_sighandler;
while ($running) {
my $p = cb_readline();
last if (!$p or $p eq 'exit');
}
print "$0: Event loop has exited\n";
exit 0;
|
