[DOC PATCH] Carp.pm pod typo
[p5sagit/p5-mst-13.2.git] / lib / Term / Complete.pm
CommitLineData
a0d0e21e 1package Term::Complete;
2require 5.000;
3require Exporter;
4
b75c8c73 5use strict;
6our @ISA = qw(Exporter);
7our @EXPORT = qw(Complete);
c680dfd8 8our $VERSION = '1.3';
a0d0e21e 9
df4a00a5 10# @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91
cb1a09d0 11
12=head1 NAME
13
14Term::Complete - Perl word completion module
15
16=head1 SYNOPSIS
17
2ab1b485 18 $input = Complete('prompt_string', \@completion_list);
19 $input = Complete('prompt_string', @completion_list);
cb1a09d0 20
21=head1 DESCRIPTION
22
23This routine provides word completion on the list of words in
24the array (or array ref).
25
c680dfd8 26The tty driver is put into raw mode and restored using an operating
27system specific command, in UNIX-like environments C<stty raw -echo>
28and C<stty -raw echo>.
cb1a09d0 29
30The following command characters are defined:
31
32=over 4
33
1fef88e7 34=item E<lt>tabE<gt>
3fe9a6f1 35
cb1a09d0 36Attempts word completion.
37Cannot be changed.
38
39=item ^D
40
41Prints completion list.
42Defined by I<$Term::Complete::complete>.
43
44=item ^U
45
46Erases the current input.
47Defined by I<$Term::Complete::kill>.
48
1fef88e7 49=item E<lt>delE<gt>, E<lt>bsE<gt>
cb1a09d0 50
51Erases one character.
52Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.
53
54=back
55
56=head1 DIAGNOSTICS
57
58Bell sounds when word completion fails.
59
60=head1 BUGS
61
8dcee03e 62The completion character E<lt>tabE<gt> cannot be changed.
cb1a09d0 63
64=head1 AUTHOR
65
66Wayne Thompson
67
68=cut
a0d0e21e 69
c680dfd8 70our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore);
a0d0e21e 71CONFIG: {
72 $complete = "\004";
73 $kill = "\025";
74 $erase1 = "\177";
75 $erase2 = "\010";
c680dfd8 76 foreach my $stty (qw(/bin/stty /usr/bin/stty)) {
77 if (-x $stty) {
78 $tty_raw_noecho = "$stty raw -echo";
79 $tty_restore = "$stty -raw echo";
80 last;
81 }
82 }
a0d0e21e 83}
84
f06db76b 85sub Complete {
b75c8c73 86 my($prompt, @cmp_lst, $cmp, $test, $l, @match);
df4a00a5 87 my ($return, $r) = ("", 0);
55497cff 88
2ab1b485 89 $return = "";
90 $r = 0;
91
a0d0e21e 92 $prompt = shift;
93 if (ref $_[0] || $_[0] =~ /^\*/) {
94 @cmp_lst = sort @{$_[0]};
95 }
96 else {
97 @cmp_lst = sort(@_);
98 }
99
c680dfd8 100 system $tty_raw_noecho if defined $tty_raw_noecho;
a0d0e21e 101 LOOP: {
102 print($prompt, $return);
103 while (($_ = getc(STDIN)) ne "\r") {
104 CASE: {
105 # (TAB) attempt completion
106 $_ eq "\t" && do {
107 @match = grep(/^$return/, @cmp_lst);
a0d0e21e 108 unless ($#match < 0) {
df4a00a5 109 $l = length($test = shift(@match));
a0d0e21e 110 foreach $cmp (@match) {
111 until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
112 $l--;
113 }
114 }
115 print("\a");
df4a00a5 116 print($test = substr($test, $r, $l - $r));
117 $r = length($return .= $test);
a0d0e21e 118 }
a0d0e21e 119 last CASE;
120 };
121
122 # (^D) completion list
123 $_ eq $complete && do {
124 print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
125 redo LOOP;
126 };
127
128 # (^U) kill
129 $_ eq $kill && do {
130 if ($r) {
2ab1b485 131 $r = 0;
132 $return = "";
a0d0e21e 133 print("\r\n");
134 redo LOOP;
135 }
136 last CASE;
137 };
138
139 # (DEL) || (BS) erase
140 ($_ eq $erase1 || $_ eq $erase2) && do {
141 if($r) {
142 print("\b \b");
143 chop($return);
144 $r--;
145 }
146 last CASE;
147 };
148
149 # printable char
150 ord >= 32 && do {
151 $return .= $_;
152 $r++;
153 print;
154 last CASE;
155 };
156 }
157 }
158 }
c680dfd8 159 system $tty_restore if defined $tty_restore;
a0d0e21e 160 print("\n");
161 $return;
162}
163
1641;
165