Changes in / [340c3e7:8830f79f]


Ignore:
Files:
2 added
9 edited

Legend:

Unmodified
Added
Removed

  • .gitignore

    rb9c8d28 r42ad917  
    2828owl_prototypes.h
    2929owl_prototypes.h.new
     30perl_tester
    3031perlglue.c
    3132perlwrap.c

  • Makefile.am

    reddee7e r42ad917  
    22
    33bin_PROGRAMS = barnowl.bin
    4 check_PROGRAMS = tester
     4check_PROGRAMS = tester perl_tester
    55
    66barnowl_bin_SOURCES = $(BASE_SRCS) \
    … …  
    1717
    1818tester_LDADD = libfaim/libfaim.a
     19
     20perl_tester_SOURCES = $(BASE_SRCS) \
     21     owl.h owl_perl.h config.h \
     22     libzcrypt.a \
     23     $(GEN_C) $(GEN_H) \
     24     perl_tester.c
     25
     26perl_tester_LDADD = libfaim/libfaim.a libzcrypt.a
    1927
    2028TESTS=runtests.sh

  • perl/lib/BarnOwl/Complete/Client.pm

    rd5ccf4e8 ra3a9eb7  
    77
    88use BarnOwl::Completion::Util qw(complete_flags);
     9use BarnOwl::Complete::Filter qw(complete_filter_name complete_filter_expr);
    910
    1011my @all_colors = qw(default
    … …  
    4243sub complete_command { return sort @BarnOwl::all_commands; }
    4344sub complete_color { return @all_colors; }
    44 sub complete_filter_name { return @{BarnOwl::all_filters()}; }
    4545sub complete_variable    { return @{BarnOwl::all_variables()}; }
    4646sub complete_style       { return @{BarnOwl::all_styles()}; }
    47 
    48 my %filter_cmds = (
    49     sender    => \&BarnOwl::Complete::Zephyr::complete_user,
    50     recipient => \&BarnOwl::Complete::Zephyr::complete_user,
    51     class     => \&BarnOwl::Complete::Zephyr::complete_class,
    52     instance  => \&BarnOwl::Complete::Zephyr::complete_instance,
    53     opcode    => \&BarnOwl::Complete::Zephyr::complete_opcode,
    54     realm     => \&BarnOwl::Complete::Zephyr::complete_realm,
    55     body      => undef,
    56     hostname  => undef,
    57     type      => sub { qw(zephyr aim admin); },
    58     direction => sub { qw(in out none); },
    59     login     => sub { qw(login logout none); },
    60     filter    => \&complete_filter_name,
    61     perl      => undef,
    62 );
    63 
    64 # Returns:
    65 # - where to look next after pulling out an expression
    66 # - $INCOMPLETE if this cannot form a complete expression (or w/e)
    67 # - pushes to completion list as it finds valid completions
    68 
    69 my $INCOMPLETE = -1;
    70 sub _complete_filter_expr {
    71     # Takes as arguments context and the index into $ctx->words where the
    72     # filter expression starts
    73     my $ctx = shift;
    74     my $start = shift;
    75     my $o_comp = shift;
    76     my $end = $ctx->word;
    77 
    78     # Grab an expression; we don't allow empty
    79     my $i = $start;
    80     $i = _complete_filter_primitive_expr($ctx, $start, $o_comp);
    81     return $INCOMPLETE if $start == $INCOMPLETE;
    82 
    83     while ($i <= $end) {
    84         if ($i == $end) {
    85             # We could and/or another clause
    86             push @$o_comp, qw(and or);
    87             return $end; # Or we could let the parent do his thing
    88         }
    89 
    90         if ($ctx->words->[$i] ne 'and' && $ctx->words->[$i] ne 'or') {
    91             return $i; # We're done. Let the parent do his thing
    92         }
    93 
    94         # Eat the and/or
    95         $i++;
    96 
    97         # Grab an expression
    98         $i = _complete_filter_primitive_expr($ctx, $i, $o_comp);
    99         return $INCOMPLETE if $i == $INCOMPLETE;
    100     }
    101    
    102     return $i; # Well, it looks like we're happy
    103     # (Actually, I'm pretty sure this never happens...)
    104 }
    105 
    106 sub _complete_filter_primitive_expr {
    107     my $ctx = shift;
    108     my $start = shift;
    109     my $o_comp = shift;
    110     my $end = $ctx->word;
    111 
    112     if ($start >= $end) {
    113         push @$o_comp, "(";
    114         push @$o_comp, qw(true false not);
    115         push @$o_comp, keys %filter_cmds;
    116         return $INCOMPLETE;
    117     }
    118 
    119     my $word = $ctx->words->[$start];
    120     if ($word eq "(") {
    121         $start = _complete_filter_expr($ctx, $start+1, $o_comp);
    122         return $INCOMPLETE if $start == $INCOMPLETE;
    123 
    124         # Now, we expect a ")"
    125         if ($start >= $end) {
    126             push @$o_comp, ")";
    127             return $INCOMPLETE;
    128         }
    129         if ($ctx->words->[$start] ne ')') {
    130             # User is being confusing. Give up.
    131             return $INCOMPLETE;
    132         }
    133         return $start+1; # Eat the )
    134     } elsif ($word eq "not") {
    135         # We just want another primitive expression
    136         return _complete_filter_primitive_expr($ctx, $start+1, $o_comp);
    137     } elsif ($word eq "true" || $word eq "false") {
    138         # No arguments
    139         return $start+1; # Eat the boolean. Mmmm, tasty.
    140     } else {
    141         # It's of the form 'CMD ARG'
    142         return $start+2 if ($start+1 < $end); # The user supplied the argument
    143 
    144         # complete the argument
    145         my $arg_func = $filter_cmds{$word};
    146         push @$o_comp, ($arg_func ? ($arg_func->()) : ());
    147         return $INCOMPLETE;
    148     }
    149 }
    150 
    151 sub complete_filter_expr {
    152     my $ctx = shift;
    153     my $start = shift;
    154     my @completions = ();
    155     _complete_filter_expr($ctx, $start, \@completions);
    156     # Get rid of duplicates and sort
    157     my %hash = ();
    158     @hash{@completions} = ();
    159     @completions = sort keys %hash;
    160     return @completions;
    161 }
    162 
    163 sub complete_filter_args {
    164     my $ctx = shift;
    165     my $arg = shift;
    166     return complete_filter_name() unless $arg;
    167     my $idx = 2; # skip the filter name
    168     while ($idx < $ctx->word) {
    169         last unless ($ctx->words->[$idx] =~ m{^-});
    170         $idx += 2; # skip the flag and the argument
    171     }
    172     return complete_filter_expr($ctx, $idx);
    173 }
    17447
    17548sub complete_help {
    … …  
    19467sub complete_filter {
    19568    my $ctx = shift;
     69    # Syntax: filter FILTERNAME FLAGS EXPR
     70
     71    # FILTERNAME
     72    return complete_filter_name() if $ctx->word == 1;
     73
     74    # FLAGS
     75    $ctx = $ctx->shift_words(1); # complete_flags starts at the second word
    19676    return complete_flags($ctx,
    19777        [qw()],
    … …  
    20080           "-b" => \&complete_color,
    20181        },
    202          \&complete_filter_args
     82        # EXPR
     83        sub {
     84            my $ctx = shift;
     85            my $arg = shift;
     86
     87            # We pass stop_at_nonflag, so we can rewind to the start
     88            my $idx = $ctx->word - $arg;
     89            $ctx = $ctx->shift_words($idx);
     90            return complete_filter_expr($ctx);
     91        },
     92        stop_at_nonflag => 1
    20393        );
    20494}
    … …  
    213103    }
    214104    if ($ctx->words->[1] eq "-d") {
    215         return complete_filter_expr($ctx, 2);
     105        $ctx = $ctx->shift_words(2);
     106        return complete_filter_expr($ctx);
    216107    }
    217108    if ($ctx->words->[1] eq "-s") {
    … …  
    243134}
    244135
     136sub complete_startup {
     137    my $ctx = shift;
     138    my $new_ctx = $ctx->shift_words(1);
     139    return BarnOwl::Completion::get_completions($new_ctx);
     140}
     141
    245142BarnOwl::Completion::register_completer(help    => \&complete_help);
    246143BarnOwl::Completion::register_completer(filter  => \&complete_filter);
    … …  
    250147BarnOwl::Completion::register_completer(set     => \&complete_set);
    251148BarnOwl::Completion::register_completer(unset   => \&complete_set);
     149BarnOwl::Completion::register_completer(startup => \&complete_startup);
    252150
    2531511;

  • perl/lib/BarnOwl/Completion/Context.pm

    r7be5d8b re97c5d05  
    4040
    4141use base qw(Class::Accessor::Fast);
     42use Carp qw(croak);
    4243
    4344__PACKAGE__->mk_ro_accessors(qw(line point words word word_point
    … …  
    6465       };
    6566    return bless($self, $class);
     67}
     68
     69=head2 shift_words N
     70
     71Returns a new C<Context> object, with the leading C<N> words
     72stripped. All fields are updated as appopriate. If C<N> > C<<
     73$self->word >>, C<croak>s with an error message.
     74
     75=cut
     76
     77sub shift_words {
     78    my $self = shift;
     79    my $n    = shift;
     80
     81    if($n > $self->word) {
     82        croak "Context::shift: Unable to shift $n words";
     83    }
     84
     85    my $before = substr($self->line, 0, $self->point);
     86    my $after  = substr($self->line, $self->point);
     87
     88    return BarnOwl::Completion::Context->new(BarnOwl::skiptokens($before, $n),
     89                                             $after);
    6690}
    6791

  • perl/lib/BarnOwl/Completion/Util.pm

    r94ef58c r69c27e6  
    2424    my $optsdone = 0;
    2525
     26    my %flags_seen;
     27
    2628    while($idx < $ctx->word) {
    2729        my $word = $ctx->words->[$idx];
    … …  
    3739        } elsif ($word =~ m{^-}) {
    3840            $word = "-" . substr($word, -1);
     41            $flags_seen{$word} = 1; # record flag
    3942            $flag = $word if(exists $args->{$word});
    4043        } else {
    … …  
    5861        return;
    5962    } else {
    60         return ($optsdone ? () : (@$no_args, keys %$args),
    61                 $default ? ($default->($ctx, $argct)) : ());
     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)) : ());
    6267    }
    6368}

  • perlglue.xs

    r1a5db78 r9e5b5fd  
    424424                RETVAL
    425425
     426const char *
     427skiptokens(str, n)
     428        const char *str;
     429        int n;
     430        CODE:
     431                RETVAL = skiptokens(str, n);
     432        OUTPUT:
     433                RETVAL
     434
     435
     436
    426437MODULE = BarnOwl                PACKAGE = BarnOwl::Internal
    427438

  • runtests.sh

    r2fa9a1a0 r42ad917  
    11#!/bin/sh
    2 prove t/
     2prove t/ --perl ./perl_tester

  • t/completion.t

    rb017b03 r1167bf1  
    88BEGIN {require (dirname($0) . "/mock.pl");};
    99
     10use BarnOwl::Complete::Filter qw(complete_filter_expr);
     11
    1012=head1 DESCRIPTION
    1113
    … …  
    2022    my $after_point = shift;
    2123   
     24    my $ctx = BarnOwl::Completion::Context->new($before_point,
     25                                                $after_point);
     26    is($ctx->line, $before_point . $after_point);
     27    is($ctx->point, length $before_point);
     28
     29    test_ctx($ctx, @_);
     30}
     31
     32sub test_ctx {
     33    local $Test::Builder::Level = $Test::Builder::Level + 1;
     34
     35    my $ctx = shift;
     36
    2237    my $words = shift;
    2338    my $word = shift;
    … …  
    2742    my $word_end   = shift;
    2843
    29     my $ctx = BarnOwl::Completion::Context->new($before_point,
    30                                                 $after_point);
    31 
    32     is($ctx->line, $before_point . $after_point);
    33     is($ctx->point, length $before_point);
    3444    is_deeply($ctx->words, $words);
    3545    if (defined($word)) {
    … …  
    4151}
    4252
     53sub test_shift {
     54    local $Test::Builder::Level = $Test::Builder::Level + 1;
     55
     56    my $before_point = shift;
     57    my $after_point = shift;
     58    my $shift = shift;
     59   
     60    my $ctx = BarnOwl::Completion::Context->new($before_point,
     61                                                $after_point);
     62    $ctx = $ctx->shift_words($shift);
     63
     64    test_ctx($ctx, @_);
     65}
     66
    4367
    4468isa_ok(BarnOwl::Completion::Context->new('Hello, W', 'orld'), 'BarnOwl::Completion::Context');
    … …  
    108132              1, -1, 7, 12);
    109133
     134## Test Context::shift
     135test_shift('lorem ipsum dolor ', 'sit amet', 0,
     136           [qw(lorem ipsum dolor sit amet)],
     137           3, 0, 18, 21);
     138
     139test_shift('lorem ipsum dolor ', 'sit amet', 1,
     140           [qw(ipsum dolor sit amet)],
     141           2, 0, 12, 15);
     142
     143test_shift('lorem ipsum dolor ', 'sit amet', 2,
     144           [qw(dolor sit amet)],
     145           1, 0, 6, 9);
     146
     147test_shift('lorem ipsum dolor ', 'sit amet', 3,
     148           [qw(sit amet)],
     149           0, 0, 0, 3);
     150
     151eval {
     152    my $before_point = 'lorem ipsum dolor';
     153    my $after_point = 'sit amet';
     154    my $shift = 4;
     155
     156    my $ctx = BarnOwl::Completion::Context->new($before_point,
     157                                                $after_point);
     158    $ctx = $ctx->shift_words($shift);
     159};
     160like($@, qr/^Context::shift: Unable to shift /, "Correctly die when shifting away the point");
    110161
    111162## Test common_prefix
    … …  
    163214
    164215test_complete('zwrite -c nelhage ', '',
    165               [qw(-n -C -m -c -i -r -O nelhage asedeno geofft)]);
     216              [qw(-n -C -m -i -r -O nelhage asedeno geofft)]);
    166217
    167218test_complete('zwrite -c nelhage ', '-',
    168               [qw(-n -C -m -c -i -r -O nelhage asedeno geofft)]);
     219              [qw(-n -C -m -i -r -O nelhage asedeno geofft)]);
    169220
    170221test_complete('zwrite -c nelhage -- ', '',
    … …  
    178229                              "-d" => sub {qw(some words for completing)},
    179230                          },
    180                           sub {$_[1]});
     231                          sub {$_[1]},
     232                          repeat_flags => 1);
    181233}
    182234
    … …  
    203255              [qw(2)], \&complete_word);
    204256
     257
     258# Test the filter expression completer
     259test_complete('', '',
     260              [qw[( body class direction false filter hostname instance login not opcode perl realm recipient sender true type]],
     261              \&complete_filter_expr);
     262
     263test_complete('not ', '',
     264              [qw[( body class direction false filter hostname instance login not opcode perl realm recipient sender true type]],
     265              \&complete_filter_expr);
     266
     267test_complete('true ', '',
     268              [qw[and or]],
     269              \&complete_filter_expr);
     270
     271test_complete('( true ', '',
     272              [qw[and or )]],
     273              \&complete_filter_expr);
     274
     275test_complete('( body static and body analysis and not false and class davidben and ( instance python or instance hotd ', '',
     276              [qw[and or )]],
     277              \&complete_filter_expr);
     278
     279test_complete('type ', '',
     280              [qw[admin aim zephyr]],
     281              \&complete_filter_expr);
     282
     283test_complete('direction ', '',
     284              [qw[in out none]],
     285              \&complete_filter_expr);
     286
     287test_complete('login ', '',
     288              [qw[login logout none]],
     289              \&complete_filter_expr);
     290
    2052911;
    206292

  • t/mock.pl

    r776c4bb r42ad917  
    77use Carp;
    88
    9 sub bootstrap {}
    109sub get_data_dir {"."}
    1110sub get_config_dir {"."}
Note: See TracChangeset for help on using the changeset viewer.