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 chomp $tty_saved_state;
110 $tty_restore = qq($stty "$tty_saved_state");
113 system $tty_raw_noecho if defined $tty_raw_noecho;
115 print($prompt, $return);
116 while (($_ = getc(STDIN)) ne "\r") {
118 # (TAB) attempt completion
120 @match = grep(/^\Q$return/, @cmp_lst);
121 unless ($#match < 0) {
122 $l = length($test = shift(@match));
123 foreach $cmp (@match) {
124 until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
129 print($test = substr($test, $r, $l - $r));
130 $r = length($return .= $test);
135 # (^D) completion list
136 $_ eq $complete && do {
137 print(join("\r\n", '', grep(/^\Q$return/, @cmp_lst)), "\r\n");
152 # (DEL) || (BS) erase
153 ($_ eq $erase1 || $_ eq $erase2) && do {
172 system $tty_restore if defined $tty_restore;