perl 3.0 patch #41 (combined patch)
[p5sagit/p5-mst-13.2.git] / lib / complete.pl
CommitLineData
a687059c 1;#
2;# @(#)complete.pl 1.0 (sun!waynet) 11/11/88
3;#
4;# Author: Wayne Thompson
5;#
6;# Description:
7;# This routine provides word completion.
8;# (TAB) attempts word completion.
9;# (^D) prints completion list.
10;#
11;# Diagnostics:
12;# Bell when word completion fails.
13;#
14;# Dependencies:
15;# The tty driver is put into raw mode.
16;#
17;# Bugs:
18;# The erase and kill characters are hard coded.
19;#
20;# Usage:
21;# $input = do Complete('prompt_string', @completion_list);
22;#
23
24sub Complete {
25 local ($prompt) = shift (@_);
26 local ($c, $cmp, $l, $r, $ret, $return, $test);
d8f2e4cc 27 @_cmp_lst = sort @_;
afd9f252 28 local($[) = 0;
a687059c 29 system 'stty raw -echo';
30 loop: {
31 print $prompt, $return;
32 while (($c = getc(stdin)) ne "\r") {
33 if ($c eq "\t") { # (TAB) attempt completion
34 @_match = ();
d8f2e4cc 35 foreach $cmp (@_cmp_lst) {
a687059c 36 push (@_match, $cmp) if $cmp =~ /^$return/;
37 }
38 $test = $_match[0];
39 $l = length ($test);
40 unless ($#_match == 0) {
41 shift (@_match);
42 foreach $cmp (@_match) {
43 until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) {
44 $l--;
45 }
46 }
47 print "\007";
48 }
49 print $test = substr ($test, $r, $l - $r);
50 $r = length ($return .= $test);
51 }
52 elsif ($c eq "\004") { # (^D) completion list
53 print "\r\n";
d8f2e4cc 54 foreach $cmp (@_cmp_lst) {
a687059c 55 print "$cmp\r\n" if $cmp =~ /^$return/;
56 }
57 redo loop;
58 }
59 elsif ($c eq "\025" && $r) { # (^U) kill
60 $return = '';
61 $r = 0;
62 print "\r\n";
63 redo loop;
64 }
65 # (DEL) || (BS) erase
66 elsif ($c eq "\177" || $c eq "\010") {
67 if($r) {
68 print "\b \b";
69 chop ($return);
70 $r--;
71 }
72 }
73 elsif ($c =~ /\S/) { # printable char
74 $return .= $c;
75 $r++;
76 print $c;
77 }
78 }
79 }
80 system 'stty -raw echo';
81 print "\n";
82 $return;
83}
84
851;