Changeset 8830f79f for perl

Timestamp:

Oct 3, 2009, 10:15:11 AM (15 years ago)

Author:

Nelson Elhage <nelhage@mit.edu>

Branches:

master, release-1.10, 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:

• lib/BarnOwl/Complete/Client.pm (modified) (7 diffs)
• lib/BarnOwl/Complete/Filter.pm (added)
• lib/BarnOwl/Completion/Context.pm (modified) (2 diffs)
• lib/BarnOwl/Completion/Util.pm (modified) (3 diffs)
• lib/BarnOwl.pm (modified) (1 diff)
• lib/BarnOwl/Complete/AIM.pm (added)
• lib/BarnOwl/Complete/Zephyr.pm (modified) (1 diff)
• lib/BarnOwl/Hooks.pm (modified) (2 diffs)
• modules/IRC/lib/BarnOwl/Module/IRC/Completion.pm (modified) (2 diffs)

perl/lib/BarnOwl/Complete/Client.pm

@@ -7 +7 @@
 
 use BarnOwl::Completion::Util qw(complete_flags);
+use BarnOwl::Complete::Filter qw(complete_filter_name complete_filter_expr);
 
 my @all_colors = qw(default
@@ -42 +43 @@
 sub complete_command { return sort @BarnOwl::all_commands; }
 sub complete_color { return @all_colors; }
-sub complete_filter_name { return @{BarnOwl::all_filters()}; }
 sub complete_variable    { return @{BarnOwl::all_variables()}; }
 sub complete_style       { return @{BarnOwl::all_styles()}; }
-
-my %filter_cmds = (
-    sender    => \&BarnOwl::Complete::Zephyr::complete_user,
-    recipient => \&BarnOwl::Complete::Zephyr::complete_user,
-    class     => \&BarnOwl::Complete::Zephyr::complete_class,
-    instance  => \&BarnOwl::Complete::Zephyr::complete_instance,
-    opcode    => \&BarnOwl::Complete::Zephyr::complete_opcode,
-    realm     => \&BarnOwl::Complete::Zephyr::complete_realm,
-    body      => undef,
-    hostname  => undef,
-    type      => sub { qw(zephyr aim admin); },
-    direction => sub { qw(in out none); },
-    login     => sub { qw(login logout none); },
-    filter    => \&complete_filter_name,
-    perl      => undef,
-);
-
-# Returns:
-# - where to look next after pulling out an expression
-# - $INCOMPLETE if this cannot form a complete expression (or w/e)
-# - pushes to completion list as it finds valid completions
-
-my $INCOMPLETE = -1;
-sub _complete_filter_expr {
-    # Takes as arguments context and the index into $ctx->words where the
-    # filter expression starts
-    my $ctx = shift;
-    my $start = shift;
-    my $o_comp = shift;
-    my $end = $ctx->word;
-
-    # Grab an expression; we don't allow empty
-    my $i = $start;
-    $i = _complete_filter_primitive_expr($ctx, $start, $o_comp);
-    return $INCOMPLETE if $start == $INCOMPLETE;
-
-    while ($i <= $end) {
-        if ($i == $end) {
-            # We could and/or another clause
-            push @$o_comp, qw(and or);
-            return $end; # Or we could let the parent do his thing
-        }
-
-        if ($ctx->words->[$i] ne 'and' && $ctx->words->[$i] ne 'or') {
-            return $i; # We're done. Let the parent do his thing
-        }
-
-        # Eat the and/or
-        $i++;
-
-        # Grab an expression
-        $i = _complete_filter_primitive_expr($ctx, $i, $o_comp);
-        return $INCOMPLETE if $i == $INCOMPLETE;
-    }
-    
-    return $i; # Well, it looks like we're happy
-    # (Actually, I'm pretty sure this never happens...)
-}
-
-sub _complete_filter_primitive_expr {
-    my $ctx = shift;
-    my $start = shift;
-    my $o_comp = shift;
-    my $end = $ctx->word;
-
-    if ($start >= $end) {
-        push @$o_comp, "(";
-        push @$o_comp, qw(true false not);
-        push @$o_comp, keys %filter_cmds;
-        return $INCOMPLETE;
-    }
-
-    my $word = $ctx->words->[$start];
-    if ($word eq "(") {
-        $start = _complete_filter_expr($ctx, $start+1, $o_comp);
-        return $INCOMPLETE if $start == $INCOMPLETE;
-
-        # Now, we expect a ")"
-        if ($start >= $end) {
-            push @$o_comp, ")";
-            return $INCOMPLETE;
-        }
-        if ($ctx->words->[$start] ne ')') {
-            # User is being confusing. Give up.
-            return $INCOMPLETE;
-        }
-        return $start+1; # Eat the )
-    } elsif ($word eq "not") {
-        # We just want another primitive expression
-        return _complete_filter_primitive_expr($ctx, $start+1, $o_comp);
-    } elsif ($word eq "true" || $word eq "false") {
-        # No arguments
-        return $start+1; # Eat the boolean. Mmmm, tasty.
-    } else {
-        # It's of the form 'CMD ARG'
-        return $start+2 if ($start+1 < $end); # The user supplied the argument
-
-        # complete the argument
-        my $arg_func = $filter_cmds{$word};
-        push @$o_comp, ($arg_func ? ($arg_func->()) : ());
-        return $INCOMPLETE;
-    }
-}
-
-sub complete_filter_expr {
-    my $ctx = shift;
-    my $start = shift;
-    my @completions = ();
-    _complete_filter_expr($ctx, $start, \@completions);
-    # Get rid of duplicates and sort
-    my %hash = ();
-    @hash{@completions} = ();
-    @completions = sort keys %hash;
-    return @completions;
-}
-
-sub complete_filter_args {
-    my $ctx = shift;
-    my $arg = shift;
-    return complete_filter_name() unless $arg;
-    my $idx = 2; # skip the filter name
-    while ($idx < $ctx->word) {
-        last unless ($ctx->words->[$idx] =~ m{^-});
-        $idx += 2; # skip the flag and the argument
-    }
-    return complete_filter_expr($ctx, $idx);
-}
 
 sub complete_help {
@@ -194 +67 @@
 sub complete_filter {
     my $ctx = shift;
+    # Syntax: filter FILTERNAME FLAGS EXPR
+
+    # FILTERNAME
+    return complete_filter_name() if $ctx->word == 1;
+
+    # FLAGS
+    $ctx = $ctx->shift_words(1); # complete_flags starts at the second word
     return complete_flags($ctx,
         [qw()],
@@ -200 +80 @@
            "-b" => \&complete_color,
         },
-         \&complete_filter_args
+        # EXPR
+        sub {
+            my $ctx = shift;
+            my $arg = shift;
+
+            # We pass stop_at_nonflag, so we can rewind to the start
+            my $idx = $ctx->word - $arg;
+            $ctx = $ctx->shift_words($idx);
+            return complete_filter_expr($ctx);
+        },
+        stop_at_nonflag => 1
         );
 }
@@ -213 +103 @@
     }
     if ($ctx->words->[1] eq "-d") {
-        return complete_filter_expr($ctx, 2);
+        $ctx = $ctx->shift_words(2);
+        return complete_filter_expr($ctx);
     }
     if ($ctx->words->[1] eq "-s") {
@@ -243 +134 @@
 }
 
