[Summary view] [Print] [Text view]

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