Merge branch 'master' of http://repo.or.cz/r/msysgit into devel
[msysgit/historical-msysgit.git] / lib / perl5 / 5.6.1 / complete.pl
blob925ce86e5da266f79389c66562613031ea609959
1 ;#
3 # This library is no longer being maintained, and is included for backward
4 # compatibility with Perl 4 programs which may require it.
6 # In particular, this should not be used as an example of modern Perl
7 # programming techniques.
9 # Suggested alternative: Term::Complete
11 ;# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91
13 ;# Author: Wayne Thompson
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.)
21 ;# Diagnostics:
22 ;# Bell when word completion fails.
24 ;# Dependencies:
25 ;# The tty driver is put into raw mode.
27 ;# Bugs:
29 ;# Usage:
30 ;# $input = &Complete('prompt_string', *completion_list);
31 ;# or
32 ;# $input = &Complete('prompt_string', @completion_list);
35 CONFIG: {
36 package Complete;
38 $complete = "\004";
39 $kill = "\025";
40 $erase1 = "\177";
41 $erase2 = "\010";
44 sub Complete {
45 package Complete;
47 local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
48 if ($_[1] =~ /^StB\0/) {
49 ($prompt, *_) = @_;
51 else {
52 $prompt = shift(@_);
54 @cmp_lst = sort(@_);
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--;
71 print("\a");
73 print($test = substr($test, $r, $l - $r));
74 $r = length($return .= $test);
75 last CASE;
78 # (^D) completion list
79 $_ eq $complete && do {
80 print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
81 redo LOOP;
84 # (^U) kill
85 $_ eq $kill && do {
86 if ($r) {
87 undef $r;
88 undef $return;
89 print("\r\n");
90 redo LOOP;
92 last CASE;
95 # (DEL) || (BS) erase
96 ($_ eq $erase1 || $_ eq $erase2) && do {
97 if($r) {
98 print("\b \b");
99 chop($return);
100 $r--;
102 last CASE;
105 # printable char
106 ord >= 32 && do {
107 $return .= $_;
108 $r++;
109 print;
110 last CASE;
115 system('stty -raw echo');
116 print("\n");
117 $return;