Commit | Line | Data |
---|---|---|
a687059c LW |
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 | ||
24 | sub Complete { | |
25 | local ($prompt) = shift (@_); | |
26 | local ($c, $cmp, $l, $r, $ret, $return, $test); | |
d8f2e4cc | 27 | @_cmp_lst = sort @_; |
a687059c LW |
28 | system 'stty raw -echo'; |
29 | loop: { | |
30 | print $prompt, $return; | |
31 | while (($c = getc(stdin)) ne "\r") { | |
32 | if ($c eq "\t") { # (TAB) attempt completion | |
33 | @_match = (); | |
d8f2e4cc | 34 | foreach $cmp (@_cmp_lst) { |
a687059c LW |
35 | push (@_match, $cmp) if $cmp =~ /^$return/; |
36 | } | |
37 | $test = $_match[0]; | |
38 | $l = length ($test); | |
39 | unless ($#_match == 0) { | |
40 | shift (@_match); | |
41 | foreach $cmp (@_match) { | |
42 | until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) { | |
43 | $l--; | |
44 | } | |
45 | } | |
46 | print "\007"; | |
47 | } | |
48 | print $test = substr ($test, $r, $l - $r); | |
49 | $r = length ($return .= $test); | |
50 | } | |
51 | elsif ($c eq "\004") { # (^D) completion list | |
52 | print "\r\n"; | |
d8f2e4cc | 53 | foreach $cmp (@_cmp_lst) { |
a687059c LW |
54 | print "$cmp\r\n" if $cmp =~ /^$return/; |
55 | } | |
56 | redo loop; | |
57 | } | |
58 | elsif ($c eq "\025" && $r) { # (^U) kill | |
59 | $return = ''; | |
60 | $r = 0; | |
61 | print "\r\n"; | |
62 | redo loop; | |
63 | } | |
64 | # (DEL) || (BS) erase | |
65 | elsif ($c eq "\177" || $c eq "\010") { | |
66 | if($r) { | |
67 | print "\b \b"; | |
68 | chop ($return); | |
69 | $r--; | |
70 | } | |
71 | } | |
72 | elsif ($c =~ /\S/) { # printable char | |
73 | $return .= $c; | |
74 | $r++; | |
75 | print $c; | |
76 | } | |
77 | } | |
78 | } | |
79 | system 'stty -raw echo'; | |
80 | print "\n"; | |
81 | $return; | |
82 | } | |
83 | ||
84 | 1; |