Commit | Line | Data |
a0d0e21e |
1 | package Term::Complete; |
2 | require 5.000; |
3 | require Exporter; |
4 | |
5 | @ISA = qw(Exporter); |
6 | @EXPORT = qw(Complete); |
7 | |
8 | # |
9 | # @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91 |
10 | # |
11 | # Author: Wayne Thompson |
12 | # |
13 | # Description: |
14 | # This routine provides word completion. |
15 | # (TAB) attempts word completion. |
16 | # (^D) prints completion list. |
17 | # (These may be changed by setting $Complete::complete, etc.) |
18 | # |
19 | # Diagnostics: |
20 | # Bell when word completion fails. |
21 | # |
22 | # Dependencies: |
23 | # The tty driver is put into raw mode. |
24 | # |
25 | # Bugs: |
26 | # |
27 | # Usage: |
28 | # $input = complete('prompt_string', \@completion_list); |
29 | # or |
30 | # $input = complete('prompt_string', @completion_list); |
31 | # |
32 | |
33 | CONFIG: { |
34 | $complete = "\004"; |
35 | $kill = "\025"; |
36 | $erase1 = "\177"; |
37 | $erase2 = "\010"; |
38 | } |
39 | |
f06db76b |
40 | sub Complete { |
a0d0e21e |
41 | $prompt = shift; |
42 | if (ref $_[0] || $_[0] =~ /^\*/) { |
43 | @cmp_lst = sort @{$_[0]}; |
44 | } |
45 | else { |
46 | @cmp_lst = sort(@_); |
47 | } |
48 | |
49 | system('stty raw -echo'); |
50 | LOOP: { |
51 | print($prompt, $return); |
52 | while (($_ = getc(STDIN)) ne "\r") { |
53 | CASE: { |
54 | # (TAB) attempt completion |
55 | $_ eq "\t" && do { |
56 | @match = grep(/^$return/, @cmp_lst); |
57 | $l = length($test = shift(@match)); |
58 | unless ($#match < 0) { |
59 | foreach $cmp (@match) { |
60 | until (substr($cmp, 0, $l) eq substr($test, 0, $l)) { |
61 | $l--; |
62 | } |
63 | } |
64 | print("\a"); |
65 | } |
66 | print($test = substr($test, $r, $l - $r)); |
67 | $r = length($return .= $test); |
68 | last CASE; |
69 | }; |
70 | |
71 | # (^D) completion list |
72 | $_ eq $complete && do { |
73 | print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n"); |
74 | redo LOOP; |
75 | }; |
76 | |
77 | # (^U) kill |
78 | $_ eq $kill && do { |
79 | if ($r) { |
80 | undef($r, $return); |
81 | print("\r\n"); |
82 | redo LOOP; |
83 | } |
84 | last CASE; |
85 | }; |
86 | |
87 | # (DEL) || (BS) erase |
88 | ($_ eq $erase1 || $_ eq $erase2) && do { |
89 | if($r) { |
90 | print("\b \b"); |
91 | chop($return); |
92 | $r--; |
93 | } |
94 | last CASE; |
95 | }; |
96 | |
97 | # printable char |
98 | ord >= 32 && do { |
99 | $return .= $_; |
100 | $r++; |
101 | print; |
102 | last CASE; |
103 | }; |
104 | } |
105 | } |
106 | } |
107 | system('stty -raw echo'); |
108 | print("\n"); |
109 | $return; |
110 | } |
111 | |
112 | 1; |
113 | |