diff options
Diffstat (limited to 'gnu/usr.bin/perl/lib/complete.pl')
-rw-r--r-- | gnu/usr.bin/perl/lib/complete.pl | 110 |
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 0000000..dabf8f6 --- /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($[) = 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; |