1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
;#
;# @(#)complete.pl 1.0 (sun!waynet) 11/11/88
;#
;# 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 = do Complete('prompt_string', @completion_list);
;#
CONFIG: {
package Complete;
$complete = "\004";
$kill = "\025";
$erase1 = "\177";
$erase2 = "\010";
}
sub Complete {
package Complete;
local ($prompt) = shift (@_);
local ($c, $cmp, $l, $r, $ret, $return, $test);
@_cmp_lst = sort @_;
local($[) = 0;
system 'stty raw -echo';
loop: {
print $prompt, $return;
while (($c = getc(stdin)) ne "\r") {
if ($c eq "\t") { # (TAB) attempt completion
@_match = ();
foreach $cmp (@_cmp_lst) {
push (@_match, $cmp) if $cmp =~ /^$return/;
}
$test = $_match[0];
$l = length ($test);
unless ($#_match == 0) {
shift (@_match);
foreach $cmp (@_match) {
until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) {
$l--;
}
}
print "\007";
}
print $test = substr ($test, $r, $l - $r);
$r = length ($return .= $test);
}
elsif ($c eq $complete) { # (^D) completion list
print "\r\n";
foreach $cmp (@_cmp_lst) {
print "$cmp\r\n" if $cmp =~ /^$return/;
}
redo loop;
}
elsif ($c eq $kill && $r) { # (^U) kill
$return = '';
$r = 0;
print "\r\n";
redo loop;
}
# (DEL) || (BS) erase
elsif ($c eq $erase1 || $c eq $erase2) {
if($r) {
print "\b \b";
chop ($return);
$r--;
}
}
elsif ($c =~ /\S/) { # printable char
$return .= $c;
$r++;
print $c;
}
}
}
system 'stty -raw echo';
print "\n";
$return;
}
1;
|
