Changeset 85fa6e4


Ignore:
Timestamp:
Dec 30, 2009, 1:59:57 PM (15 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, release-1.10, release-1.6, release-1.7, release-1.8, release-1.9
Children:
814aca1
Parents:
416241f (diff), 460fbe8 (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 'release-1.5'
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • editwin.c

    rc471e85 r460fbe8  
    251251  e->lock=e->bufflen;
    252252  oe_set_index(e, e->lock);
     253  e->topindex = 0;
    253254  owl_editwin_redisplay(e, 0);
    254255}
    … …  
    470471static void oe_reframe(owl_editwin *e) {
    471472  oe_excursion x;
    472   int goal = e->winlines / 2;
     473  int goal = 1 + e->winlines / 2;
    473474  int index;
    474475  int count = 0;

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

    r0cfa6ee rb84feab  
    12291229    $props{xml}        = $j->GetXML();
    12301230
    1231     if ( $jtype eq 'chat' ) {
     1231    if ( $jtype eq 'groupchat' ) {
     1232        my $nick = $props{nick} = $from->GetResource();
     1233        my $room = $props{room} = $from->GetJID('base');
     1234        $completion_jids{$room} = 1;
     1235
     1236        $props{sender} = $nick || $room;
     1237        $props{recipient} = $room;
     1238
     1239        if ( $props{subject} && !$props{body} ) {
     1240            $props{body} =
     1241              '[' . $nick . " has set the topic to: " . $props{subject} . "]";
     1242        }
     1243    }
     1244    elsif ( $jtype eq 'headline' ) {
     1245        ;
     1246    }
     1247    elsif ( $jtype eq 'error' ) {
     1248        $props{body}     = "Error "
     1249          . $props{error_code}
     1250          . " sending to "
     1251          . $props{from} . "\n"
     1252          . $props{error};
     1253    }
     1254    else { # chat, or normal (default)
    12321255        $props{private} = 1;
    12331256
    … …  
    12561279            $completion_jids{ $props{recipient} } = 1;
    12571280        }
    1258     }
    1259     elsif ( $jtype eq 'groupchat' ) {
    1260         my $nick = $props{nick} = $from->GetResource();
    1261         my $room = $props{room} = $from->GetJID('base');
    1262         $completion_jids{$room} = 1;
    1263 
    1264         $props{sender} = $nick || $room;
    1265         $props{recipient} = $room;
    1266 
    1267         if ( $props{subject} && !$props{body} ) {
    1268             $props{body} =
    1269               '[' . $nick . " has set the topic to: " . $props{subject} . "]";
    1270         }
    1271     }
    1272     elsif ( $jtype eq 'normal' ) {
    1273         $props{private} = 1;
    1274     }
    1275     elsif ( $jtype eq 'headline' ) {
    1276     }
    1277     elsif ( $jtype eq 'error' ) {
    1278         $props{body}     = "Error "
    1279           . $props{error_code}
    1280           . " sending to "
    1281           . $props{from} . "\n"
    1282           . $props{error};
    12831281    }
    12841282

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

    rdab89e28 rdc8f6e0  
    66package BarnOwl::Complete::Client;
    77
    8 use BarnOwl::Completion::Util qw(complete_flags);
     8use BarnOwl::Completion::Util qw(complete_flags complete_file);
    99use BarnOwl::Complete::Filter qw(complete_filter_name complete_filter_expr);
    1010
    … …  
    167167}
    168168
     169sub 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
     185sub complete_print {
     186    my $ctx = shift;
     187    return unless $ctx->word == 1;
     188    return complete_variable();
     189}
     190
     191sub complete_one_file_arg {
     192    my $ctx = shift;
     193    return unless $ctx->word == 1;
     194    return complete_file($ctx->words->[1]);
     195}
     196
    169197BarnOwl::Completion::register_completer(help    => \&complete_help);
    170198BarnOwl::Completion::register_completer(filter  => \&complete_filter);
    … …  
    178206BarnOwl::Completion::register_completer(unset   => \&complete_set);
    179207BarnOwl::Completion::register_completer(startup => \&complete_startup);
     208BarnOwl::Completion::register_completer(bindkey => \&complete_bindkey);
     209BarnOwl::Completion::register_completer(print   => \&complete_print);
     210
     211BarnOwl::Completion::register_completer(source      => \&complete_one_file_arg);
     212BarnOwl::Completion::register_completer('load-subs' => \&complete_one_file_arg);
     213BarnOwl::Completion::register_completer(loadsubs    => \&complete_one_file_arg);
     214BarnOwl::Completion::register_completer(loadloginsubs    => \&complete_one_file_arg);
     215BarnOwl::Completion::register_completer(dump        => \&complete_one_file_arg);
    180216
    1812171;

  • perl/lib/BarnOwl/Completion.pm

    r48d130b r880311d  
    3131    my @words = get_completions($ctx);
    3232    return unless @words;
    33     my $prefix = common_prefix(@words);
     33    my $prefix = common_prefix(map {completion_value($_)} @words);
    3434
    3535    if($prefix) {
    36         insert_completion($ctx, $prefix, scalar @words == 1);
     36        insert_completion($ctx, $prefix,
     37                          scalar @words == 1 && completion_done($words[0]));
    3738    }
    3839
    … …  
    4445}
    4546
     47=head1 COMPLETIONS
     48
     49A COMPLETION is either a simple string, or a reference to an array
     50containing two or more values.
     51
     52In the former case, the string use used for both the text to display,
     53as well as the result of the completion, and is assumed to be a full
     54completion.
     55
     56An 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
     62is only a single completion for a given word, a space will be appended
     63after the completion iff $completion_done is true (or missing).
     64
     65=cut
     66
     67sub completion_text {
     68    my $c = shift;
     69    return $c unless ref($c) eq 'ARRAY';
     70    return $c->[0];
     71}
     72
     73sub completion_value {
     74    my $c = shift;
     75    return $c unless ref($c) eq 'ARRAY';
     76    return $c->[1];
     77}
     78
     79sub completion_done {
     80    my $c = shift;
     81    return 1 if ref($c) ne 'ARRAY' or @$c < 3;
     82    return $c->[2];
     83}
     84
    4685sub insert_completion {
    4786    my $ctx = shift;
    48     my $completion = BarnOwl::quote(shift);
    49     my $unique = shift;
     87    my $completion = BarnOwl::quote(completion_value(shift));
     88    my $done = shift;
    5089
    51     if($unique) {
     90    if($done) {
    5291        $completion .= " ";
    5392    }
    … …  
    66105sub show_completions {
    67106    my @words = @_;
    68     my $all = BarnOwl::quote(@words);
     107    my $all = BarnOwl::quote(map {completion_text($_)} @words);
    69108    my $width = BarnOwl::getnumcols();
    70109    if (length($all) > $width-1) {
    … …  
    98137        my $word = $ctx->words->[$ctx->word];
    99138        if(exists($completers{$cmd})) {
    100             return grep {$_ =~ m{^\Q$word\E}} $completers{$cmd}->($ctx);
     139            return grep {completion_value($_) =~ m{^\Q$word\E}} $completers{$cmd}->($ctx);
    101140        }
    102141        return;

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

    r69c27e6 re6cec01  
    55
    66use base qw(Exporter);
    7 our @EXPORT_OK = qw(complete_flags);
     7our @EXPORT_OK = qw(complete_flags complete_file);
    88
    99use Getopt::Long;
     10use Cwd qw(abs_path);
     11use File::Basename qw(dirname basename);
     12
    1013
    1114sub complete_flags {
    … …  
    6770    }
    6871}
     72
     73sub 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
     86sub splitfile {
     87    my $path = shift;
     88    if ($path =~ m{^(.*/)([^/]*)$}) {
     89        return ($1, $2);
     90    } else {
     91        return ('', $path);
     92    }
     93}
     94
     95sub 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

    r618a980 r416241f  
    137137}
    138138
    139 use constant OPTIONAL_CHANNEL => 1;
    140 use constant REQUIRE_CHANNEL => 2;
     139=head2 mk_irc_command SUB FLAGS
     140
     141Return a subroutine that can be bound as a an IRC command. The
     142subroutine will be called with arguments (COMMAND-NAME,
     143IRC-CONNECTION, [CHANNEL], ARGV...).
     144
     145C<IRC-CONNECTION> and C<CHANNEL> will be inferred from arguments to
     146the command and the current message if appropriate.
     147
     148The bitwise C<or> of zero or more C<FLAGS> can be passed in as a
     149second argument to alter the behavior of the returned commands:
     150
     151=over 4
     152
     153=item C<CHANNEL_ARG>
     154
     155This command accepts the name of a channel. Pass in the C<CHANNEL>
     156argument listed above, and die if no channel argument can be found.
     157
     158=item C<CHANNEL_OPTIONAL>
     159
     160Pass the channel argument, but don't die if not present. Only relevant
     161with C<CHANNEL_ARG>.
     162
     163=item C<ALLOW_DISCONNECTED>
     164
     165C<IRC-CONNECTION> may be a disconnected connection object that is
     166currently pending a reconnect.
     167
     168=back
     169
     170=cut
     171
     172use constant CHANNEL_ARG        => 1;
     173use constant CHANNEL_OPTIONAL   => 2;
     174
     175use constant ALLOW_DISCONNECTED => 4;
    141176
    142177sub register_commands {
    … …  
    167202
    168203    BarnOwl::new_command(
    169         'irc-disconnect' => \&cmd_disconnect,
     204        'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
    170205        {
    171206            summary => 'Disconnect from an IRC server',
    … …  
    192227
    193228    BarnOwl::new_command(
    194         'irc-mode' => mk_irc_command( \&cmd_mode, OPTIONAL_CHANNEL ),
     229        'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
    195230        {
    196231            summary => 'Change an IRC channel or user mode',
    … …  
    216251
    217252    BarnOwl::new_command(
    218         'irc-part' => mk_irc_command( \&cmd_part, REQUIRE_CHANNEL ),
     253        'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
    219254        {
    220255            summary => 'Leave an IRC channel',
    … …  
    241276
    242277    BarnOwl::new_command(
    243         'irc-names' => mk_irc_command( \&cmd_names, REQUIRE_CHANNEL ),
     278        'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
    244279        {
    245280            summary => 'View the list of users in a channel',
    … …  
    294329
    295330    BarnOwl::new_command(
    296         'irc-topic' => mk_irc_command( \&cmd_topic, REQUIRE_CHANNEL ),
     331        'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
    297332        {
    298333            summary => 'View or change the topic of an IRC channel',
    … …  
    391426
    392427sub cmd_disconnect {
    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     )->(@_);
     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    }
    414437}
    415438
    … …  
    564587sub mk_irc_command {
    565588    my $sub = shift;
    566     my $use_channel = shift || 0;
     589    my $flags = shift || 0;
    567590    return sub {
    568591        my $cmd = shift;
    … …  
    578601
    579602        if(defined($alias)) {
    580             $conn = get_connection_by_alias($alias);
    581         }
    582         if($use_channel) {
     603            $conn = get_connection_by_alias($alias,
     604                                            $flags & ALLOW_DISCONNECTED);
     605        }
     606        if($flags & CHANNEL_ARG) {
    583607            $channel = $ARGV[0];
    584608            if(defined($channel) && $channel =~ /^#/) {
    … …  
    594618        }
    595619
    596         if(!$channel && $use_channel == REQUIRE_CHANNEL) {
     620        if(!$channel &&
     621           ($flags & CHANNEL_ARG) &&
     622           !($flags & CHANNEL_OPTIONAL)) {
    597623            die("Usage: $cmd <channel>\n");
    598624        }
    599625        if(!$conn) {
    600626            if($m && $m->type eq 'IRC') {
    601                 $conn = get_connection_by_alias($m->network);
     627                $conn = get_connection_by_alias($m->network,
     628                                               $flags & ALLOW_DISCONNECTED);
    602629            }
    603630        }
    … …  
    608635            die("You must specify an IRC network using -a.\n");
    609636        }
    610         if($use_channel) {
     637        if($flags & CHANNEL_ARG) {
    611638            $sub->($cmd, $conn, $channel, @ARGV);
    612639        } else {
    … …  
    618645sub get_connection_by_alias {
    619646    my $key = shift;
    620     die("No such ircnet: $key\n") unless exists $ircnets{$key};
    621     return $ircnets{$key};
     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")
    622652}
    623653

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

    r618a980 r416241f  
    2323
    2424use BarnOwl;
     25use Scalar::Util qw(weaken);
    2526
    2627BEGIN {
    … …  
    315316    my $interval = shift || 5;
    316317    delete $BarnOwl::Module::IRC::ircnets{$self->alias};
    317     $BarnOwl::Module::IRC::reconnect{$self->alias} =
     318    $BarnOwl::Module::IRC::reconnect{$self->alias} = $self;
     319    my $weak = $self;
     320    weaken($weak);
     321    $self->{reconnect_timer} =
    318322        BarnOwl::Timer->new( {
    319323            after => $interval,
    320324            cb    => sub {
    321                 $self->reconnect( $interval );
     325                $weak->reconnect( $interval ) if $weak;
    322326            },
    323327        } );
    324     $BarnOwl::Module::IRC::reconnect{$self->alias}{conn} = $self;
     328}
     329
     330sub cancel_reconnect {
     331    my $self = shift;
     332    delete $BarnOwl::Module::IRC::reconnect{$self->alias};
     333    delete $self->{reconnect_timer};
    325334}
    326335
    … …  
    329338    my $msg = shift;
    330339    BarnOwl::admin_message("IRC", $msg);
    331     delete $BarnOwl::Module::IRC::reconnect{$self->alias};
     340    $self->cancel_reconnect;
    332341    $BarnOwl::Module::IRC::ircnets{$self->alias} = $self;
    333342    my $fd = $self->getSocket()->fileno();

  • scripts/do-release

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

  • t/completion.t

    r1167bf1 re6cec01  
    289289              \&complete_filter_expr);
    290290
     291# Test complete_files
     292use BarnOwl::Completion::Util qw(complete_file);
     293use File::Temp;
     294use File::Path qw(mkpath);
     295
     296my $tmpdir = File::Temp::tempdir(CLEANUP => 1);
     297
     298# Make sure $tmpdir does not have a trailing /
     299$tmpdir =~ s{/$}{};
     300$ENV{HOME} = $tmpdir;
     301
     302sub touch {
     303    my $path = shift;
     304    system("touch", "$path");
     305}
     306
     307mkpath("$tmpdir/.owl/",
     308       "$tmpdir/.owl/modules/",
     309       "$tmpdir/Public/",
     310       "$tmpdir/Private/",
     311       "$tmpdir/.ours",
     312       "$tmpdir/www");
     313touch("$tmpdir/.zephyr.subs");
     314touch("$tmpdir/wheee");
     315touch("$tmpdir/.owl/startup");
     316
     317sub completion_value {
     318    my $c = shift;
     319    return $c unless ref($c) eq 'ARRAY';
     320    return $c->[1];
     321}
     322
     323sub 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
     345is_deeply([complete_file("~")], [["~/", "~/", 0]]);
     346
     347chdir($tmpdir);
     348test_file("$tmpdir/", $tmpdir,
     349          [qw(Public Private www)],
     350          [qw(wheee)]);
     351
     352test_file("./", ".",
     353          [qw(Public Private www)],
     354          [qw(wheee)]);
     355
     356test_file("", undef, [qw(Public Private www)], [qw(wheee)]);
     357
     358test_file("./.owl/", "./.owl",
     359          [qw(modules)],
     360          [qw(startup)]);
     361
     362test_file("~/", "~",
     363          [qw(Public Private www)],
     364          [qw(wheee)]);
     365
     366test_file("P", undef, [qw(Public Private)], []);
     367
     368test_file("$tmpdir/.", $tmpdir,
     369          [qw(. .. .owl .ours)],
     370          [qw(.zephyr.subs)]);
    2913711;
    292372
Note: See TracChangeset for help on using the changeset viewer.