I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / complete.pl
CommitLineData
a687059c 1;#
a6d71656 2#
3# This library is no longer being maintained, and is included for backward
4# compatibility with Perl 4 programs which may require it.
5#
6# In particular, this should not be used as an example of modern Perl
7# programming techniques.
8#
9# Suggested alternative: Term::Complete
10#
55204971 11;# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91
a687059c 12;#
13;# Author: Wayne Thompson
14;#
15;# Description:
16;# This routine provides word completion.
17;# (TAB) attempts word completion.
18;# (^D) prints completion list.
55204971 19;# (These may be changed by setting $Complete'complete, etc.)
a687059c 20;#
21;# Diagnostics:
22;# Bell when word completion fails.
23;#
24;# Dependencies:
25;# The tty driver is put into raw mode.
26;#
27;# Bugs:
a687059c 28;#
29;# Usage:
55204971 30;# $input = &Complete('prompt_string', *completion_list);
31;# or
32;# $input = &Complete('prompt_string', @completion_list);
a687059c 33;#
34
7e1cf235 35CONFIG: {
36 package Complete;
37
55204971 38 $complete = "\004";
39 $kill = "\025";
40 $erase1 = "\177";
41 $erase2 = "\010";
7e1cf235 42}
43
a687059c 44sub Complete {
7e1cf235 45 package Complete;
46
55497cff 47 local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
55204971 48 if ($_[1] =~ /^StB\0/) {
49 ($prompt, *_) = @_;
a687059c 50 }
55204971 51 else {
52 $prompt = shift(@_);
53 }
54 @cmp_lst = sort(@_);
55
56 system('stty raw -echo');
57 LOOP: {
58 print($prompt, $return);
59 while (($_ = getc(STDIN)) ne "\r") {
60 CASE: {
61 # (TAB) attempt completion
62 $_ eq "\t" && do {
63 @match = grep(/^$return/, @cmp_lst);
64 $l = length($test = shift(@match));
65 unless ($#match < 0) {
66 foreach $cmp (@match) {
67 until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
68 $l--;
69 }
70 }
71 print("\a");
72 }
73 print($test = substr($test, $r, $l - $r));
74 $r = length($return .= $test);
75 last CASE;
76 };
77
78 # (^D) completion list
79 $_ eq $complete && do {
80 print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
81 redo LOOP;
82 };
83
84 # (^U) kill
85 $_ eq $kill && do {
86 if ($r) {
40da2db3 87 undef $r;
88 undef $return;
55204971 89 print("\r\n");
90 redo LOOP;
91 }
92 last CASE;
93 };
94
95 # (DEL) || (BS) erase
96 ($_ eq $erase1 || $_ eq $erase2) && do {
97 if($r) {
98 print("\b \b");
99 chop($return);
100 $r--;
101 }
102 last CASE;
103 };
104
105 # printable char
106 ord >= 32 && do {
107 $return .= $_;
108 $r++;
109 print;
110 last CASE;
111 };
112 }
113 }
114 }
115 system('stty -raw echo');
116 print("\n");
a687059c 117 $return;
118}
119
1201;