1 files changed, 110 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/lib/complete.pl b/gnu/usr.bin/perl/lib/complete.pl
new file mode 100644
index 00000000000..1e08f9145ae
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/complete.pl
@@ -0,0 +1,110 @@
+;#
+;#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
+;#
+;# Author: Wayne Thompson
+;#
+;# Description:
+;#     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.
+;#
+;# Dependencies:
+;#     The tty driver is put into raw mode.
+;#
+;# Bugs:
+;#
+;# Usage:
+;#     $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 {
+    package Complete;
+
+    local($[,$return) = 0;
+    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, $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");
+    $return;
+}
+
+1;