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 ;#      (These may be changed by setting $Complete'complete, etc.)
  11 ;#
  12 ;# Diagnostics:
  13 ;#     Bell when word completion fails.
  14 ;#
  15 ;# Dependencies:
  16 ;#     The tty driver is put into raw mode.
  17 ;#
  18 ;# Bugs:
  19 ;#
  20 ;# Usage:
  21 ;#     $input = do Complete('prompt_string', @completion_list);
  22 ;#
  23
  24 CONFIG: {
  25     package Complete;
  26
  27     $complete = "\004";
  28     $kill =     "\025";
  29     $erase1 =   "\177";
  30     $erase2 =   "\010";
  31 }
  32
  33 sub Complete {
  34     package Complete;
  35
  36     local ($prompt) = shift (@_);
  37     local ($c, $cmp, $l, $r, $ret, $return, $test);
  38     @_cmp_lst = sort @_;
  39     local($[) = 0;
  40     system 'stty raw -echo';
  41     loop: {
  42         print $prompt, $return;
  43         while (($c = getc(stdin)) ne "\r") {
  44             if ($c eq "\t") {                   # (TAB) attempt completion
  45                 @_match = ();
  46                 foreach $cmp (@_cmp_lst) {
  47                     push (@_match, $cmp) if $cmp =~ /^$return/;
  48                 }
  49                 $test = $_match[0];
  50                 $l = length ($test);
  51                 unless ($#_match == 0) {
  52                     shift (@_match);
  53                     foreach $cmp (@_match) {
  54                         until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) {
  55                             $l--;
  56                         }
  57                     }
  58                     print "\007";
  59                 }
  60                 print $test = substr ($test, $r, $l - $r);
  61                 $r = length ($return .= $test);
  62             }
  63             elsif ($c eq $complete) {           # (^D) completion list
  64                 print "\r\n";
  65                 foreach $cmp (@_cmp_lst) {
  66                     print "$cmp\r\n" if $cmp =~ /^$return/;
  67                 }
  68                 redo loop;
  69             }
  70             elsif ($c eq $kill && $r) { # (^U) kill
  71                 $return = '';
  72                 $r = 0;
  73                 print "\r\n";
  74                 redo loop;
  75             }
  76                                                 # (DEL) || (BS) erase
  77             elsif ($c eq $erase1 || $c eq $erase2) {
  78                 if($r) {
  79                     print "\b \b";
  80                     chop ($return);
  81                     $r--;
  82                 }
  83             }
  84             elsif ($c =~ /\S/) {                # printable char
  85                 $return .= $c;
  86                 $r++;
  87                 print $c;
  88             }
  89         }
  90     }
  91     system 'stty -raw echo';
  92     print "\n";
  93     $return;
  94 }
  95
  96 1;