diff -N -U3 -r IO-Prompt-v0.99.4/examples/completion.pl IO-Prompt-completion/examples/completion.pl
--- IO-Prompt-v0.99.4/examples/completion.pl 1970-01-01 10:00:00.000000000 +1000
+++ IO-Prompt-completion/examples/completion.pl 2006-08-17 22:56:18.000000000 +1000
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use IO::Prompt;
+
+my @fruit = qw(apple apricot banana kumquat guava grape pear);
+my $fruit_re_str = '^'.join('|', @fruit).'$';
+my $fruit_re = qr/$fruit_re_str/;
+
+# Example of completion. First, basic operation from a simple array
+
+while (prompt "fruit: ", -complete => \@fruit,
+ -until => $fruit_re) {
+ print "Not a fruit!\n";
+}
+
+# Can add options like so:
+
+while (prompt "another fruit: ", -complete => [ -bell, -show, \@fruit ],
+ -until => $fruit_re) {
+ print "Not a fruit!\n";
+}
+
+
+# Use a callback to provide different completion based on user class
+
+my %commands = (
+ anonymous => [qw(read)],
+ user => [qw(read post)],
+ admin => [qw(read post delete)],
+);
+
+for my $user_class (keys %commands) {
+ prompt "[$user_class] command> ",
+ -complete => [ -bell, -show,
+ sub { @{$commands{$user_class}} } ];
+}
+
+
+# Using -split to do file selection
+
+sub complete_file {
+ my ($input, $has_lead_slash, $has_trail_slash, @path) = @_;
+
+ my ($file, $dir);
+ $file = pop @path if @path > 0 and not $has_trail_slash;
+ $dir = (($has_lead_slash ? "/" : "") . join '/', @path) || ".";
+
+ opendir my ($dh), $dir;
+ my @files = map { -d "$dir/$_" ? "$_/" : $_ } readdir $dh;
+ closedir $dh;
+
+ return @files;
+}
+
+my $file = prompt "file: ", -complete => [ -bell, -show,
+ \&complete_file,
+ -split => qr{/+} ];
+print "file: $file\n";
diff -N -U3 -r IO-Prompt-v0.99.4/lib/IO/Prompt.pm IO-Prompt-completion/lib/IO/Prompt.pm
--- IO-Prompt-v0.99.4/lib/IO/Prompt.pm 2006-02-17 15:59:21.000000000 +1100
+++ IO-Prompt-completion/lib/IO/Prompt.pm 2006-08-18 08:48:25.000000000 +1000
@@ -29,15 +29,16 @@
}
our %flags_arg = (
- p => 'prompt',
- s => 'speed',
- e => 'echo',
- r => 'require',
- d => 'default',
- u => 'until',
- w => 'while',
- nl => 'newline',
- m => 'menu',
+ p => 'prompt',
+ s => 'speed',
+ e => 'echo',
+ r => 'require',
+ d => 'default',
+ u => 'until',
+ w => 'while',
+ nl => 'newline',
+ m => 'menu',
+ com => 'complete',
);
our %flags_alias = (
@@ -144,6 +145,45 @@
: qr/^\Q$_\E$/
for @{$flags}{qw(-while -until -failif -okayif)};
+ if (exists $flags->{-complete}) {
+ my $args = $flags->{-complete};
+ croak "Argument to -complete must be array or code reference"
+ unless ref $args eq 'ARRAY' or ref $args eq 'CODE';
+ $args = [ $args ] if ref $args ne 'ARRAY';
+
+ my %stuff = ();
+ for (my $i = 0; $i < @$args; $i++) {
+ my $arg = $args->[$i];
+ if ($arg =~ /^-show/) {
+ $stuff{show} = 1;
+ }
+ elsif ($arg =~ /^-bell/) {
+ $stuff{bell} = 1;
+ }
+ elsif ($arg =~ /^-split/) {
+ my $val = $args->[$i+1];
+ croak "Missing argument for -split completion option" if not defined $val;
+ $val = qr/\Q$_\E/ if ref $val ne "Regexp";
+ $stuff{split} = $val;
+ $i++;
+ }
+ elsif (ref $arg eq 'CODE') {
+ $stuff{callback} = $arg;
+ }
+ elsif (ref $arg eq 'ARRAY') {
+ push @$args, @$arg;
+ }
+ elsif (ref $arg eq 'HASH') {
+ push @$args, %$arg;
+ }
+ else {
+ push @{$stuff{list}}, $arg;
+ }
+ }
+
+ $flags->{-complete} = \%stuff;
+ }
+
for (grep { defined } $flags->{ -require }) {
croak "Argument to -require must be hash reference"
unless ref eq 'HASH';
@@ -406,6 +446,11 @@
INPUT: while (1) {
my $next = getc $IN;
+
+ if ($flags->{-complete} and $next ne "\t") {
+ delete $flags->{-complete}{firsttab};
+ }
+
if ($next eq $cntl{INTERRUPT}) {
ReadMode 'restore', $IN;
exit;
@@ -425,6 +470,10 @@
print {$OUT} "<esc>";
return "\e";
}
+ elsif ($flags->{-complete} && $next eq "\t") {
+ $input = _do_complete($input, $flags->{-complete}, $IN, $OUT, @prompt);
+ next;
+ }
elsif ($next !~ /$cntl/ && defined $next) {
$input .= $next;
if ($next eq "\n") {
@@ -465,6 +514,162 @@
}
}
+sub _do_complete {
+ my ($input, $flags, $IN, $OUT, @prompt) = @_;
+
+ # we're always splitting, even if we're not. in that case, then we
+ # pretend we have one argument with no leading or trailing delimeter
+ my $split_re = exists $flags->{split} ? $flags->{split} : 0;
+ my ($split_lead, $split_trail, @split);
+ if ($split_re) {
+ my $copy = $input;
+ $copy =~ s/^$split_re?(.*)$split_re$/$1/;
+ @split = split $split_re, $copy;
+ $split_lead = 1 if $input =~ m/^$split_re/;
+ $split_trail = 1 if $input =~ m/$split_re$/;
+ }
+ elsif ($input) {
+ @split = ($input);
+ }
+
+ # get the list of possible completions at this point, both from the
+ # passed-in list, and from the callback
+ my %list;
+ if (exists $flags->{list}) {
+ $list{$_} = 1 for @{$flags->{list}};
+ }
+ if (exists $flags->{callback}) {
+ if ($split_re) {
+ $list{$_} = 1 for $flags->{callback}->($input,
+ $split_lead, $split_trail,
+ @split);
+ }
+ else {
+ $list{$_} = 1 for $flags->{callback}->($input);
+ }
+ }
+
+ # this is our equivalent of $input
+ my $fragment = $split_trail ? ""
+ : @split > 0 ? $split[-1]
+ : "";
+
+ # whittle away at the valid options until we get a set that are
+ # valid candidates for completion. if they haven't typed anything,
+ # then anything goes
+ my @matches;
+ if ($fragment) {
+ @matches = grep { m/^$fragment/ } keys %list;
+ }
+ else {
+ @matches = keys %list;
+ }
+
+ # if there's no matches, then we're done here
+ if (@matches == 0) {
+ print ${OUT} "\a" if exists $flags->{bell};
+ return $input;
+ }
+
+ # one match, completion are go!
+ if (@matches == 1) {
+ if ($fragment eq $matches[0]) {
+ print ${OUT} "\a" if exists $flags->{bell};
+ return $input;
+ }
+
+ # replace the fragment in the input proper with the match
+ substr $input,
+ length($input) - length($fragment),
+ length $fragment,
+ $matches[0];
+
+ print ${OUT} "\b \b" for (1 .. length $fragment);
+ print ${OUT} $matches[0];
+
+ return $input;
+ }
+
+ # otherwise, we've got multiples. we start off by looking weeding
+ # out any common stems in the matches
+ my @chunks = @matches;
+ substr $_, 0, length $fragment, "" for @chunks;
+
+ my $chunk = "";
+ while (1) {
+ my $char = substr $chunks[0], 0, 1;
+ last if not $char;
+ my $same = 0;
+ for (@chunks) {
+ my $first = substr $_, 0, 1, "";
+ $same++ if $first eq $char;
+ }
+ last if $same != @chunks;
+ $chunk .= $char;
+ }
+ if ($chunk) {
+ $input .= $chunk;
+ print ${OUT} $chunk;
+ return $input;
+ }
+
+ # at least one multiple without a commonality
+
+ # if we're not displaying, then just beep and get out of here
+ if (not exists $flags->{show}) {
+ print ${OUT} "\a" if exists $flags->{bell};
+ return $input;
+ }
+
+ # have to tab twice to get a list (like bash)
+ if (not exists $flags->{firsttab}) {
+ print ${OUT} "\a" if exists $flags->{bell};
+ $flags->{firsttab} = 1;
+ return $input;
+ }
+ delete $flags->{firsttab};
+
+ # figure out column widths
+ my $max = 0;
+ map { $max = length if length > $max } @matches;
+ my $cols = int(80/($max));
+ my $format = "%-".($max+2)."s";
+
+ # if its going to go over 20 lines, ask before spamming them
+ if (@matches / $cols >= 20) {
+ print ${OUT} "\n";
+ my $doshow = prompt "Display all ".scalar @matches. " matches? ", -yn1;
+ ReadMode 'raw', $IN;
+ if (!$doshow) {
+ print ${OUT} @prompt;
+ print ${OUT} $input if $input;
+ return $input;
+ }
+ }
+ else {
+ print ${OUT} "\n";
+ }
+
+ # assemble the columns
+ my $list = "";
+ my $ncols = 0;
+ for (sort @matches) {
+ $list .= sprintf $format, $_;
+ $ncols++;
+ if ($ncols == $cols) {
+ $list .= "\n";
+ $ncols = 0;
+ }
+ }
+ $list .= "\n" if $ncols > 0;
+
+ # and print
+ print ${OUT} $list, @prompt;
+ print ${OUT} $input if $input;
+
+ return $input;
+}
+
sub _yesno {
my ($IN, $OUT, $flags, @prompt) = @_;
my ($yes, $no, $yesprompt, $noprompt) =
@@ -725,6 +930,8 @@
-num -number Accept only valid numbers as input
-i -integer Accept only valid integers as input
+ -com -complete <list|code> Enable tab completion
+
Note that the underscores between words in flags like C<-one_char> and
C<-yes_no> are optional.
@@ -745,7 +952,77 @@
string. It prints the prompt and retreives the input. You almost
certainly want to use C<prompt()> instead.
+=head2 Tab completion
+
+The C<-complete> option allows you to get shell-style tab completion. There's a
+number of ways it can be used.
+
+First, you can pass a simple list of values. These will be matched against the
+current input and one chosen (or part of one, if there are several matches):
+
+ prompt "fruit: ", -complete => [ "apple", "orange", "pear" ];
+
+Alternatively, you can pass a code reference. It will be called each time tab
+is pressed, with the current input as the first argument. It is expected to
+return a list of possible values. The following is equivalent to the array
+example presented above:
+
+ sub complete_fruit {
+ my ($input) = @_;
+ return qw(apple orange pear);
+ }
+
+ prompt "fruit: ", -complete => \&complete_fruit;
+
+This coderef can be used to modify possible completions based on the current
+input.
+
+There's also a number of options you can use to modify the behaviour of the
+completion mechanism. These are specified as flags within the array given to
+C<-complete>:
+
+ prompt "fruit: ", -complete => [ -bell, -show, "apple", "orange", "pear" ];
+
+ prompt "fruit: ", -complete => [ -bell, -show, \&complete_fruit ];
+
+The following options are available:
+
+=over
+
+=item C<-bell>
+
+Causes a bell character (ASCII code 7) to be "displayed" when no or a partial
+completion is possible (ie in the case of multiple matches). This usually
+results in an audible tone or other visual cue that something odd has happened.
+
+=item C<-show>
+
+If during completion there are multiple matches, this will cause them to be
+displayed by pressing tab again. If there are so many matches that displaying
+them would cause your terminal to scroll, you'll be told how many there are and
+asked if you want to display them all.
+
+=item C<-split>
+
+This option is used in conjunction with the callback to allow quite advanced
+completions, eg for file selection. C<-split> takes a regular expression as an
+argument. This regex should match the delimeter between "fragments" of the
+input; eg whitespace for commands and arguments, or slashes for file paths.
+
+When enabled, the callback receives extra arguments in addition to the current
+input. The second and third arguments are flags indicating if the regex
+matches the start or end of the input.
+
+After that follows one or more arguments that are the result of a call to
+C<split> with the regex as the first argument.
+
+When using C<-split>, the callback is expected to return an list of possible
+values for the current fragment.
+=back
+
+Alot of this is difficult to explain; see C<examples/completion.pl> for a taste
+of what's possible.
=head1 DIAGNOSTICS
@@ -806,6 +1083,21 @@
A menu can't have fewer than 1 or more than 26 items.
+=item C<< Argument to -complete must be array or code reference >>
+
+The C<-complete> option requires an argument that is either an array:
+
+ prompt -complete => [ "apple", "orange", "pear" ];
+
+or a code reference:
+
+ prompt -complete => \&complete;
+
+=item C<< Missing argument for -split completion option >>
+
+The C<-split> option to C<-complete> requires a regex as an argument. This
+regex is used to specify the split delimeter.
+
=back
@@ -865,6 +1157,8 @@
Damian Conway C<< <DCONWAY@cpan.org> >>
+Tab completion by Robert Norris C<< <rob@cataclysm.cx> >>
+
=head1 LICENCE AND COPYRIGHT
