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