+sub complete_startup {
+    my $ctx = shift;
+    my $new_ctx = $ctx->shift_words(1);
+    return BarnOwl::Completion::get_completions($new_ctx);
+}
+
 BarnOwl::Completion::register_completer(help    => \&complete_help);
 BarnOwl::Completion::register_completer(filter  => \&complete_filter);
@@ -250 +147 @@
 BarnOwl::Completion::register_completer(set     => \&complete_set);
 BarnOwl::Completion::register_completer(unset   => \&complete_set);
+BarnOwl::Completion::register_completer(startup => \&complete_startup);
 
 1;

perl/lib/BarnOwl/Completion/Context.pm

@@ -40 +40 @@
 
 use base qw(Class::Accessor::Fast);
+use Carp qw(croak);
 
 __PACKAGE__->mk_ro_accessors(qw(line point words word word_point
@@ -64 +65 @@
        };
     return bless($self, $class);
+}
+
+=head2 shift_words N
+
+Returns a new C<Context> object, with the leading C<N> words
+stripped. All fields are updated as appopriate. If C<N> > C<<
+$self->word >>, C<croak>s with an error message.
+
+=cut
+
+sub shift_words {
+    my $self = shift;
+    my $n    = shift;
+
+    if($n > $self->word) {
+        croak "Context::shift: Unable to shift $n words";
+    }
+
+    my $before = substr($self->line, 0, $self->point);
+    my $after  = substr($self->line, $self->point);
+
+    return BarnOwl::Completion::Context->new(BarnOwl::skiptokens($before, $n),
+                                             $after);
 }
 

