source: perl/lib/BarnOwl/Completion/Util.pm @ da554da

release-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since da554da was 69c27e6, checked in by David Benjamin <davidben@mit.edu>, 15 years ago
Don't suggest repeated flags in complete_flags For most commands, it doesn't make sense to provide an option twice, so we avoid offering it again as a completion. Note: if the user happened to pass the flag again, we'll still attempt to complete it. To disable, use the repeat_flags keyword option. Tests update, with complete_zwrite testing non-repeating and complete_word testing the old behavior. Signed-off-by: David Benjamin <davidben@mit.edu>
  • Property mode set to 100644
File size: 1.6 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Completion::Util;
5
6use base qw(Exporter);
7our @EXPORT_OK = qw(complete_flags);
8
9use Getopt::Long;
10
11sub complete_flags {
12    my $ctx     = shift;
13    my $no_args = shift;
14    my $args    = shift;
15    my $default = shift;
16
17    my %options = ();
18    %options = @_ if @_;
19
20    my $idx = 1;
21    my $flag = undef;
22
23    my $argct = 0;
24    my $optsdone = 0;
25
26    my %flags_seen;
27
28    while($idx < $ctx->word) {
29        my $word = $ctx->words->[$idx];
30        if($flag) {
31            undef $flag;
32        } elsif($word =~ m{^--}) {
33            if($word eq '--') {
34                $optsdone = 1;
35                $idx++;
36                last;
37            }
38            $flag = $word if(exists $args->{$word});
39        } elsif ($word =~ m{^-}) {
40            $word = "-" . substr($word, -1);
41            $flags_seen{$word} = 1; # record flag
42            $flag = $word if(exists $args->{$word});
43        } else {
44            $argct++;
45            if ($options{stop_at_nonflag}) {
46                $optsdone = 1;
47                $idx++;
48                last;
49            }
50        }
51        $idx++;
52    }
53    # Account for any words we skipped
54    $argct += $ctx->word - $idx;
55
56    if($flag) {
57        my $c = $args->{$flag};
58        if($c) {
59            return $c->($ctx);
60        }
61        return;
62    } else {
63        my @opts = $optsdone ? () : (@$no_args, keys %$args);
64        # filter out flags we've seen if needbe
65        @opts = grep {!$flags_seen{$_}} @opts unless $options{repeat_flags};
66        return (@opts, $default ? ($default->($ctx, $argct)) : ());
67    }
68}
Note: See TracBrowser for help on using the repository browser.