return 0 rather than "" when scalar grep has nothing to iterate
[p5sagit/p5-mst-13.2.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 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 95If C<Features> method reports a feature C<attribs> as present, the
96method C<Attribs> is not dummy.
97
cb31d310 98=back
99
a737e074 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 105All these commands are callable via method interface and have names
106which conform to standard conventions with the leading C<rl_> stripped.
107
f36776d9 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 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 140=head1 ENVIRONMENT
141
8dcee03e 142The environment variable C<PERL_RL> governs which ReadLine clone is
405ff068 143loaded. If the value is false, a dummy interface is used. If the value
144is true, it should be tail of the name of the package to use, such as
145C<Perl> or C<Gnu>.
a737e074 146
405ff068 147As a special case, if the value of this variable is space-separated,
148the tail might be used to disable the ornaments by setting the tail to
149be C<o=0> or C<ornaments=0>. The head should be as described above, say
150
151If the variable is not set, or if the head of space-separated list is
152empty, the best available package is loaded.
153
154 export "PERL_RL=Perl o=0" # Use Perl ReadLine without ornaments
155 export "PERL_RL= o=0" # Use best available ReadLine without ornaments
156
157(Note that processing of C<PERL_RL> for ornaments is in the discretion of the
158particular used C<Term::ReadLine::*> package).
a737e074 159
cb31d310 160=cut
161
162package Term::ReadLine::Stub;
7a2e2cd6 163@ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
cb31d310 164
165$DB::emacs = $DB::emacs; # To peacify -w
7a2e2cd6 166*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
cb31d310 167
168sub ReadLine {'Term::ReadLine::Stub'}
169sub readline {
a737e074 170 my $self = shift;
171 my ($in,$out,$str) = @$self;
7a2e2cd6 172 print $out $rl_term_set[0], shift, $rl_term_set[1], $rl_term_set[2];
a737e074 173 $self->register_Tk
174 if not $Term::ReadLine::registered and $Term::ReadLine::toloop
175 and defined &Tk::DoOneEvent;
176 #$str = scalar <$in>;
177 $str = $self->get_line;
7a2e2cd6 178 print $out $rl_term_set[3];
cb31d310 179 # bug in 5.000: chomping empty string creats length -1:
180 chomp $str if defined $str;
181 $str;
182}
183sub addhistory {}
184
185sub findConsole {
186 my $console;
187
188 if (-e "/dev/tty") {
189 $console = "/dev/tty";
8878e869 190 } elsif (-e "con" or $^O eq 'MSWin32') {
cb31d310 191 $console = "con";
192 } else {
193 $console = "sys\$command";
194 }
195
6ee623d5 196 if (($^O eq 'amigaos') || ($^O eq 'beos')) {
287f63d2 197 $console = undef;
198 }
199 elsif ($^O eq 'os2') {
cb31d310 200 if ($DB::emacs) {
201 $console = undef;
202 } else {
203 $console = "/dev/con";
204 }
205 }
206
207 $consoleOUT = $console;
208 $console = "&STDIN" unless defined $console;
209 if (!defined $consoleOUT) {
210 $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
211 }
212 ($console,$consoleOUT);
213}
214
215sub new {
216 die "method new called with wrong number of arguments"
217 unless @_==2 or @_==4;
218 #local (*FIN, *FOUT);
405ff068 219 my ($FIN, $FOUT, $ret);
cb31d310 220 if (@_==2) {
221 ($console, $consoleOUT) = findConsole;
222
223 open(FIN, "<$console");
224 open(FOUT,">$consoleOUT");
225 #OUT->autoflush(1); # Conflicts with debugger?
226 $sel = select(FOUT);
227 $| = 1; # for DB::OUT
228 select($sel);
405ff068 229 $ret = bless [\*FIN, \*FOUT];
cb31d310 230 } else { # Filehandles supplied
231 $FIN = $_[2]; $FOUT = $_[3];
232 #OUT->autoflush(1); # Conflicts with debugger?
233 $sel = select($FOUT);
234 $| = 1; # for DB::OUT
235 select($sel);
405ff068 236 $ret = bless [$FIN, $FOUT];
cb31d310 237 }
405ff068 238 if ($ret->Features->{ornaments}
239 and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) {
240 local $Term::ReadLine::termcap_nowarn = 1;
241 $ret->ornaments(1);
242 }
243 return $ret;
cb31d310 244}
f36776d9 245
246sub newTTY {
247 my ($self, $in, $out) = @_;
248 $self->[0] = $in;
249 $self->[1] = $out;
250 my $sel = select($out);
251 $| = 1; # for DB::OUT
252 select($sel);
253}
254
cb31d310 255sub IN { shift->[0] }
256sub OUT { shift->[1] }
257sub MinLine { undef }
a737e074 258sub Attribs { {} }
259
84902520 260my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
a737e074 261sub Features { \%features }
cb31d310 262
263package Term::ReadLine; # So late to allow the above code be defined?
a737e074 264
405ff068 265my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
a737e074 266if ($which) {
267 if ($which =~ /\bgnu\b/i){
268 eval "use Term::ReadLine::Gnu;";
269 } elsif ($which =~ /\bperl\b/i) {
270 eval "use Term::ReadLine::Perl;";
271 } else {
272 eval "use Term::ReadLine::$which;";
273 }
405ff068 274} elsif (defined $which and $which ne '') { # Defined but false
a737e074 275 # Do nothing fancy
276} else {
277 eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
278}
cb31d310 279
280#require FileHandle;
281
282# To make possible switch off RL in debugger: (Not needed, work done
283# in debugger).
284
285if (defined &Term::ReadLine::Gnu::readline) {
286 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
287} elsif (defined &Term::ReadLine::Perl::readline) {
288 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
289} else {
290 @ISA = qw(Term::ReadLine::Stub);
291}
292
7a2e2cd6 293package Term::ReadLine::TermCap;
294
295# Prompt-start, prompt-end, command-line-start, command-line-end
296# -- zero-width beautifies to emit around prompt and the command line.
297@rl_term_set = ("","","","");
298# string encoded:
299$rl_term_set = ',,,';
300
301sub LoadTermCap {
302 return if defined $terminal;
303
304 require Term::Cap;
305 $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
306}
307
308sub ornaments {
309 shift;
310 return $rl_term_set unless @_;
311 $rl_term_set = shift;
312 $rl_term_set ||= ',,,';
7b8d334a 313 $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1';
7a2e2cd6 314 my @ts = split /,/, $rl_term_set, 4;
315 eval { LoadTermCap };
405ff068 316 unless (defined $terminal) {
317 warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn;
318 $rl_term_set = ',,,';
319 return;
320 }
7a2e2cd6 321 @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
322 return $rl_term_set;
323}
324
325
a737e074 326package Term::ReadLine::Tk;
327
328$count_handle = $count_DoOne = $count_loop = 0;
329
330sub handle {$giveup = 1; $count_handle++}
331
332sub Tk_loop {
333 # Tk->tkwait('variable',\$giveup); # needs Widget
334 $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
335 $count_loop++;
336 $giveup = 0;
337}
338
339sub register_Tk {
340 my $self = shift;
341 $Term::ReadLine::registered++
342 or Tk->fileevent($self->IN,'readable',\&handle);
343}
344
345sub tkRunning {
346 $Term::ReadLine::toloop = $_[1] if @_ > 1;
347 $Term::ReadLine::toloop;
348}
349
350sub get_c {
351 my $self = shift;
352 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
353 return getc $self->IN;
354}
355
356sub get_line {
357 my $self = shift;
358 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
359 my $in = $self->IN;
4e83e451 360 local ($/) = "\n";
a737e074 361 return scalar <$in>;
362}
cb31d310 363
3641;
365