Changeset 8830f79f for perl


Ignore:
Timestamp:
Oct 3, 2009, 10:15:11 AM (12 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
Children:
9f5e847
Parents:
340c3e7 (diff), 1167bf1 (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent.
Message:
Merge branch 'davidben/context-slice'

Conflicts:
	perlglue.xs
Location:
perl
Files:
2 added
7 edited

Legend:

Unmodified
Added
Removed
  • 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}
  • perl/lib/BarnOwl.pm

    r7589f0a rde3f641  
    427427}
    428428
     429=head3 default_zephyr_signature
     430
     431Compute the default zephyr signature.
     432
     433=cut
     434
     435sub default_zephyr_signature
     436{
     437  if (my $zsig = getvar('zsig')) {
     438    return $zsig;
     439  }
     440  if (my $zsigproc = getvar('zsigproc')) {
     441    return `$zsigproc`;
     442  }
     443  my $zwrite_signature = get_zephyr_variable('zwrite-signature');
     444  if (defined($zwrite_signature)) {
     445    return $zwrite_signature;
     446  }
     447  my $name = ((getpwuid($<))[6]);
     448  $name =~ s/,.*//;
     449  return $name;
     450}
     451
    429452# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
    430453# startup command. This may be redefined in a user's configfile.
  • perl/lib/BarnOwl/Complete/Zephyr.pm

    rfdc0c47 r9300fe5  
    4545    my $m = shift;
    4646    return unless $m->type eq 'zephyr';
    47     $classes{$m->class} = 1;
    48     $realms{$m->realm} = 1;
    49     $users{BarnOwl::Message::Zephyr::strip_realm($m->sender)} = 1;
     47    $classes{lc $m->class} = 1;
     48    $realms{lc $m->realm} = 1;
     49    $users{lc BarnOwl::Message::Zephyr::strip_realm($m->sender)} = 1;
    5050}
    5151
  • perl/lib/BarnOwl/Hooks.pm

    r03e25c5 re2f7963  
    196196    my $package = "BarnOwl";
    197197
     198
     199    if(!contains(\@BarnOwl::all_commands, $command)) {
     200        push @BarnOwl::all_commands, $command;
     201    }
     202
    198203    if($symbol =~ m{^edit:(.+)$}) {
    199204        $symbol = $1;
     
    222227        }
    223228    }
    224 
    225     if(!contains(\@BarnOwl::all_commands, $command)) {
    226         push @BarnOwl::all_commands, $command;
    227     }
    228229}
    229230
  • perl/modules/IRC/lib/BarnOwl/Module/IRC/Completion.pm

    r216b1d0 r955a36e  
    66use BarnOwl::Completion::Util qw(complete_flags);
    77
    8 my %networks = ();
    9 my %dests = ();
    10 my %servers = ();
     8our %users = ();
     9our %servers = ();
    1110
    12 sub complete_networks { keys %networks }
    13 sub complete_dests    { keys %dests }
    14 sub complete_channels { grep /^#/, keys %dests }
    15 sub complete_nicks    { grep /^[^#]/, keys %dests }
     11sub complete_networks { keys %BarnOwl::Module::IRC::ircnets }
     12sub complete_dests    { keys %users, complete_channels() }
     13sub complete_channels { keys %BarnOwl::Module::IRC::channels }
     14sub complete_nicks    { keys %users }
    1615sub complete_servers  { keys %servers }
    1716
     
    7574    my $m = shift;
    7675    return unless $m->type eq 'IRC';
    77     $networks{$m->network} = 1;
    78     $dests{$m->recipient} = 1;
    79     $dests{$m->sender} = 1;
     76    if ($m->recipient && $m->recipient !~ m{^#}) {
     77        $users{$m->recipient} = 1;
     78    }
     79    if ($m->sender && $m->sender !~ m{^#}) {
     80        $users{$m->sender} = 1;
     81    }
    8082    $servers{$m->server} = 1;
    8183}
Note: See TracChangeset for help on using the changeset viewer.