home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / perl / complete.pl < prev    next >
Text File  |  1991-04-12  |  2KB  |  97 lines
  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;
  97.