X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTerm%2FComplete.pm;h=445dfca02a26f84fc934a326be57ffbdb4957569;hb=206483f1ebeef33f7da74d5c167b3fd37bbf2d6b;hp=97c71fe43f5fd3aaafe854c8395da956769abf0d;hpb=f06db76b9e41859439aeadb79feb6c603ee741ff;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm index 97c71fe..445dfca 100644 --- a/lib/Term/Complete.pm +++ b/lib/Term/Complete.pm @@ -5,30 +5,64 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(Complete); -# -# @(#)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); -# +# @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91 + +=head1 NAME + +Term::Complete - Perl word completion module + +=head1 SYNOPSIS + + $input = Complete('prompt_string', \@completion_list); + $input = Complete('prompt_string', @completion_list); + +=head1 DESCRIPTION + +This routine provides word completion on the list of words in +the array (or array ref). + +The tty driver is put into raw mode using the system command +C and restored using C. + +The following command characters are defined: + +=over 4 + +=item EtabE + +Attempts word completion. +Cannot be changed. + +=item ^D + +Prints completion list. +Defined by I<$Term::Complete::complete>. + +=item ^U + +Erases the current input. +Defined by I<$Term::Complete::kill>. + +=item EdelE, EbsE + +Erases one character. +Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>. + +=back + +=head1 DIAGNOSTICS + +Bell sounds when word completion fails. + +=head1 BUGS + +The completion character EtabE cannot be changed. + +=head1 AUTHOR + +Wayne Thompson + +=cut CONFIG: { $complete = "\004"; @@ -38,6 +72,12 @@ CONFIG: { } sub Complete { + my($prompt, @cmp_list, $cmp, $test, $l, @match); + my ($return, $r) = ("", 0); + + $return = ""; + $r = 0; + $prompt = shift; if (ref $_[0] || $_[0] =~ /^\*/) { @cmp_lst = sort @{$_[0]}; @@ -54,17 +94,17 @@ sub Complete { # (TAB) attempt completion $_ eq "\t" && do { @match = grep(/^$return/, @cmp_lst); - $l = length($test = shift(@match)); unless ($#match < 0) { + $l = length($test = shift(@match)); 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); } - print($test = substr($test, $r, $l - $r)); - $r = length($return .= $test); last CASE; }; @@ -77,7 +117,8 @@ sub Complete { # (^U) kill $_ eq $kill && do { if ($r) { - undef($r, $return); + $r = 0; + $return = ""; print("\r\n"); redo LOOP; }