This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
DB_File 1.15 patch
[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
7a2e2cd6 108The stub package included with the perl distribution allows two
109additional methods: C<tkRunning> and C<ornaments>. The first one
110makes Tk event loop run when waiting for user input (i.e., during
111C<readline> method), the second one makes the command line stand out
112by using termcap data. The argument to C<ornaments> should be 0, 1,
113or a string of a form "aa,bb,cc,dd". Four components of this string
114should be names of I<terminal capacities>, first two will be issued to
115make the prompt standout, last two to make the input line standout.
116
cb31d310 117=head1 EXPORTS
118
119None
120
a737e074
CS
121=head1 ENVIRONMENT
122
123The variable C<PERL_RL> governs which ReadLine clone is loaded. If the
124value is false, a dummy interface is used. If the value is true, it
125should be tail of the name of the package to use, such as C<Perl> or
126C<Gnu>.
127
128If the variable is not set, the best available package is loaded.
129
cb31d310 130=cut
131
132package Term::ReadLine::Stub;
7a2e2cd6 133@ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
cb31d310 134
135$DB::emacs = $DB::emacs; # To peacify -w
7a2e2cd6 136*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
cb31d310 137
138sub ReadLine {'Term::ReadLine::Stub'}
139sub readline {
a737e074
CS
140 my $self = shift;
141 my ($in,$out,$str) = @$self;
7a2e2cd6 142 print $out $rl_term_set[0], shift, $rl_term_set[1], $rl_term_set[2];
a737e074
CS
143 $self->register_Tk
144 if not $Term::ReadLine::registered and $Term::ReadLine::toloop
145 and defined &Tk::DoOneEvent;
146 #$str = scalar <$in>;
147 $str = $self->get_line;
7a2e2cd6 148 print $out $rl_term_set[3];
cb31d310 149 # bug in 5.000: chomping empty string creats length -1:
150 chomp $str if defined $str;
151 $str;
152}
153sub addhistory {}
154
155sub findConsole {
156 my $console;
157
158 if (-e "/dev/tty") {
159 $console = "/dev/tty";
8878e869 160 } elsif (-e "con" or $^O eq 'MSWin32') {
cb31d310 161 $console = "con";
162 } else {
163 $console = "sys\$command";
164 }
165
287f63d2
CS
166 if ($^O eq 'amigaos') {
167 $console = undef;
168 }
169 elsif ($^O eq 'os2') {
cb31d310 170 if ($DB::emacs) {
171 $console = undef;
172 } else {
173 $console = "/dev/con";
174 }
175 }
176
177 $consoleOUT = $console;
178 $console = "&STDIN" unless defined $console;
179 if (!defined $consoleOUT) {
180 $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
181 }
182 ($console,$consoleOUT);
183}
184
185sub new {
186 die "method new called with wrong number of arguments"
187 unless @_==2 or @_==4;
188 #local (*FIN, *FOUT);
189 my ($FIN, $FOUT);
190 if (@_==2) {
191 ($console, $consoleOUT) = findConsole;
192
193 open(FIN, "<$console");
194 open(FOUT,">$consoleOUT");
195 #OUT->autoflush(1); # Conflicts with debugger?
196 $sel = select(FOUT);
197 $| = 1; # for DB::OUT
198 select($sel);
199 bless [\*FIN, \*FOUT];
200 } else { # Filehandles supplied
201 $FIN = $_[2]; $FOUT = $_[3];
202 #OUT->autoflush(1); # Conflicts with debugger?
203 $sel = select($FOUT);
204 $| = 1; # for DB::OUT
205 select($sel);
206 bless [$FIN, $FOUT];
207 }
208}
209sub IN { shift->[0] }
210sub OUT { shift->[1] }
211sub MinLine { undef }
a737e074
CS
212sub Attribs { {} }
213
7a2e2cd6 214my %features = (tkRunning => 1, ornaments => 1);
a737e074 215sub Features { \%features }
cb31d310 216
217package Term::ReadLine; # So late to allow the above code be defined?
a737e074
CS
218
219my $which = $ENV{PERL_RL};
220if ($which) {
221 if ($which =~ /\bgnu\b/i){
222 eval "use Term::ReadLine::Gnu;";
223 } elsif ($which =~ /\bperl\b/i) {
224 eval "use Term::ReadLine::Perl;";
225 } else {
226 eval "use Term::ReadLine::$which;";
227 }
228} elsif (defined $which) { # Defined but false
229 # Do nothing fancy
230} else {
231 eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
232}
cb31d310 233
234#require FileHandle;
235
236# To make possible switch off RL in debugger: (Not needed, work done
237# in debugger).
238
239if (defined &Term::ReadLine::Gnu::readline) {
240 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
241} elsif (defined &Term::ReadLine::Perl::readline) {
242 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
243} else {
244 @ISA = qw(Term::ReadLine::Stub);
245}
246
7a2e2cd6 247package Term::ReadLine::TermCap;
248
249# Prompt-start, prompt-end, command-line-start, command-line-end
250# -- zero-width beautifies to emit around prompt and the command line.
251@rl_term_set = ("","","","");
252# string encoded:
253$rl_term_set = ',,,';
254
255sub LoadTermCap {
256 return if defined $terminal;
257
258 require Term::Cap;
259 $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
260}
261
262sub ornaments {
263 shift;
264 return $rl_term_set unless @_;
265 $rl_term_set = shift;
266 $rl_term_set ||= ',,,';
267 $rl_term_set = 'us,ue,md,me' if $rl_term_set == 1;
268 my @ts = split /,/, $rl_term_set, 4;
269 eval { LoadTermCap };
270 warn("Cannot find termcap: $@\n"), return unless defined $terminal;
271 @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
272 return $rl_term_set;
273}
274
275
a737e074
CS
276package Term::ReadLine::Tk;
277
278$count_handle = $count_DoOne = $count_loop = 0;
279
280sub handle {$giveup = 1; $count_handle++}
281
282sub Tk_loop {
283 # Tk->tkwait('variable',\$giveup); # needs Widget
284 $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
285 $count_loop++;
286 $giveup = 0;
287}
288
289sub register_Tk {
290 my $self = shift;
291 $Term::ReadLine::registered++
292 or Tk->fileevent($self->IN,'readable',\&handle);
293}
294
295sub tkRunning {
296 $Term::ReadLine::toloop = $_[1] if @_ > 1;
297 $Term::ReadLine::toloop;
298}
299
300sub get_c {
301 my $self = shift;
302 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
303 return getc $self->IN;
304}
305
306sub get_line {
307 my $self = shift;
308 $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
309 my $in = $self->IN;
310 return scalar <$in>;
311}
cb31d310 312
3131;
314