This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Little patch for perl5.003_97c/pod/perlpod.pod
[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
cb31d310 108=head1 EXPORTS
109
110None
111
a737e074
CS
112=head1 ENVIRONMENT
113
114The variable C<PERL_RL> governs which ReadLine clone is loaded. If the
115value is false, a dummy interface is used. If the value is true, it
116should be tail of the name of the package to use, such as C<Perl> or
117C<Gnu>.
118
119If the variable is not set, the best available package is loaded.
120
cb31d310 121=cut
122
123package Term::ReadLine::Stub;
a737e074 124@ISA = 'Term::ReadLine::Tk';
cb31d310 125
126$DB::emacs = $DB::emacs; # To peacify -w
127
128sub ReadLine {'Term::ReadLine::Stub'}
129sub readline {
a737e074
CS
130 my $self = shift;
131 my ($in,$out,$str) = @$self;
cb31d310 132 print $out shift;
a737e074
CS
133 $self->register_Tk
134 if not $Term::ReadLine::registered and $Term::ReadLine::toloop
135 and defined &Tk::DoOneEvent;
136 #$str = scalar <$in>;
137 $str = $self->get_line;
cb31d310 138 # bug in 5.000: chomping empty string creats length -1:
139 chomp $str if defined $str;
140 $str;
141}
142sub addhistory {}
143
144sub findConsole {
145 my $console;
146
147 if (-e "/dev/tty") {
148 $console = "/dev/tty";
149 } elsif (-e "con") {
150 $console = "con";
151 } else {
152 $console = "sys\$command";
153 }
154
287f63d2
CS
155 if ($^O eq 'amigaos') {
156 $console = undef;
157 }
158 elsif ($^O eq 'os2') {
cb31d310 159 if ($DB::emacs) {
160 $console = undef;
161 } else {
162 $console = "/dev/con";
163 }
164 }
165
166 $consoleOUT = $console;
167 $console = "&STDIN" unless defined $console;
168 if (!defined $consoleOUT) {
169 $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
170 }
171 ($console,$consoleOUT);
172}
173
174sub new {
175 die "method new called with wrong number of arguments"
176 unless @_==2 or @_==4;
177 #local (*FIN, *FOUT);
178 my ($FIN, $FOUT);
179 if (@_==2) {
180 ($console, $consoleOUT) = findConsole;
181
182 open(FIN, "<$console");
183 open(FOUT,">$consoleOUT");
184 #OUT->autoflush(1); # Conflicts with debugger?
185 $sel = select(FOUT);
186 $| = 1; # for DB::OUT
187 select($sel);
188 bless [\*FIN, \*FOUT];
189 } else { # Filehandles supplied
190 $FIN = $_[2]; $FOUT = $_[3];
191 #OUT->autoflush(1); # Conflicts with debugger?
192 $sel = select($FOUT);
193 $| = 1; # for DB::OUT
194 select($sel);
195 bless [$FIN, $FOUT];
196 }
197}
198sub IN { shift->[0] }
199sub OUT { shift->[1] }
200sub MinLine { undef }
a737e074
CS
201sub Attribs { {} }
202
203my %features = (tkRunning => 1);
204sub Features { \%features }
cb31d310 205
206package Term::ReadLine; # So late to allow the above code be defined?
a737e074
CS
207
208my $which = $ENV{PERL_RL};
209if ($which) {
210 if ($which =~ /\bgnu\b/i){
211 eval "use Term::ReadLine::Gnu;";
212 } elsif ($which =~ /\bperl\b/i) {
213 eval "use Term::ReadLine::Perl;";
214 } else {
215 eval "use Term::ReadLine::$which;";
216 }
217} elsif (defined $which) { # Defined but false
218 # Do nothing fancy
219} else {
220 eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
221}
cb31d310 222
223#require FileHandle;
224
225# To make possible switch off RL in debugger: (Not needed, work done
226# in debugger).
227
228if (defined &Term::ReadLine::Gnu::readline) {
229 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
230} elsif (defined &Term::ReadLine::Perl::readline) {
231 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
232} else {
233 @ISA = qw(Term::ReadLine::Stub);
234}
235
a737e074
CS
236package Term::ReadLine::Tk;
237
238$count_handle = $count_DoOne = $count_loop = 0;
239
240sub handle {$giveup = 1; $count_handle++}
241
242sub Tk_loop {
243 # Tk->tkwait('variable',\$giveup); # needs Widget
244 $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
245 $count_loop++;
246 $giveup = 0;
247}
248
249sub register_Tk {
250 my $self = shift;
251 $Term::ReadLine::registered++
252 or Tk->fileevent($self->IN,'readable',\&handle);
253}
254
255sub tkRunning {
256 $Term::ReadLine::toloop = $_[1] if @_ > 1;
257 $Term::ReadLine::toloop;
258}
259
260sub get_c {
261 my $self = shift;
262 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
263 return getc $self->IN;
264}
265
266sub get_line {
267 my $self = shift;
268 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
269 my $in = $self->IN;
270 return scalar <$in>;
271}
cb31d310 272
2731;
274