perl/lib/BarnOwl/Completion/Util.pm

@@ -24 +24 @@
     my $optsdone = 0;
 
+    my %flags_seen;
+
     while($idx < $ctx->word) {
         my $word = $ctx->words->[$idx];
@@ -37 +39 @@
         } elsif ($word =~ m{^-}) {
             $word = "-" . substr($word, -1);
+            $flags_seen{$word} = 1; # record flag
             $flag = $word if(exists $args->{$word});
         } else {
@@ -58 +61 @@
         return;
     } else {
-        return ($optsdone ? () : (@$no_args, keys %$args),
-                $default ? ($default->($ctx, $argct)) : ());
+        my @opts = $optsdone ? () : (@$no_args, keys %$args);
+        # filter out flags we've seen if needbe
+        @opts = grep {!$flags_seen{$_}} @opts unless $options{repeat_flags};
+        return (@opts, $default ? ($default->($ctx, $argct)) : ());
     }
 }

perl/lib/BarnOwl.pm

@@ -427 +427 @@
 }
 
+=head3 default_zephyr_signature
+
+Compute the default zephyr signature.
+
+=cut
+
+sub default_zephyr_signature
+{
+  if (my $zsig = getvar('zsig')) {
+    return $zsig;
+  }
+  if (my $zsigproc = getvar('zsigproc')) {
+    return `$zsigproc`;
+  }
+  my $zwrite_signature = get_zephyr_variable('zwrite-signature');
+  if (defined($zwrite_signature)) {
+    return $zwrite_signature;
+  }
+  my $name = ((getpwuid($<))[6]);
+  $name =~ s/,.*//;
+  return $name;
+}
+
 # Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
 # startup command. This may be redefined in a user's configfile.

perl/lib/BarnOwl/Complete/Zephyr.pm

@@ -45 +45 @@
     my $m = shift;
     return unless $m->type eq 'zephyr';
-    $classes{$m->class} = 1;
-    $realms{$m->realm} = 1;
-    $users{BarnOwl::Message::Zephyr::strip_realm($m->sender)} = 1;
+    $classes{lc $m->class} = 1;
+    $realms{lc $m->realm} = 1;
+    $users{lc BarnOwl::Message::Zephyr::strip_realm($m->sender)} = 1;
 }
 

perl/lib/BarnOwl/Hooks.pm

@@ -196 +196 @@
     my $package = "BarnOwl";
 
+
+    if(!contains(\@BarnOwl::all_commands, $command)) {
+        push @BarnOwl::all_commands, $command;
+    }
+
     if($symbol =~ m{^edit:(.+)$}) {
         $symbol = $1;
@@ -222 +227 @@
         }
     }
-
-    if(!contains(\@BarnOwl::all_commands, $command)) {
-        push @BarnOwl::all_commands, $command;
-    }
 }
 

perl/modules/IRC/lib/BarnOwl/Module/IRC/Completion.pm

@@ -6 +6 @@
 use BarnOwl::Completion::Util qw(complete_flags);
 
-my %networks = ();
-my %dests = ();
-my %servers = ();
+our %users = ();
+our %servers = ();
 
-sub complete_networks { keys %networks }
-sub complete_dests    { keys %dests }
-sub complete_channels { grep /^#/, keys %dests }
-sub complete_nicks    { grep /^[^#]/, keys %dests }
+sub complete_networks { keys %BarnOwl::Module::IRC::ircnets }
+sub complete_dests    { keys %users, complete_channels() }
+sub complete_channels { keys %BarnOwl::Module::IRC::channels }
+sub complete_nicks    { keys %users }
 sub complete_servers  { keys %servers }
 
@@ -75 +74 @@
     my $m = shift;
     return unless $m->type eq 'IRC';
-    $networks{$m->network} = 1;
-    $dests{$m->recipient} = 1;
-    $dests{$m->sender} = 1;
+    if ($m->recipient && $m->recipient !~ m{^#}) {
+        $users{$m->recipient} = 1;
+    }
+    if ($m->sender && $m->sender !~ m{^#}) {
+        $users{$m->sender} = 1;
+    }
     $servers{$m->server} = 1;
 }