This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: ANNOUNCE: perl5.004_60 Configure patch is available
[perl5.git] / lib / Term / ReadLine.pm
CommitLineData
cb31d310 1=head1 NAME
2
c07a80fd 3Term::ReadLine - Perl interface to various C<readline> packages. If
cb31d310 4no real package is found, substitutes stubs instead of basic functions.
5
6=head1 SYNOPSIS
7
8 use Term::ReadLine;
9 $term = new Term::ReadLine 'Simple Perl calc';
10 $prompt = "Enter your arithmetic expression: ";
11 $OUT = $term->OUT || STDOUT;
12 while ( defined ($_ = $term->readline($prompt)) ) {
13 $res = eval($_), "\n";
14 warn $@ if $@;
15 print $OUT $res, "\n" unless $@;
16 $term->addhistory($_) if /\S/;
17 }
18
c07a80fd 19=head1 DESCRIPTION
20
21This package is just a front end to some other packages. At the moment
22this description is written, the only such package is Term-ReadLine,
23available on CPAN near you. The real target of this stub package is to
24set up a common interface to whatever Readline emerges with time.
25
cb31d310 26=head1 Minimal set of supported functions
27
28All the supported functions should be called as methods, i.e., either as
29
30 $term = new Term::ReadLine 'name';
31
32or as
33
34 $term->addhistory('row');
35
1fef88e7 36where $term is a return value of Term::ReadLine-E<gt>Init.
cb31d310 37
38=over 12
39
40=item C<ReadLine>
41
42returns the actual package that executes the commands. Among possible
43values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
44C<Term::ReadLine::Stub Exporter>.
45
46=item C<new>
47
48returns the handle for subsequent calls to following
49functions. Argument is the name of the application. Optionally can be
50followed by two arguments for C<IN> and C<OUT> filehandles. These
51arguments should be globs.
52
53=item C<readline>
54
55gets an input line, I<possibly> with actual C<readline>
56support. Trailing newline is removed. Returns C<undef> on C<EOF>.
57
58=item C<addhistory>
59
60adds the line to the history of input, from where it can be used if
61the actual C<readline> is present.
62
63=item C<IN>, $C<OUT>
64
65return the filehandles for input and output or C<undef> if C<readline>
66input and output cannot be used for Perl.
67
68=item C<MinLine>
69
70If argument is specified, it is an advice on minimal size of line to
71be included into history. C<undef> means do not include anything into
72history. Returns the old value.
73
74=item C<findConsole>
75
76returns an array with two strings that give most appropriate names for
1fef88e7 77files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">.
cb31d310 78
a737e074
CS
79=item Attribs
80
81returns a reference to a hash which describes internal configuration
82of the package. Names of keys in this hash conform to standard
83conventions with the leading C<rl_> stripped.
84
cb31d310 85=item C<Features>
86
87Returns a reference to a hash with keys being features present in
88current implementation. Several optional features are used in the
89minimal interface: C<appname> should be present if the first argument
90to C<new> is recognized, and C<minline> should be present if
91C<MinLine> method is not dummy. C<autohistory> should be present if
92lines are put into history automatically (maybe subject to
93C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy.
94
a737e074
CS
95If C<Features> method reports a feature C<attribs> as present, the
96method C<Attribs> is not dummy.
97
cb31d310 98=back
99
a737e074
CS
100=head1 Additional supported functions
101
cb31d310 102Actually C<Term::ReadLine> can use some other package, that will
103support reacher set of commands.
104
a737e074
CS
105All these commands are callable via method interface and have names
106which conform to standard conventions with the leading C<rl_> stripped.
107
f36776d9
IZ
108The stub package included with the perl distribution allows some
109additional methods:
110
111=over 12
112
113=item C<tkRunning>
114
7a2e2cd6 115makes Tk event loop run when waiting for user input (i.e., during
f36776d9
IZ
116C<readline> method).
117
118=item C<ornaments>
119
120makes the command line stand out by using termcap data. The argument
121to C<ornaments> should be 0, 1, or a string of a form
122C<"aa,bb,cc,dd">. Four components of this string should be names of
123I<terminal capacities>, first two will be issued to make the prompt
124standout, last two to make the input line standout.
125
126=item C<newTTY>
127
128takes two arguments which are input filehandle and output filehandle.
129Switches to use these filehandles.
130
131=back
132
133One can check whether the currently loaded ReadLine package supports
134these methods by checking for corresponding C<Features>.
7a2e2cd6 135
cb31d310 136=head1 EXPORTS
137
138None
139
a737e074
CS
140=head1 ENVIRONMENT
141
142The variable C<PERL_RL> governs which ReadLine clone is loaded. If the
143value is false, a dummy interface is used. If the value is true, it
144should be tail of the name of the package to use, such as C<Perl> or
145C<Gnu>.
146
147If the variable is not set, the best available package is loaded.
148
cb31d310 149=cut
150
151package Term::ReadLine::Stub;
7a2e2cd6 152@ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
cb31d310 153
154$DB::emacs = $DB::emacs; # To peacify -w
7a2e2cd6 155*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
cb31d310 156
157sub ReadLine {'Term::ReadLine::Stub'}
158sub readline {
a737e074
CS
159 my $self = shift;
160 my ($in,$out,$str) = @$self;
7a2e2cd6 161 print $out $rl_term_set[0], shift, $rl_term_set[1], $rl_term_set[2];
a737e074
CS
162 $self->register_Tk
163 if not $Term::ReadLine::registered and $Term::ReadLine::toloop
164 and defined &Tk::DoOneEvent;
165 #$str = scalar <$in>;
166 $str = $self->get_line;
7a2e2cd6 167 print $out $rl_term_set[3];
cb31d310 168 # bug in 5.000: chomping empty string creats length -1:
169 chomp $str if defined $str;
170 $str;
171}
172sub addhistory {}
173
174sub findConsole {
175 my $console;
176
177 if (-e "/dev/tty") {
178 $console = "/dev/tty";
8878e869 179 } elsif (-e "con" or $^O eq 'MSWin32') {
cb31d310 180 $console = "con";
181 } else {
182 $console = "sys\$command";
183 }
184
287f63d2
CS
185 if ($^O eq 'amigaos') {
186 $console = undef;
187 }
188 elsif ($^O eq 'os2') {
cb31d310 189 if ($DB::emacs) {
190 $console = undef;
191 } else {
192 $console = "/dev/con";
193 }
194 }
195
196 $consoleOUT = $console;
197 $console = "&STDIN" unless defined $console;
198 if (!defined $consoleOUT) {
199 $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
200 }
201 ($console,$consoleOUT);
202}
203
204sub new {
205 die "method new called with wrong number of arguments"
206 unless @_==2 or @_==4;
207 #local (*FIN, *FOUT);
208 my ($FIN, $FOUT);
209 if (@_==2) {
210 ($console, $consoleOUT) = findConsole;
211
212 open(FIN, "<$console");
213 open(FOUT,">$consoleOUT");
214 #OUT->autoflush(1); # Conflicts with debugger?
215 $sel = select(FOUT);
216 $| = 1; # for DB::OUT
217 select($sel);
218 bless [\*FIN, \*FOUT];
219 } else { # Filehandles supplied
220 $FIN = $_[2]; $FOUT = $_[3];
221 #OUT->autoflush(1); # Conflicts with debugger?
222 $sel = select($FOUT);
223 $| = 1; # for DB::OUT
224 select($sel);
225 bless [$FIN, $FOUT];
226 }
227}
f36776d9
IZ
228
229sub newTTY {
230 my ($self, $in, $out) = @_;
231 $self->[0] = $in;
232 $self->[1] = $out;
233 my $sel = select($out);
234 $| = 1; # for DB::OUT
235 select($sel);
236}
237
cb31d310 238sub IN { shift->[0] }
239sub OUT { shift->[1] }
240sub MinLine { undef }
a737e074
CS
241sub Attribs { {} }
242
84902520 243my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
a737e074 244sub Features { \%features }
cb31d310 245
246package Term::ReadLine; # So late to allow the above code be defined?
a737e074
CS
247
248my $which = $ENV{PERL_RL};
249if ($which) {
250 if ($which =~ /\bgnu\b/i){
251 eval "use Term::ReadLine::Gnu;";
252 } elsif ($which =~ /\bperl\b/i) {
253 eval "use Term::ReadLine::Perl;";
254 } else {
255 eval "use Term::ReadLine::$which;";
256 }
257} elsif (defined $which) { # Defined but false
258 # Do nothing fancy
259} else {
260 eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
261}
cb31d310 262
263#require FileHandle;
264
265# To make possible switch off RL in debugger: (Not needed, work done
266# in debugger).
267
268if (defined &Term::ReadLine::Gnu::readline) {
269 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
270} elsif (defined &Term::ReadLine::Perl::readline) {
271 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
272} else {
273 @ISA = qw(Term::ReadLine::Stub);
274}
275
7a2e2cd6 276package Term::ReadLine::TermCap;
277
278# Prompt-start, prompt-end, command-line-start, command-line-end
279# -- zero-width beautifies to emit around prompt and the command line.
280@rl_term_set = ("","","","");
281# string encoded:
282$rl_term_set = ',,,';
283
284sub LoadTermCap {
285 return if defined $terminal;
286
287 require Term::Cap;
288 $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
289}
290
291sub ornaments {
292 shift;
293 return $rl_term_set unless @_;
294 $rl_term_set = shift;
295 $rl_term_set ||= ',,,';
296 $rl_term_set = 'us,ue,md,me' if $rl_term_set == 1;
297 my @ts = split /,/, $rl_term_set, 4;
298 eval { LoadTermCap };
299 warn("Cannot find termcap: $@\n"), return unless defined $terminal;
300 @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
301 return $rl_term_set;
302}
303
304
a737e074
CS
305package Term::ReadLine::Tk;
306
307$count_handle = $count_DoOne = $count_loop = 0;
308
309sub handle {$giveup = 1; $count_handle++}
310
311sub Tk_loop {
312 # Tk->tkwait('variable',\$giveup); # needs Widget
313 $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
314 $count_loop++;
315 $giveup = 0;
316}
317
318sub register_Tk {
319 my $self = shift;
320 $Term::ReadLine::registered++
321 or Tk->fileevent($self->IN,'readable',\&handle);
322}
323
324sub tkRunning {
325 $Term::ReadLine::toloop = $_[1] if @_ > 1;
326 $Term::ReadLine::toloop;
327}
328
329sub get_c {
330 my $self = shift;
331 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
332 return getc $self->IN;
333}
334
335sub get_line {
336 my $self = shift;
337 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
338 my $in = $self->IN;
339 return scalar <$in>;
340}
cb31d310 341
3421;
343