lib/complete.pl

   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;