X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fcomplete.pl;h=925ce86e5da266f79389c66562613031ea609959;hb=d9f30342f9de4793189d81b85a5e32057393e428;hp=fd506740869a3de970a8c92051c9bfae5f906931;hpb=a687059cbaf2c6fdccb5e0fae2aee80ec15625a8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/complete.pl b/lib/complete.pl
index fd50674..925ce86 100644
--- a/lib/complete.pl
+++ b/lib/complete.pl
@@ -1,5 +1,14 @@
 ;#
-;#	@(#)complete.pl	1.0 (sun!waynet) 11/11/88
+#
+# This library is no longer being maintained, and is included for backward
+# compatibility with Perl 4 programs which may require it.
+#
+# In particular, this should not be used as an example of modern Perl
+# programming techniques.
+#
+# Suggested alternative: Term::Complete
+#
+;#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
 ;#
 ;# Author: Wayne Thompson
 ;#
@@ -7,6 +16,7 @@
 ;#     This routine provides word completion.
 ;#     (TAB) attempts word completion.
 ;#     (^D)  prints completion list.
+;#      (These may be changed by setting $Complete'complete, etc.)
 ;#
 ;# Diagnostics:
 ;#     Bell when word completion fails.
@@ -15,69 +25,95 @@
 ;#     The tty driver is put into raw mode.
 ;#
 ;# Bugs:
-;#     The erase and kill characters are hard coded.
 ;#
 ;# Usage:
-;#     $input = do Complete('prompt_string', @completion_list);
+;#     $input = &Complete('prompt_string', *completion_list);
+;#         or
+;#     $input = &Complete('prompt_string', @completion_list);
 ;#
 
+CONFIG: {
+    package Complete;
+
+    $complete = "\004";
+    $kill     = "\025";
+    $erase1 =   "\177";
+    $erase2 =   "\010";
+}
+
 sub Complete {
-    local ($prompt) = shift (@_);
-    local ($c, $cmp, $l, $r, $ret, $return, $test);
-    @_ = sort @_;
-    system 'stty raw -echo';
-    loop: {
-	print $prompt, $return;
-	while (($c = getc(stdin)) ne "\r") {
-	    if ($c eq "\t") {			# (TAB) attempt completion
-		@_match = ();
-		foreach $cmp (@_) {
-		    push (@_match, $cmp) if $cmp =~ /^$return/;
-		}
-    	    	$test = $_match[0];
-    	    	$l = length ($test);
-		unless ($#_match == 0) {
-    	    	    shift (@_match);
-    	    	    foreach $cmp (@_match) {
-    	    	    	until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) {
-    	    	    	    $l--;
-    	    	    	}
-    	    	    }
-    	    	    print "\007";
-    	    	}
-    	    	print $test = substr ($test, $r, $l - $r);
-    	    	$r = length ($return .= $test);
-	    }
-	    elsif ($c eq "\004") {		# (^D) completion list
-		print "\r\n";
-		foreach $cmp (@_) {
-		    print "$cmp\r\n" if $cmp =~ /^$return/;
-		}
-		redo loop;
-	    }
-    	    elsif ($c eq "\025" && $r) {	# (^U) kill
-    	    	$return = '';
-    	    	$r = 0;
-    	    	print "\r\n";
-    	    	redo loop;
-    	    }
-	    	    	    	    	    	# (DEL) || (BS) erase
-	    elsif ($c eq "\177" || $c eq "\010") {
-		if($r) {
-		    print "\b \b";
-		    chop ($return);
-		    $r--;
-		}
-	    }
-	    elsif ($c =~ /\S/) {    	    	# printable char
-		$return .= $c;
-		$r++;
-		print $c;
-	    }
-	}
+    package Complete;
+
+    local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
+    if ($_[1] =~ /^StB\0/) {
+        ($prompt, *_) = @_;
+    }
+    else {
+        $prompt = shift(@_);
+    }
+    @cmp_lst = sort(@_);
+
+    system('stty raw -echo');
+    LOOP: {
+        print($prompt, $return);
+        while (($_ = getc(STDIN)) ne "\r") {
+            CASE: {
+                # (TAB) attempt completion
+                $_ eq "\t" && do {
+                    @match = grep(/^$return/, @cmp_lst);
+                    $l = length($test = shift(@match));
+                    unless ($#match < 0) {
+                        foreach $cmp (@match) {
+                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
+                                $l--;
+                            }
+                        }
+                        print("\a");
+                    }
+                    print($test = substr($test, $r, $l - $r));
+                    $r = length($return .= $test);
+                    last CASE;
+                };
+
+                # (^D) completion list
+                $_ eq $complete && do {
+                    print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
+                    redo LOOP;
+                };
+
+                # (^U) kill
+                $_ eq $kill && do {
+                    if ($r) {
+                        undef $r;
+			undef $return;
+                        print("\r\n");
+                        redo LOOP;
+                    }
+                    last CASE;
+                };
+
+                # (DEL) || (BS) erase
+                ($_ eq $erase1 || $_ eq $erase2) && do {
+                    if($r) {
+                        print("\b \b");
+                        chop($return);
+                        $r--;
+                    }
+                    last CASE;
+                };
+
+                # printable char
+                ord >= 32 && do {
+                    $return .= $_;
+                    $r++;
+                    print;
+                    last CASE;
+                };
+            }
+        }
     }
-    system 'stty -raw echo';
-    print "\n";
+    system('stty -raw echo');
+    print("\n");
     $return;
 }