1package Term::Complete;
2require 5.000;
3require Exporter;
4
5use strict;
6our @ISA = qw(Exporter);
7our @EXPORT = qw(Complete);
8our $VERSION = '1.403';
9
10#      @(#)complete.pl,v1.2            (me@anywhere.EBay.Sun.COM) 09/23/91
11
12=head1 NAME
13
14Term::Complete - Perl word completion module
15
16=head1 SYNOPSIS
17
18    $input = Complete('prompt_string', \@completion_list);
19    $input = Complete('prompt_string', @completion_list);
20
21=head1 DESCRIPTION
22
23This routine provides word completion on the list of words in
24the array (or array ref).
25
26The tty driver is put into raw mode and restored using an operating
27system specific command, in UNIX-like environments C<stty>.
28
29The following command characters are defined:
30
31=over 4
32
33=item E<lt>tabE<gt>
34
35Attempts word completion.
36Cannot be changed.
37
38=item ^D
39
40Prints completion list.
41Defined by I<$Term::Complete::complete>.
42
43=item ^U
44
45Erases the current input.
46Defined by I<$Term::Complete::kill>.
47
48=item E<lt>delE<gt>, E<lt>bsE<gt>
49
50Erases one character.
51Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.
52
53=back
54
55=head1 DIAGNOSTICS
56
57Bell sounds when word completion fails.
58
59=head1 BUGS
60
61The completion character E<lt>tabE<gt> cannot be changed.
62
63=head1 AUTHOR
64
65Wayne Thompson
66
67=cut
68
69our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty, $tty_safe_restore);
70our($tty_saved_state) = '';
71CONFIG: {
72    $complete = "\004";
73    $kill     = "\025";
74    $erase1 =   "\177";
75    $erase2 =   "\010";
76    foreach my $s (qw(/bin/stty /usr/bin/stty)) {
77	if (-x $s) {
78	    $tty_raw_noecho = "$s raw -echo";
79	    $tty_restore    = "$s -raw echo";
80	    $tty_safe_restore = $tty_restore;
81	    $stty = $s;
82	    last;
83	}
84    }
85}
86
87sub Complete {
88    my($prompt, @cmp_lst, $cmp, $test, $l, @match);
89    my ($return, $r) = ("", 0);
90
91    $return = "";
92    $r      = 0;
93
94    $prompt = shift;
95    if (ref $_[0] || $_[0] =~ /^\*/) {
96	@cmp_lst = sort @{$_[0]};
97    }
98    else {
99	@cmp_lst = sort(@_);
100    }
101
102    # Attempt to save the current stty state, to be restored later
103    if (defined $stty && defined $tty_saved_state && $tty_saved_state eq '') {
104	$tty_saved_state = qx($stty -g 2>/dev/null);
105	if ($?) {
106	    # stty -g not supported
107	    $tty_saved_state = undef;
108	}
109	else {
110	    $tty_saved_state =~ s/\s+$//g;
111	    $tty_restore = qq($stty "$tty_saved_state" 2>/dev/null);
112	}
113    }
114    system $tty_raw_noecho if defined $tty_raw_noecho;
115    LOOP: {
116        local $_;
117        print($prompt, $return);
118        while (($_ = getc(STDIN)) ne "\r") {
119            CASE: {
120                # (TAB) attempt completion
121                $_ eq "\t" && do {
122                    @match = grep(/^\Q$return/, @cmp_lst);
123                    unless ($#match < 0) {
124                        $l = length($test = shift(@match));
125                        foreach $cmp (@match) {
126                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
127                                $l--;
128                            }
129                        }
130                        print("\a");
131                        print($test = substr($test, $r, $l - $r));
132                        $r = length($return .= $test);
133                    }
134                    last CASE;
135                };
136
137                # (^D) completion list
138                $_ eq $complete && do {
139                    print(join("\r\n", '', grep(/^\Q$return/, @cmp_lst)), "\r\n");
140                    redo LOOP;
141                };
142
143                # (^U) kill
144                $_ eq $kill && do {
145                    if ($r) {
146                        $r	= 0;
147			$return	= "";
148                        print("\r\n");
149                        redo LOOP;
150                    }
151                    last CASE;
152                };
153
154                # (DEL) || (BS) erase
155                ($_ eq $erase1 || $_ eq $erase2) && do {
156                    if($r) {
157                        print("\b \b");
158                        chop($return);
159                        $r--;
160                    }
161                    last CASE;
162                };
163
164                # printable char
165                ord >= ord(" ") && do {
166                    $return .= $_;
167                    $r++;
168                    print;
169                    last CASE;
170                };
171            }
172        }
173    }
174
175    # system $tty_restore if defined $tty_restore;
176    if (defined $tty_saved_state && defined $tty_restore && defined $tty_safe_restore)
177    {
178	system $tty_restore;
179	if ($?) {
180	    # tty_restore caused error
181	    system $tty_safe_restore;
182	}
183    }
184    print("\n");
185    $return;
186}
187
1881;
189