1 package Term::Complete;
6 our @ISA = qw(Exporter);
7 our @EXPORT = qw(Complete);
10 # @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91
14 Term::Complete - Perl word completion module
18 $input = Complete('prompt_string', \@completion_list);
19 $input = Complete('prompt_string', @completion_list);
23 This routine provides word completion on the list of words in
24 the array (or array ref).
26 The tty driver is put into raw mode and restored using an operating
27 system specific command, in UNIX-like environments C<stty>.
29 The following command characters are defined:
35 Attempts word completion.
40 Prints completion list.
41 Defined by I<$Term::Complete::complete>.
45 Erases the current input.
46 Defined by I<$Term::Complete::kill>.
48 =item E<lt>delE<gt>, E<lt>bsE<gt>
51 Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.
57 Bell sounds when word completion fails.
61 The completion character E<lt>tabE<gt> cannot be changed.
69 our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty);
70 our($tty_saved_state) = '';
76 foreach my $s (qw(/bin/stty /usr/bin/stty)) {
78 $tty_raw_noecho = "$s raw -echo";
79 $tty_restore = "$s -raw echo";
87 my($prompt, @cmp_lst, $cmp, $test, $l, @match);
88 my ($return, $r) = ("", 0);
94 if (ref $_[0] || $_[0] =~ /^\*/) {
95 @cmp_lst = sort @{$_[0]};
101 # Attempt to save the current stty state, to be restored later
102 if (defined $stty && defined $tty_saved_state && $tty_saved_state eq '') {
103 $tty_saved_state = qx($stty -g 2>/dev/null);
105 # stty -g not supported
106 $tty_saved_state = undef;
109 $tty_restore = qq($stty "$tty_saved_state");
112 system $tty_raw_noecho if defined $tty_raw_noecho;
114 print($prompt, $return);
115 while (($_ = getc(STDIN)) ne "\r") {
117 # (TAB) attempt completion
119 @match = grep(/^$return/, @cmp_lst);
120 unless ($#match < 0) {
121 $l = length($test = shift(@match));
122 foreach $cmp (@match) {
123 until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
128 print($test = substr($test, $r, $l - $r));
129 $r = length($return .= $test);
134 # (^D) completion list
135 $_ eq $complete && do {
136 print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
151 # (DEL) || (BS) erase
152 ($_ eq $erase1 || $_ eq $erase2) && do {
171 system $tty_restore if defined $tty_restore;