1*0Sstevel@tonic-gate;# 2*0Sstevel@tonic-gate# 3*0Sstevel@tonic-gate# This library is no longer being maintained, and is included for backward 4*0Sstevel@tonic-gate# compatibility with Perl 4 programs which may require it. 5*0Sstevel@tonic-gate# 6*0Sstevel@tonic-gate# In particular, this should not be used as an example of modern Perl 7*0Sstevel@tonic-gate# programming techniques. 8*0Sstevel@tonic-gate# 9*0Sstevel@tonic-gate# Suggested alternative: Term::Complete 10*0Sstevel@tonic-gate# 11*0Sstevel@tonic-gate;# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91 12*0Sstevel@tonic-gate;# 13*0Sstevel@tonic-gate;# Author: Wayne Thompson 14*0Sstevel@tonic-gate;# 15*0Sstevel@tonic-gate;# Description: 16*0Sstevel@tonic-gate;# This routine provides word completion. 17*0Sstevel@tonic-gate;# (TAB) attempts word completion. 18*0Sstevel@tonic-gate;# (^D) prints completion list. 19*0Sstevel@tonic-gate;# (These may be changed by setting $Complete'complete, etc.) 20*0Sstevel@tonic-gate;# 21*0Sstevel@tonic-gate;# Diagnostics: 22*0Sstevel@tonic-gate;# Bell when word completion fails. 23*0Sstevel@tonic-gate;# 24*0Sstevel@tonic-gate;# Dependencies: 25*0Sstevel@tonic-gate;# The tty driver is put into raw mode. 26*0Sstevel@tonic-gate;# 27*0Sstevel@tonic-gate;# Bugs: 28*0Sstevel@tonic-gate;# 29*0Sstevel@tonic-gate;# Usage: 30*0Sstevel@tonic-gate;# $input = &Complete('prompt_string', *completion_list); 31*0Sstevel@tonic-gate;# or 32*0Sstevel@tonic-gate;# $input = &Complete('prompt_string', @completion_list); 33*0Sstevel@tonic-gate;# 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gateCONFIG: { 36*0Sstevel@tonic-gate package Complete; 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gate $complete = "\004"; 39*0Sstevel@tonic-gate $kill = "\025"; 40*0Sstevel@tonic-gate $erase1 = "\177"; 41*0Sstevel@tonic-gate $erase2 = "\010"; 42*0Sstevel@tonic-gate} 43*0Sstevel@tonic-gate 44*0Sstevel@tonic-gatesub Complete { 45*0Sstevel@tonic-gate package Complete; 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gate local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r); 48*0Sstevel@tonic-gate if ($_[1] =~ /^StB\0/) { 49*0Sstevel@tonic-gate ($prompt, *_) = @_; 50*0Sstevel@tonic-gate } 51*0Sstevel@tonic-gate else { 52*0Sstevel@tonic-gate $prompt = shift(@_); 53*0Sstevel@tonic-gate } 54*0Sstevel@tonic-gate @cmp_lst = sort(@_); 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate system('stty raw -echo'); 57*0Sstevel@tonic-gate LOOP: { 58*0Sstevel@tonic-gate print($prompt, $return); 59*0Sstevel@tonic-gate while (($_ = getc(STDIN)) ne "\r") { 60*0Sstevel@tonic-gate CASE: { 61*0Sstevel@tonic-gate # (TAB) attempt completion 62*0Sstevel@tonic-gate $_ eq "\t" && do { 63*0Sstevel@tonic-gate @match = grep(/^$return/, @cmp_lst); 64*0Sstevel@tonic-gate $l = length($test = shift(@match)); 65*0Sstevel@tonic-gate unless ($#match < 0) { 66*0Sstevel@tonic-gate foreach $cmp (@match) { 67*0Sstevel@tonic-gate until (substr($cmp, 0, $l) eq substr($test, 0, $l)) { 68*0Sstevel@tonic-gate $l--; 69*0Sstevel@tonic-gate } 70*0Sstevel@tonic-gate } 71*0Sstevel@tonic-gate print("\a"); 72*0Sstevel@tonic-gate } 73*0Sstevel@tonic-gate print($test = substr($test, $r, $l - $r)); 74*0Sstevel@tonic-gate $r = length($return .= $test); 75*0Sstevel@tonic-gate last CASE; 76*0Sstevel@tonic-gate }; 77*0Sstevel@tonic-gate 78*0Sstevel@tonic-gate # (^D) completion list 79*0Sstevel@tonic-gate $_ eq $complete && do { 80*0Sstevel@tonic-gate print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n"); 81*0Sstevel@tonic-gate redo LOOP; 82*0Sstevel@tonic-gate }; 83*0Sstevel@tonic-gate 84*0Sstevel@tonic-gate # (^U) kill 85*0Sstevel@tonic-gate $_ eq $kill && do { 86*0Sstevel@tonic-gate if ($r) { 87*0Sstevel@tonic-gate undef $r; 88*0Sstevel@tonic-gate undef $return; 89*0Sstevel@tonic-gate print("\r\n"); 90*0Sstevel@tonic-gate redo LOOP; 91*0Sstevel@tonic-gate } 92*0Sstevel@tonic-gate last CASE; 93*0Sstevel@tonic-gate }; 94*0Sstevel@tonic-gate 95*0Sstevel@tonic-gate # (DEL) || (BS) erase 96*0Sstevel@tonic-gate ($_ eq $erase1 || $_ eq $erase2) && do { 97*0Sstevel@tonic-gate if($r) { 98*0Sstevel@tonic-gate print("\b \b"); 99*0Sstevel@tonic-gate chop($return); 100*0Sstevel@tonic-gate $r--; 101*0Sstevel@tonic-gate } 102*0Sstevel@tonic-gate last CASE; 103*0Sstevel@tonic-gate }; 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gate # printable char 106*0Sstevel@tonic-gate ord >= 32 && do { 107*0Sstevel@tonic-gate $return .= $_; 108*0Sstevel@tonic-gate $r++; 109*0Sstevel@tonic-gate print; 110*0Sstevel@tonic-gate last CASE; 111*0Sstevel@tonic-gate }; 112*0Sstevel@tonic-gate } 113*0Sstevel@tonic-gate } 114*0Sstevel@tonic-gate } 115*0Sstevel@tonic-gate system('stty -raw echo'); 116*0Sstevel@tonic-gate print("\n"); 117*0Sstevel@tonic-gate $return; 118*0Sstevel@tonic-gate} 119*0Sstevel@tonic-gate 120*0Sstevel@tonic-gate1; 121