Changes in / [8830f79f:340c3e7]
- Files:
-
- 2 deleted
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
.gitignore
r42ad917 rb9c8d28 28 28 owl_prototypes.h 29 29 owl_prototypes.h.new 30 perl_tester31 30 perlglue.c 32 31 perlwrap.c -
Makefile.am
r42ad917 reddee7e 2 2 3 3 bin_PROGRAMS = barnowl.bin 4 check_PROGRAMS = tester perl_tester4 check_PROGRAMS = tester 5 5 6 6 barnowl_bin_SOURCES = $(BASE_SRCS) \ … … 17 17 18 18 tester_LDADD = libfaim/libfaim.a 19 20 perl_tester_SOURCES = $(BASE_SRCS) \21 owl.h owl_perl.h config.h \22 libzcrypt.a \23 $(GEN_C) $(GEN_H) \24 perl_tester.c25 26 perl_tester_LDADD = libfaim/libfaim.a libzcrypt.a27 19 28 20 TESTS=runtests.sh -
perl/lib/BarnOwl/Complete/Client.pm
ra3a9eb7 rd5ccf4e8 7 7 8 8 use BarnOwl::Completion::Util qw(complete_flags); 9 use BarnOwl::Complete::Filter qw(complete_filter_name complete_filter_expr);10 9 11 10 my @all_colors = qw(default … … 43 42 sub complete_command { return sort @BarnOwl::all_commands; } 44 43 sub complete_color { return @all_colors; } 44 sub complete_filter_name { return @{BarnOwl::all_filters()}; } 45 45 sub complete_variable { return @{BarnOwl::all_variables()}; } 46 46 sub 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 } 47 174 48 175 sub complete_help { … … 67 194 sub complete_filter { 68 195 my $ctx = shift; 69 # Syntax: filter FILTERNAME FLAGS EXPR70 71 # FILTERNAME72 return complete_filter_name() if $ctx->word == 1;73 74 # FLAGS75 $ctx = $ctx->shift_words(1); # complete_flags starts at the second word76 196 return complete_flags($ctx, 77 197 [qw()], … … 80 200 "-b" => \&complete_color, 81 201 }, 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 202 \&complete_filter_args 93 203 ); 94 204 } … … 103 213 } 104 214 if ($ctx->words->[1] eq "-d") { 105 $ctx = $ctx->shift_words(2); 106 return complete_filter_expr($ctx); 215 return complete_filter_expr($ctx, 2); 107 216 } 108 217 if ($ctx->words->[1] eq "-s") { … … 132 241 return if $arg; 133 242 return complete_variable(); 134 }135 136 sub complete_startup {137 my $ctx = shift;138 my $new_ctx = $ctx->shift_words(1);139 return BarnOwl::Completion::get_completions($new_ctx);140 243 } 141 244 … … 147 250 BarnOwl::Completion::register_completer(set => \&complete_set); 148 251 BarnOwl::Completion::register_completer(unset => \&complete_set); 149 BarnOwl::Completion::register_completer(startup => \&complete_startup);150 252 151 253 1; -
perl/lib/BarnOwl/Completion/Context.pm
re97c5d05 r7be5d8b 40 40 41 41 use base qw(Class::Accessor::Fast); 42 use Carp qw(croak);43 42 44 43 __PACKAGE__->mk_ro_accessors(qw(line point words word word_point … … 65 64 }; 66 65 return bless($self, $class); 67 }68 69 =head2 shift_words N70 71 Returns a new C<Context> object, with the leading C<N> words72 stripped. All fields are updated as appopriate. If C<N> > C<<73 $self->word >>, C<croak>s with an error message.74 75 =cut76 77 sub 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);90 66 } 91 67 -
perl/lib/BarnOwl/Completion/Util.pm
r69c27e6 r94ef58c 24 24 my $optsdone = 0; 25 25 26 my %flags_seen;27 28 26 while($idx < $ctx->word) { 29 27 my $word = $ctx->words->[$idx]; … … 39 37 } elsif ($word =~ m{^-}) { 40 38 $word = "-" . substr($word, -1); 41 $flags_seen{$word} = 1; # record flag42 39 $flag = $word if(exists $args->{$word}); 43 40 } else { … … 61 58 return; 62 59 } 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)) : ()); 60 return ($optsdone ? () : (@$no_args, keys %$args), 61 $default ? ($default->($ctx, $argct)) : ()); 67 62 } 68 63 } -
perlglue.xs
r9e5b5fd r1a5db78 424 424 RETVAL 425 425 426 const char *427 skiptokens(str, n)428 const char *str;429 int n;430 CODE:431 RETVAL = skiptokens(str, n);432 OUTPUT:433 RETVAL434 435 436 437 426 MODULE = BarnOwl PACKAGE = BarnOwl::Internal 438 427 -
runtests.sh
r42ad917 r2fa9a1a0 1 1 #!/bin/sh 2 prove t/ --perl ./perl_tester2 prove t/ -
t/completion.t
r1167bf1 rb017b03 8 8 BEGIN {require (dirname($0) . "/mock.pl");}; 9 9 10 use BarnOwl::Complete::Filter qw(complete_filter_expr);11 12 10 =head1 DESCRIPTION 13 11 … … 22 20 my $after_point = shift; 23 21 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 32 sub test_ctx {33 local $Test::Builder::Level = $Test::Builder::Level + 1;34 35 my $ctx = shift;36 37 22 my $words = shift; 38 23 my $word = shift; … … 42 27 my $word_end = shift; 43 28 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); 44 34 is_deeply($ctx->words, $words); 45 35 if (defined($word)) { … … 51 41 } 52 42 53 sub 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 67 43 68 44 isa_ok(BarnOwl::Completion::Context->new('Hello, W', 'orld'), 'BarnOwl::Completion::Context'); … … 132 108 1, -1, 7, 12); 133 109 134 ## Test Context::shift135 test_shift('lorem ipsum dolor ', 'sit amet', 0,136 [qw(lorem ipsum dolor sit amet)],137 3, 0, 18, 21);138 139 test_shift('lorem ipsum dolor ', 'sit amet', 1,140 [qw(ipsum dolor sit amet)],141 2, 0, 12, 15);142 143 test_shift('lorem ipsum dolor ', 'sit amet', 2,144 [qw(dolor sit amet)],145 1, 0, 6, 9);146 147 test_shift('lorem ipsum dolor ', 'sit amet', 3,148 [qw(sit amet)],149 0, 0, 0, 3);150 151 eval {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 };160 like($@, qr/^Context::shift: Unable to shift /, "Correctly die when shifting away the point");161 110 162 111 ## Test common_prefix … … 214 163 215 164 test_complete('zwrite -c nelhage ', '', 216 [qw(-n -C -m - i -r -O nelhage asedeno geofft)]);165 [qw(-n -C -m -c -i -r -O nelhage asedeno geofft)]); 217 166 218 167 test_complete('zwrite -c nelhage ', '-', 219 [qw(-n -C -m - i -r -O nelhage asedeno geofft)]);168 [qw(-n -C -m -c -i -r -O nelhage asedeno geofft)]); 220 169 221 170 test_complete('zwrite -c nelhage -- ', '', … … 229 178 "-d" => sub {qw(some words for completing)}, 230 179 }, 231 sub {$_[1]}, 232 repeat_flags => 1); 180 sub {$_[1]}); 233 181 } 234 182 … … 255 203 [qw(2)], \&complete_word); 256 204 257 258 # Test the filter expression completer259 test_complete('', '',260 [qw[( body class direction false filter hostname instance login not opcode perl realm recipient sender true type]],261 \&complete_filter_expr);262 263 test_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 267 test_complete('true ', '',268 [qw[and or]],269 \&complete_filter_expr);270 271 test_complete('( true ', '',272 [qw[and or )]],273 \&complete_filter_expr);274 275 test_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 279 test_complete('type ', '',280 [qw[admin aim zephyr]],281 \&complete_filter_expr);282 283 test_complete('direction ', '',284 [qw[in out none]],285 \&complete_filter_expr);286 287 test_complete('login ', '',288 [qw[login logout none]],289 \&complete_filter_expr);290 291 205 1; 292 206 -
t/mock.pl
r42ad917 r776c4bb 7 7 use Carp; 8 8 9 sub bootstrap {} 9 10 sub get_data_dir {"."} 10 11 sub get_config_dir {"."}
Note: See TracChangeset
for help on using the changeset viewer.