home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / lib / complete.pl < prev    next >
Text File  |  1999-07-25  |  3KB  |  121 lines
  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;
  121.