| 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); |
| 27 | @_cmp_lst = sort @_; |
| 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 = (); |
| 34 | foreach $cmp (@_cmp_lst) { |
| 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"; |
| 53 | foreach $cmp (@_cmp_lst) { |
| 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; |