home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / PERL30X.ZIP / COMPLETE.PL < prev    next >
Text File  |  1991-01-14  |  2KB  |  86 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. ;#
  11. ;# Diagnostics:
  12. ;#     Bell when word completion fails.
  13. ;#
  14. ;# Dependencies:
  15. ;#     The tty driver is put into raw mode.
  16. ;#
  17. ;# Bugs:
  18. ;#     The erase and kill characters are hard coded.
  19. ;#
  20. ;# Usage:
  21. ;#     $input = do Complete('prompt_string', @completion_list);
  22. ;#
  23.  
  24. sub Complete {
  25.     local ($prompt) = shift (@_);
  26.     local ($c, $cmp, $l, $r, $ret, $return, $test);
  27.     @_cmp_lst = sort @_;
  28.     local($[) = 0;
  29.     system 'stty raw -echo';
  30.     loop: {
  31.     print $prompt, $return;
  32.     while (($c = getc(stdin)) ne "\r") {
  33.         if ($c eq "\t") {            # (TAB) attempt completion
  34.         @_match = ();
  35.         foreach $cmp (@_cmp_lst) {
  36.             push (@_match, $cmp) if $cmp =~ /^$return/;
  37.         }
  38.                 $test = $_match[0];
  39.                 $l = length ($test);
  40.         unless ($#_match == 0) {
  41.                     shift (@_match);
  42.                     foreach $cmp (@_match) {
  43.                         until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) {
  44.                             $l--;
  45.                         }
  46.                     }
  47.                     print "\007";
  48.                 }
  49.                 print $test = substr ($test, $r, $l - $r);
  50.                 $r = length ($return .= $test);
  51.         }
  52.         elsif ($c eq "\004") {        # (^D) completion list
  53.         print "\r\n";
  54.         foreach $cmp (@_cmp_lst) {
  55.             print "$cmp\r\n" if $cmp =~ /^$return/;
  56.         }
  57.         redo loop;
  58.         }
  59.             elsif ($c eq "\025" && $r) {    # (^U) kill
  60.                 $return = '';
  61.                 $r = 0;
  62.                 print "\r\n";
  63.                 redo loop;
  64.             }
  65.                                             # (DEL) || (BS) erase
  66.         elsif ($c eq "\177" || $c eq "\010") {
  67.         if($r) {
  68.             print "\b \b";
  69.             chop ($return);
  70.             $r--;
  71.         }
  72.         }
  73.         elsif ($c =~ /\S/) {                # printable char
  74.         $return .= $c;
  75.         $r++;
  76.         print $c;
  77.         }
  78.     }
  79.     }
  80.     system 'stty -raw echo';
  81.     print "\n";
  82.     $return;
  83. }
  84.  
  85. 1;
  86.