Changes in / [85fa6e4:460fbe8]


Ignore:
Files:
7 edited

Legend:

Unmodified
Added
Removed

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

    rdc8f6e0 rdab89e28  
    66package BarnOwl::Complete::Client;
    77
    8 use BarnOwl::Completion::Util qw(complete_flags complete_file);
     8use BarnOwl::Completion::Util qw(complete_flags);
    99use BarnOwl::Complete::Filter qw(complete_filter_name complete_filter_expr);
    1010
    … …  
    167167}
    168168
    169 sub complete_bindkey {
    170     my $ctx = shift;
    171     # bindkey KEYMAP KEYSEQ command COMMAND
    172     #   0      1       2      3        4
    173     if ($ctx->word == 1) {
    174         return complete_keymap();
    175     } elsif ($ctx->word == 2) {
    176         return;
    177     } elsif ($ctx->word == 3) {
    178         return ('command');
    179     } else {
    180         my $new_ctx = $ctx->shift_words(4);
    181         return BarnOwl::Completion::get_completions($new_ctx);
    182     }
    183 }
    184 
    185 sub complete_print {
    186     my $ctx = shift;
    187     return unless $ctx->word == 1;
    188     return complete_variable();
    189 }
    190 
    191 sub complete_one_file_arg {
    192     my $ctx = shift;
    193     return unless $ctx->word == 1;
    194     return complete_file($ctx->words->[1]);
    195 }
    196 
    197169BarnOwl::Completion::register_completer(help    => \&complete_help);
    198170BarnOwl::Completion::register_completer(filter  => \&complete_filter);
    … …  
    206178BarnOwl::Completion::register_completer(unset   => \&complete_set);
    207179BarnOwl::Completion::register_completer(startup => \&complete_startup);
    208 BarnOwl::Completion::register_completer(bindkey => \&complete_bindkey);
    209 BarnOwl::Completion::register_completer(print   => \&complete_print);
    210 
    211 BarnOwl::Completion::register_completer(source      => \&complete_one_file_arg);
    212 BarnOwl::Completion::register_completer('load-subs' => \&complete_one_file_arg);
    213 BarnOwl::Completion::register_completer(loadsubs    => \&complete_one_file_arg);
    214 BarnOwl::Completion::register_completer(loadloginsubs    => \&complete_one_file_arg);
    215 BarnOwl::Completion::register_completer(dump        => \&complete_one_file_arg);
    216180
    2171811;

  • perl/lib/BarnOwl/Completion.pm

    r880311d r48d130b  
    3131    my @words = get_completions($ctx);
    3232    return unless @words;
    33     my $prefix = common_prefix(map {completion_value($_)} @words);
     33    my $prefix = common_prefix(@words);
    3434
    3535    if($prefix) {
    36         insert_completion($ctx, $prefix,
    37                           scalar @words == 1 && completion_done($words[0]));
     36        insert_completion($ctx, $prefix, scalar @words == 1);
    3837    }
    3938
    … …  
    4544}
    4645
    47 =head1 COMPLETIONS
    48 
    49 A COMPLETION is either a simple string, or a reference to an array
    50 containing two or more values.
    51 
    52 In the former case, the string use used for both the text to display,
    53 as well as the result of the completion, and is assumed to be a full
    54 completion.
    55 
    56 An arrayref completion consists of
    57 
    58     [$display_text, $replacement_value[, $completion_done] ].
    59 
    60 $display_text will be printed in the case of ambiguous completions,
    61 $replacement_value will be used to substitute the value in. If there
    62 is only a single completion for a given word, a space will be appended
    63 after the completion iff $completion_done is true (or missing).
    64 
    65 =cut
    66 
    67 sub completion_text {
    68     my $c = shift;
    69     return $c unless ref($c) eq 'ARRAY';
    70     return $c->[0];
    71 }
    72 
    73 sub completion_value {
    74     my $c = shift;
    75     return $c unless ref($c) eq 'ARRAY';
    76     return $c->[1];
    77 }
    78 
    79 sub completion_done {
    80     my $c = shift;
    81     return 1 if ref($c) ne 'ARRAY' or @$c < 3;
    82     return $c->[2];
    83 }
    84 
    8546sub insert_completion {
    8647    my $ctx = shift;
    87     my $completion = BarnOwl::quote(completion_value(shift));
    88     my $done = shift;
     48    my $completion = BarnOwl::quote(shift);
     49    my $unique = shift;
    8950
    90     if($done) {
     51    if($unique) {
    9152        $completion .= " ";
    9253    }
    … …  
    10566sub show_completions {
    10667    my @words = @_;
    107     my $all = BarnOwl::quote(map {completion_text($_)} @words);
     68    my $all = BarnOwl::quote(@words);
    10869    my $width = BarnOwl::getnumcols();
    10970    if (length($all) > $width-1) {
    … …  
    13798        my $word = $ctx->words->[$ctx->word];
    13899        if(exists($completers{$cmd})) {
    139             return grep {completion_value($_) =~ m{^\Q$word\E}} $completers{$cmd}->($ctx);
     100            return grep {$_ =~ m{^\Q$word\E}} $completers{$cmd}->($ctx);
    140101        }
    141102        return;

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

    re6cec01 r69c27e6  
    55
    66use base qw(Exporter);
    7 our @EXPORT_OK = qw(complete_flags complete_file);
     7our @EXPORT_OK = qw(complete_flags);
    88
    99use Getopt::Long;
    10 use Cwd qw(abs_path);
    11 use File::Basename qw(dirname basename);
    12 
    1310
    1411sub complete_flags {
    … …  
    7067    }
    7168}
    72 
    73 sub expand_tilde {
    74     # Taken from The Perl Cookbook, recipe 7.3
    75     my $path = shift;
    76     $path =~ s{ ^ ~ ( [^/]* ) }
    77                 { $1
    78                   ? (getpwnam($1))[7]
    79                   : ( $ENV{HOME} || $ENV{LOGDIR}
    80                       || (getpwuid($>))[7]
    81                      )
    82               }ex;
    83     return $path;
    84 }
    85 
    86 sub splitfile {
    87     my $path = shift;
    88     if ($path =~ m{^(.*/)([^/]*)$}) {
    89         return ($1, $2);
    90     } else {
    91         return ('', $path);
    92     }
    93 }
    94 
    95 sub complete_file {
    96     my $string = shift;
    97 
    98     return ['~/', '~/', 0] if $string eq '~';
    99 
    100     my $path = abs_path(expand_tilde($string));
    101     my $dir;
    102     if ($string =~ m{/$} || $string eq '' || basename($string) eq '.') {
    103         $dir = $path;
    104     } else {
    105         $dir = dirname($path);
    106     }
    107     return unless -d $dir;
    108 
    109     my ($pfx, $base) = splitfile($string);
    110    
    111     opendir(my $dh, $dir) or return;
    112     my @dirs = readdir($dh);
    113     close($dh);
    114 
    115     my @out;
    116     for my $d (@dirs) {
    117         # Skip dotfiles unless explicitly requested
    118         if($d =~ m{^[.]} && $base !~ m{^[.]}) {
    119             next;
    120         }
    121        
    122         my ($text, $value, $done) = ($d, "${pfx}${d}", 1);
    123 
    124         if (-d "$dir/$d") {
    125             $text .= "/";
    126             $value .= "/";
    127             $done = 0;
    128         }
    129         push @out, [$text, $value, $done];
    130     }
    131     return @out;
    132 }

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

    r416241f r618a980  
    137137}
    138138
    139 =head2 mk_irc_command SUB FLAGS
    140 
    141 Return a subroutine that can be bound as a an IRC command. The
    142 subroutine will be called with arguments (COMMAND-NAME,
    143 IRC-CONNECTION, [CHANNEL], ARGV...).
    144 
    145 C<IRC-CONNECTION> and C<CHANNEL> will be inferred from arguments to
    146 the command and the current message if appropriate.
    147 
    148 The bitwise C<or> of zero or more C<FLAGS> can be passed in as a
    149 second argument to alter the behavior of the returned commands:
    150 
    151 =over 4
    152 
    153 =item C<CHANNEL_ARG>
    154 
    155 This command accepts the name of a channel. Pass in the C<CHANNEL>
    156 argument listed above, and die if no channel argument can be found.
    157 
    158 =item C<CHANNEL_OPTIONAL>
    159 
    160 Pass the channel argument, but don't die if not present. Only relevant
    161 with C<CHANNEL_ARG>.
    162 
    163 =item C<ALLOW_DISCONNECTED>
    164 
    165 C<IRC-CONNECTION> may be a disconnected connection object that is
    166 currently pending a reconnect.
    167 
    168 =back
    169 
    170 =cut
    171 
    172 use constant CHANNEL_ARG        => 1;
    173 use constant CHANNEL_OPTIONAL   => 2;
    174 
    175 use constant ALLOW_DISCONNECTED => 4;
     139use constant OPTIONAL_CHANNEL => 1;
     140use constant REQUIRE_CHANNEL => 2;
    176141
    177142sub register_commands {
    … …  
    202167
    203168    BarnOwl::new_command(
    204         'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
     169        'irc-disconnect' => \&cmd_disconnect,
    205170        {
    206171            summary => 'Disconnect from an IRC server',
    … …  
    227192
    228193    BarnOwl::new_command(
    229         'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
     194        'irc-mode' => mk_irc_command( \&cmd_mode, OPTIONAL_CHANNEL ),
    230195        {
    231196            summary => 'Change an IRC channel or user mode',
    … …  
    251216
    252217    BarnOwl::new_command(
    253         'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
     218        'irc-part' => mk_irc_command( \&cmd_part, REQUIRE_CHANNEL ),
    254219        {
    255220            summary => 'Leave an IRC channel',
    … …  
    276241
    277242    BarnOwl::new_command(
    278         'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
     243        'irc-names' => mk_irc_command( \&cmd_names, REQUIRE_CHANNEL ),
    279244        {
    280245            summary => 'View the list of users in a channel',
    … …  
    329294
    330295    BarnOwl::new_command(
    331         'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
     296        'irc-topic' => mk_irc_command( \&cmd_topic, REQUIRE_CHANNEL ),
    332297        {
    333298            summary => 'View or change the topic of an IRC channel',
    … …  
    426391
    427392sub cmd_disconnect {
    428     my $cmd = shift;
    429     my $conn = shift;
    430     if ($conn->conn->connected) {
    431         $conn->conn->disconnect;
    432     } elsif ($reconnect{$conn->alias}) {
    433         BarnOwl::admin_message('IRC',
    434                                "[" . $conn->alias . "] Reconnect cancelled");
    435         $conn->cancel_reconnect;
    436     }
     393    # Such a hack
     394    local *get_connection_by_alias = sub {
     395        my $key = shift;
     396        return $ircnets{$key} if exists $ircnets{$key};
     397        return $reconnect{$key}{conn} if exists $reconnect{$key};
     398        die("No such ircnet: $key\n");
     399    };
     400
     401    mk_irc_command(
     402        sub {
     403            my $cmd = shift;
     404            my $conn = shift;
     405            if ($conn->conn->connected) {
     406                $conn->conn->disconnect;
     407            } elsif ($reconnect{$conn->alias}) {
     408                BarnOwl::admin_message('IRC',
     409                                       "[" . $conn->alias . "] Reconnect cancelled");
     410                delete $reconnect{$conn->alias};
     411            }
     412        }
     413    )->(@_);
    437414}
    438415
    … …  
    587564sub mk_irc_command {
    588565    my $sub = shift;
    589     my $flags = shift || 0;
     566    my $use_channel = shift || 0;
    590567    return sub {
    591568        my $cmd = shift;
    … …  
    601578
    602579        if(defined($alias)) {
    603             $conn = get_connection_by_alias($alias,
    604                                             $flags & ALLOW_DISCONNECTED);
    605         }
    606         if($flags & CHANNEL_ARG) {
     580            $conn = get_connection_by_alias($alias);
     581        }
     582        if($use_channel) {
    607583            $channel = $ARGV[0];
    608584            if(defined($channel) && $channel =~ /^#/) {
    … …  
    618594        }
    619595
    620         if(!$channel &&
    621            ($flags & CHANNEL_ARG) &&
    622            !($flags & CHANNEL_OPTIONAL)) {
     596        if(!$channel && $use_channel == REQUIRE_CHANNEL) {
    623597            die("Usage: $cmd <channel>\n");
    624598        }
    625599        if(!$conn) {
    626600            if($m && $m->type eq 'IRC') {
    627                 $conn = get_connection_by_alias($m->network,
    628                                                $flags & ALLOW_DISCONNECTED);
     601                $conn = get_connection_by_alias($m->network);
    629602            }
    630603        }
    … …  
    635608            die("You must specify an IRC network using -a.\n");
    636609        }
    637         if($flags & CHANNEL_ARG) {
     610        if($use_channel) {
    638611            $sub->($cmd, $conn, $channel, @ARGV);
    639612        } else {
    … …  
    645618sub get_connection_by_alias {
    646619    my $key = shift;
    647     my $allow_disconnected = shift;
    648 
    649     return $ircnets{$key} if exists $ircnets{$key};
    650     return $reconnect{$key} if $allow_disconnected && exists $reconnect{$key};
    651     die("No such ircnet: $key\n")
     620    die("No such ircnet: $key\n") unless exists $ircnets{$key};
     621    return $ircnets{$key};
    652622}
    653623

  • perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm

    r416241f r618a980  
    2323
    2424use BarnOwl;
    25 use Scalar::Util qw(weaken);
    2625
    2726BEGIN {
    … …  
    316315    my $interval = shift || 5;
    317316    delete $BarnOwl::Module::IRC::ircnets{$self->alias};
    318     $BarnOwl::Module::IRC::reconnect{$self->alias} = $self;
    319     my $weak = $self;
    320     weaken($weak);
    321     $self->{reconnect_timer} =
     317    $BarnOwl::Module::IRC::reconnect{$self->alias} =
    322318        BarnOwl::Timer->new( {
    323319            after => $interval,
    324320            cb    => sub {
    325                 $weak->reconnect( $interval ) if $weak;
     321                $self->reconnect( $interval );
    326322            },
    327323        } );
    328 }
    329 
    330 sub cancel_reconnect {
    331     my $self = shift;
    332     delete $BarnOwl::Module::IRC::reconnect{$self->alias};
    333     delete $self->{reconnect_timer};
     324    $BarnOwl::Module::IRC::reconnect{$self->alias}{conn} = $self;
    334325}
    335326
    … …  
    338329    my $msg = shift;
    339330    BarnOwl::admin_message("IRC", $msg);
    340     $self->cancel_reconnect;
     331    delete $BarnOwl::Module::IRC::reconnect{$self->alias};
    341332    $BarnOwl::Module::IRC::ircnets{$self->alias} = $self;
    342333    my $fd = $self->getSocket()->fileno();

  • scripts/do-release

    rd771d1b r01846ce  
    3131if [ ! "$force" ] && [ "$VERS" != "$(head -1 ChangeLog)" ]; then
    3232    die "No ChangeLog entry for version $VERS, aborting."
    33 fi
    34 
    35 head=$(git symbolic-ref HEAD)
    36 head=${head#refs/heads/}
    37 
    38 git rev-parse --verify -q $head >/dev/null 2>&1
    39 git rev-parse --verify -q origin/$head >/dev/null 2>&1
    40 if [ -n "$(git rev-list $head..origin/$head)" ]; then
    41     die "$head is not up to date. Aborting."
    4233fi
    4334

  • t/completion.t

    re6cec01 r1167bf1  
    289289              \&complete_filter_expr);
    290290
    291 # Test complete_files
    292 use BarnOwl::Completion::Util qw(complete_file);
    293 use File::Temp;
    294 use File::Path qw(mkpath);
    295 
    296 my $tmpdir = File::Temp::tempdir(CLEANUP => 1);
    297 
    298 # Make sure $tmpdir does not have a trailing /
    299 $tmpdir =~ s{/$}{};
    300 $ENV{HOME} = $tmpdir;
    301 
    302 sub touch {
    303     my $path = shift;
    304     system("touch", "$path");
    305 }
    306 
    307 mkpath("$tmpdir/.owl/",
    308        "$tmpdir/.owl/modules/",
    309        "$tmpdir/Public/",
    310        "$tmpdir/Private/",
    311        "$tmpdir/.ours",
    312        "$tmpdir/www");
    313 touch("$tmpdir/.zephyr.subs");
    314 touch("$tmpdir/wheee");
    315 touch("$tmpdir/.owl/startup");
    316 
    317 sub completion_value {
    318     my $c = shift;
    319     return $c unless ref($c) eq 'ARRAY';
    320     return $c->[1];
    321 }
    322 
    323 sub test_file {
    324     my $spec  = shift;
    325     my $pfx   = shift;
    326     my $dirs  = shift;
    327     my $files = shift;
    328 
    329     my $expect = [ sort {$a->[1] cmp $b->[1]}
    330         ((map {["$_/", defined($pfx)?"$pfx/$_/":"$_/", 0]} @$dirs),
    331          (map {["$_",  defined($pfx)?"$pfx/$_" :$_   , 1]} @$files))
    332        ];
    333 
    334     local $Test::Builder::Level = $Test::Builder::Level + 1;
    335 
    336     my @got = complete_file($spec);
    337 
    338     @got = grep {completion_value($_) =~ m{^\Q$spec\E}} @got;
    339     @got = sort {completion_value($a) cmp completion_value($b)} @got;
    340 
    341     use Data::Dumper;
    342     is_deeply(\@got, $expect);
    343 }
    344 
    345 is_deeply([complete_file("~")], [["~/", "~/", 0]]);
    346 
    347 chdir($tmpdir);
    348 test_file("$tmpdir/", $tmpdir,
    349           [qw(Public Private www)],
    350           [qw(wheee)]);
    351 
    352 test_file("./", ".",
    353           [qw(Public Private www)],
    354           [qw(wheee)]);
    355 
    356 test_file("", undef, [qw(Public Private www)], [qw(wheee)]);
    357 
    358 test_file("./.owl/", "./.owl",
    359           [qw(modules)],
    360           [qw(startup)]);
    361 
    362 test_file("~/", "~",
    363           [qw(Public Private www)],
    364           [qw(wheee)]);
    365 
    366 test_file("P", undef, [qw(Public Private)], []);
    367 
    368 test_file("$tmpdir/.", $tmpdir,
    369           [qw(. .. .owl .ours)],
    370           [qw(.zephyr.subs)]);
    3712911;
    372292
Note: See TracChangeset for help on using the changeset viewer.