This queue is for tickets about the IO-Prompt CPAN distribution.

Report information
The Basics
Id:
21055
Status:
new
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
ROBN [...] cpan.org
Cc:
AdminCc:

BugTracker
Severity:
Wishlist
Broken in:
(no value)
Fixed in:
v0.99.4

Attachments


Subject: [PATCH] Tab completion
MIME-Version: 1.0
X-Mailer: MIME-tools 5.418 (Entity 5.418)
X-RT-Original-Encoding: utf-8
Content-Type: multipart/mixed; boundary="----------=_1155855182-16559-12"
Content-Length: 0
Content-Type: text/plain; charset="utf8"
Content-Disposition: inline
Content-Transfer-Encoding: binary
Content-Length: 235
Hi Damian, Here's a patch that adds tab completion to IO-Prompt. The docs suck, but the code works and I'm pretty sure the example covers enough. Got a timeframe for the next release? And/or do you need a maintainer? :P Cheers, Rob.
Subject: completion.pl
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="----------=_1155855081-16598-14"
X-Mailer: MIME-tools 5.418 (Entity 5.418)
Content-Length: 0
Content-Type: text/plain; charset="utf8"
Content-Disposition: inline
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: utf-8
Content-Length: 0
Content-Type: application/octet-stream; name="completion.pl"
Content-Disposition: inline; filename="completion.pl"
Content-Transfer-Encoding: base64
Content-Length: 0
MIME-Version: 1.0
X-Mailer: MIME-tools 5.418 (Entity 5.418)
Message-Id: <rt-3.6.HEAD-16580-1155855281-1373.21055-0-0@rt.cpan.org>
Content-Type: multipart/mixed; boundary="----------=_1155855281-16580-16"
X-RT-Original-Encoding: utf-8
Content-Length: 0
Content-Disposition: inline
Content-Type: text/plain; charset="utf8"
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: utf-8
Content-Length: 26
Sigh. Lets try that again.
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="----------=_1155855260-16595-12"
X-Mailer: MIME-tools 5.418 (Entity 5.418)
Content-Length: 0
Content-Type: text/plain; charset="utf8"
Content-Disposition: inline
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: utf-8
X-RT-Original-Encoding: utf-8
Content-Length: 0
Content-Type: text/plain; charset="utf-8"; name="completion.diff"
Content-Disposition: inline; filename="completion.diff"
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: ascii
X-RT-Original-Encoding: utf-8
Content-Length: 13435
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


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.