home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / complete.pl < prev    next >
Text File  |  1997-05-19  |  3KB  |  114 lines
  1. ;#
  2. ;#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
  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 = &Complete('prompt_string', *completion_list);
  22. ;#         or
  23. ;#     $input = &Complete('prompt_string', @completion_list);
  24. ;#
  25.  
  26. CONFIG: {
  27.     package Complete;
  28.  
  29.     $complete = "\004";
  30.     $kill     = "\025";
  31.     $erase1 =   "\177";
  32.     $erase2 =   "\010";
  33.     $eol    = ($^O eq 'MacOS' ? "\n" : "\r");
  34.     $nl     = ($^O eq 'MacOS' ? "\n" : "\r\n");
  35. }
  36.  
  37. sub Complete {
  38.     package Complete;
  39.  
  40.     local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
  41.     if ($_[1] =~ /^StB\0/) {
  42.         ($prompt, *_) = @_;
  43.     }
  44.     else {
  45.         $prompt = shift(@_);
  46.     }
  47.     @cmp_lst = sort(@_);
  48.  
  49.     system('stty raw -echo');
  50.     LOOP: {
  51.         print($prompt, $return);
  52.         while (($_ = getc(STDIN)) ne $eol) {
  53.             CASE: {
  54.                 # (TAB) attempt completion
  55.                 $_ eq "\t" && do {
  56.                     @match = grep(/^$return/, @cmp_lst);
  57.                     $l = length($test = shift(@match));
  58.                     unless ($#match < 0) {
  59.                         foreach $cmp (@match) {
  60.                             until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
  61.                                 $l--;
  62.                             }
  63.                         }
  64.                         print("\a");
  65.                     }
  66.                     print($test = substr($test, $r, $l - $r));
  67.                     $r = length($return .= $test);
  68.                     last CASE;
  69.                 };
  70.  
  71.                 # (^D) completion list
  72.                 $_ eq $complete && do {
  73.                     print(join($nl, '', grep(/^$return/, @cmp_lst)), $nl);
  74.                     redo LOOP;
  75.                 };
  76.  
  77.                 # (^U) kill
  78.                 $_ eq $kill && do {
  79.                     if ($r) {
  80.                         undef $r;
  81.             undef $return;
  82.                         print($nl);
  83.                         redo LOOP;
  84.                     }
  85.                     last CASE;
  86.                 };
  87.  
  88.                 # (DEL) || (BS) erase
  89.                 ($_ eq $erase1 || $_ eq $erase2) && do {
  90.                     if($r) {
  91.                         print("\b \b");
  92.                         chop($return);
  93.                         $r--;
  94.                     }
  95.                     last CASE;
  96.                 };
  97.  
  98.                 # printable char
  99.                 ord >= 32 && do {
  100.                     $return .= $_;
  101.                     $r++;
  102.                     print;
  103.                     last CASE;
  104.                 };
  105.             }
  106.         }
  107.     }
  108.     system('stty -raw echo');
  109.     print("\n");
  110.     $return;
  111. }
  112.  
  113. 1;
  114.