[DOC PATCH] Carp.pm pod typo
[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
4c3ccbe1 160=head1 CAVEATS
161
162It seems that using Term::ReadLine from Emacs minibuffer doesn't work
163quite right and one will get an error message like
164
165 Cannot open /dev/tty for read at ...
166
167One possible workaround for this is to explicitly open /dev/tty like this
168
169 open (FH, "/dev/tty" )
170 or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }';
171 die $@ if $@;
172 close (FH);
173
174or you can try using the 4-argument form of Term::ReadLine->new().
175
cb31d310 176=cut
177
b75c8c73 178use strict;
179
cb31d310 180package Term::ReadLine::Stub;
b75c8c73 181our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
cb31d310 182
183$DB::emacs = $DB::emacs; # To peacify -w
b75c8c73 184our @rl_term_set;
7a2e2cd6 185*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
cb31d310 186
187sub ReadLine {'Term::ReadLine::Stub'}
188sub readline {
a737e074 189 my $self = shift;
190 my ($in,$out,$str) = @$self;
6d697788 191 my $prompt = shift;
192 print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
a737e074 193 $self->register_Tk
194 if not $Term::ReadLine::registered and $Term::ReadLine::toloop
195 and defined &Tk::DoOneEvent;
196 #$str = scalar <$in>;
197 $str = $self->get_line;
6d697788 198 $str =~ s/^\s*\Q$prompt\E// if ($^O eq 'MacOS');
7a2e2cd6 199 print $out $rl_term_set[3];
cb31d310 200 # bug in 5.000: chomping empty string creats length -1:
201 chomp $str if defined $str;
202 $str;
203}
204sub addhistory {}
205
206sub findConsole {
207 my $console;
208
6d697788 209 if ($^O eq 'MacOS') {
210 $console = "Dev:Console";
211 } elsif (-e "/dev/tty") {
cb31d310 212 $console = "/dev/tty";
8878e869 213 } elsif (-e "con" or $^O eq 'MSWin32') {
cb31d310 214 $console = "con";
215 } else {
216 $console = "sys\$command";
217 }
218
4d2c4e07 219 if (($^O eq 'amigaos') || ($^O eq 'beos') || ($^O eq 'epoc')) {
287f63d2 220 $console = undef;
221 }
222 elsif ($^O eq 'os2') {
cb31d310 223 if ($DB::emacs) {
224 $console = undef;
225 } else {
226 $console = "/dev/con";
227 }
228 }
229
b75c8c73 230 my $consoleOUT = $console;
cb31d310 231 $console = "&STDIN" unless defined $console;
232 if (!defined $consoleOUT) {
233 $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
234 }
235 ($console,$consoleOUT);
236}
237
238sub new {
239 die "method new called with wrong number of arguments"
240 unless @_==2 or @_==4;
241 #local (*FIN, *FOUT);
405ff068 242 my ($FIN, $FOUT, $ret);
cb31d310 243 if (@_==2) {
4c3ccbe1 244 my($console, $consoleOUT) = $_[0]->findConsole;
cb31d310 245
246 open(FIN, "<$console");
247 open(FOUT,">$consoleOUT");
248 #OUT->autoflush(1); # Conflicts with debugger?
b75c8c73 249 my $sel = select(FOUT);
cb31d310 250 $| = 1; # for DB::OUT
251 select($sel);
405ff068 252 $ret = bless [\*FIN, \*FOUT];
cb31d310 253 } else { # Filehandles supplied
254 $FIN = $_[2]; $FOUT = $_[3];
255 #OUT->autoflush(1); # Conflicts with debugger?
b75c8c73 256 my $sel = select($FOUT);
cb31d310 257 $| = 1; # for DB::OUT
258 select($sel);
405ff068 259 $ret = bless [$FIN, $FOUT];
cb31d310 260 }
405ff068 261 if ($ret->Features->{ornaments}
262 and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) {
263 local $Term::ReadLine::termcap_nowarn = 1;
264 $ret->ornaments(1);
265 }
266 return $ret;
cb31d310 267}
f36776d9 268
269sub newTTY {
270 my ($self, $in, $out) = @_;
271 $self->[0] = $in;
272 $self->[1] = $out;
273 my $sel = select($out);
274 $| = 1; # for DB::OUT
275 select($sel);
276}
277
cb31d310 278sub IN { shift->[0] }
279sub OUT { shift->[1] }
280sub MinLine { undef }
a737e074 281sub Attribs { {} }
282
84902520 283my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
a737e074 284sub Features { \%features }
cb31d310 285
286package Term::ReadLine; # So late to allow the above code be defined?
a737e074 287
b75c8c73 288our $VERSION = '1.00';
289
405ff068 290my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
a737e074 291if ($which) {
292 if ($which =~ /\bgnu\b/i){
293 eval "use Term::ReadLine::Gnu;";
294 } elsif ($which =~ /\bperl\b/i) {
295 eval "use Term::ReadLine::Perl;";
296 } else {
297 eval "use Term::ReadLine::$which;";
298 }
405ff068 299} elsif (defined $which and $which ne '') { # Defined but false
a737e074 300 # Do nothing fancy
301} else {
302 eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
303}
cb31d310 304
305#require FileHandle;
306
307# To make possible switch off RL in debugger: (Not needed, work done
308# in debugger).
b75c8c73 309our @ISA;
cb31d310 310if (defined &Term::ReadLine::Gnu::readline) {
311 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
312} elsif (defined &Term::ReadLine::Perl::readline) {
313 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
314} else {
315 @ISA = qw(Term::ReadLine::Stub);
316}
317
7a2e2cd6 318package Term::ReadLine::TermCap;
319
320# Prompt-start, prompt-end, command-line-start, command-line-end
321# -- zero-width beautifies to emit around prompt and the command line.
b75c8c73 322our @rl_term_set = ("","","","");
7a2e2cd6 323# string encoded:
b75c8c73 324our $rl_term_set = ',,,';
7a2e2cd6 325
b75c8c73 326our $terminal;
7a2e2cd6 327sub LoadTermCap {
328 return if defined $terminal;
329
330 require Term::Cap;
331 $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
332}
333
334sub ornaments {
335 shift;
336 return $rl_term_set unless @_;
337 $rl_term_set = shift;
338 $rl_term_set ||= ',,,';
7b8d334a 339 $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1';
7a2e2cd6 340 my @ts = split /,/, $rl_term_set, 4;
341 eval { LoadTermCap };
405ff068 342 unless (defined $terminal) {
343 warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn;
344 $rl_term_set = ',,,';
345 return;
346 }
7a2e2cd6 347 @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
348 return $rl_term_set;
349}
350
351
a737e074 352package Term::ReadLine::Tk;
353
b75c8c73 354our($count_handle, $count_DoOne, $count_loop);
a737e074 355$count_handle = $count_DoOne = $count_loop = 0;
356
b75c8c73 357our($giveup);
a737e074 358sub handle {$giveup = 1; $count_handle++}
359
360sub Tk_loop {
361 # Tk->tkwait('variable',\$giveup); # needs Widget
362 $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
363 $count_loop++;
364 $giveup = 0;
365}
366
367sub register_Tk {
368 my $self = shift;
369 $Term::ReadLine::registered++
370 or Tk->fileevent($self->IN,'readable',\&handle);
371}
372
373sub tkRunning {
374 $Term::ReadLine::toloop = $_[1] if @_ > 1;
375 $Term::ReadLine::toloop;
376}
377
378sub get_c {
379 my $self = shift;
380 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
381 return getc $self->IN;
382}
383
384sub get_line {
385 my $self = shift;
386 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
387 my $in = $self->IN;
4e83e451 388 local ($/) = "\n";
a737e074 389 return scalar <$in>;
390}
cb31d310 391
3921;
393