Commit | Line | Data |
cb31d310 |
1 | =head1 NAME |
2 | |
c07a80fd |
3 | Term::ReadLine - Perl interface to various C<readline> packages. If |
cb31d310 |
4 | no 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 | |
21 | This package is just a front end to some other packages. At the moment |
22 | this description is written, the only such package is Term-ReadLine, |
23 | available on CPAN near you. The real target of this stub package is to |
24 | set up a common interface to whatever Readline emerges with time. |
25 | |
cb31d310 |
26 | =head1 Minimal set of supported functions |
27 | |
28 | All the supported functions should be called as methods, i.e., either as |
29 | |
30 | $term = new Term::ReadLine 'name'; |
31 | |
32 | or as |
33 | |
34 | $term->addhistory('row'); |
35 | |
1fef88e7 |
36 | where $term is a return value of Term::ReadLine-E<gt>Init. |
cb31d310 |
37 | |
38 | =over 12 |
39 | |
40 | =item C<ReadLine> |
41 | |
42 | returns the actual package that executes the commands. Among possible |
43 | values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>, |
44 | C<Term::ReadLine::Stub Exporter>. |
45 | |
46 | =item C<new> |
47 | |
48 | returns the handle for subsequent calls to following |
49 | functions. Argument is the name of the application. Optionally can be |
50 | followed by two arguments for C<IN> and C<OUT> filehandles. These |
51 | arguments should be globs. |
52 | |
53 | =item C<readline> |
54 | |
55 | gets an input line, I<possibly> with actual C<readline> |
56 | support. Trailing newline is removed. Returns C<undef> on C<EOF>. |
57 | |
58 | =item C<addhistory> |
59 | |
60 | adds the line to the history of input, from where it can be used if |
61 | the actual C<readline> is present. |
62 | |
63 | =item C<IN>, $C<OUT> |
64 | |
65 | return the filehandles for input and output or C<undef> if C<readline> |
66 | input and output cannot be used for Perl. |
67 | |
68 | =item C<MinLine> |
69 | |
70 | If argument is specified, it is an advice on minimal size of line to |
71 | be included into history. C<undef> means do not include anything into |
72 | history. Returns the old value. |
73 | |
74 | =item C<findConsole> |
75 | |
76 | returns an array with two strings that give most appropriate names for |
1fef88e7 |
77 | files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">. |
cb31d310 |
78 | |
a737e074 |
79 | =item Attribs |
80 | |
81 | returns a reference to a hash which describes internal configuration |
82 | of the package. Names of keys in this hash conform to standard |
83 | conventions with the leading C<rl_> stripped. |
84 | |
cb31d310 |
85 | =item C<Features> |
86 | |
87 | Returns a reference to a hash with keys being features present in |
88 | current implementation. Several optional features are used in the |
89 | minimal interface: C<appname> should be present if the first argument |
90 | to C<new> is recognized, and C<minline> should be present if |
91 | C<MinLine> method is not dummy. C<autohistory> should be present if |
92 | lines are put into history automatically (maybe subject to |
93 | C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy. |
94 | |
a737e074 |
95 | If C<Features> method reports a feature C<attribs> as present, the |
96 | method C<Attribs> is not dummy. |
97 | |
cb31d310 |
98 | =back |
99 | |
a737e074 |
100 | =head1 Additional supported functions |
101 | |
cb31d310 |
102 | Actually C<Term::ReadLine> can use some other package, that will |
103 | support reacher set of commands. |
104 | |
a737e074 |
105 | All these commands are callable via method interface and have names |
106 | which conform to standard conventions with the leading C<rl_> stripped. |
107 | |
f36776d9 |
108 | The stub package included with the perl distribution allows some |
109 | additional methods: |
110 | |
111 | =over 12 |
112 | |
113 | =item C<tkRunning> |
114 | |
7a2e2cd6 |
115 | makes Tk event loop run when waiting for user input (i.e., during |
f36776d9 |
116 | C<readline> method). |
117 | |
118 | =item C<ornaments> |
119 | |
120 | makes the command line stand out by using termcap data. The argument |
121 | to C<ornaments> should be 0, 1, or a string of a form |
122 | C<"aa,bb,cc,dd">. Four components of this string should be names of |
123 | I<terminal capacities>, first two will be issued to make the prompt |
124 | standout, last two to make the input line standout. |
125 | |
126 | =item C<newTTY> |
127 | |
128 | takes two arguments which are input filehandle and output filehandle. |
129 | Switches to use these filehandles. |
130 | |
131 | =back |
132 | |
133 | One can check whether the currently loaded ReadLine package supports |
134 | these methods by checking for corresponding C<Features>. |
7a2e2cd6 |
135 | |
cb31d310 |
136 | =head1 EXPORTS |
137 | |
138 | None |
139 | |
a737e074 |
140 | =head1 ENVIRONMENT |
141 | |
142 | The variable C<PERL_RL> governs which ReadLine clone is loaded. If the |
143 | value is false, a dummy interface is used. If the value is true, it |
144 | should be tail of the name of the package to use, such as C<Perl> or |
145 | C<Gnu>. |
146 | |
147 | If the variable is not set, the best available package is loaded. |
148 | |
cb31d310 |
149 | =cut |
150 | |
151 | package 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 | |
157 | sub ReadLine {'Term::ReadLine::Stub'} |
158 | sub readline { |
a737e074 |
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 |
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 | } |
172 | sub addhistory {} |
173 | |
174 | sub 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 |
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 | |
204 | sub 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 |
228 | |
229 | sub 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 |
238 | sub IN { shift->[0] } |
239 | sub OUT { shift->[1] } |
240 | sub MinLine { undef } |
a737e074 |
241 | sub Attribs { {} } |
242 | |
f36776d9 |
243 | my %features = (tkRunning => 1, ornaments => 1, newTTY => 1); |
a737e074 |
244 | sub Features { \%features } |
cb31d310 |
245 | |
246 | package Term::ReadLine; # So late to allow the above code be defined? |
a737e074 |
247 | |
248 | my $which = $ENV{PERL_RL}; |
249 | if ($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 | |
268 | if (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 |
276 | package 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 | |
284 | sub LoadTermCap { |
285 | return if defined $terminal; |
286 | |
287 | require Term::Cap; |
288 | $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning. |
289 | } |
290 | |
291 | sub 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 |
305 | package Term::ReadLine::Tk; |
306 | |
307 | $count_handle = $count_DoOne = $count_loop = 0; |
308 | |
309 | sub handle {$giveup = 1; $count_handle++} |
310 | |
311 | sub 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 | |
318 | sub register_Tk { |
319 | my $self = shift; |
320 | $Term::ReadLine::registered++ |
321 | or Tk->fileevent($self->IN,'readable',\&handle); |
322 | } |
323 | |
324 | sub tkRunning { |
325 | $Term::ReadLine::toloop = $_[1] if @_ > 1; |
326 | $Term::ReadLine::toloop; |
327 | } |
328 | |
329 | sub get_c { |
330 | my $self = shift; |
331 | $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent; |
332 | return getc $self->IN; |
333 | } |
334 | |
335 | sub 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 | |
342 | 1; |
343 | |