source: perl/lib/BarnOwl/Completion.pm @ 6e48560

release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 6e48560 was 6e48560, checked in by Nelson Elhage <nelhage@mit.edu>, 12 years ago
Implement tab completion for command names.
  • Property mode set to 100644
File size: 1.8 KB
Line 
1use warnings;
2use strict;
3
4=head1 NAME
5
6BarnOwl::Completion
7
8=head1 DESCRIPTION
9
10Hooks for tab-completion support in BarnOwl.
11
12=cut
13
14package BarnOwl::Completion;
15
16use BarnOwl::Completion::Context;
17use BarnOwl::Editwin qw(text_before_point text_after_point);
18
19use List::Util qw(max first);
20
21sub do_complete {
22    my $cmd = shift;
23    my $before = text_before_point();
24    my $after  = text_after_point();
25    BarnOwl::debug("Completing: $before-|-$after");
26    my $ctx = BarnOwl::Completion::Context->new($before, $after);
27
28    my @words = get_completions($ctx);
29    return unless @words;
30    my $prefix = common_prefix(@words);
31
32    my $word = $ctx->words->[$ctx->word];
33
34    if($prefix && $prefix ne $word) {
35        if(scalar @words == 1) {
36            $prefix .= ' ';
37        }
38       
39        BarnOwl::Editwin::insert_text(substr($prefix, length($word)));
40    }
41
42    if(scalar @words > 1) {
43        show_completions(@words);
44    }
45}
46
47sub get_completions {
48    my $ctx = shift;
49    if($ctx->word == 0) {
50        return complete_command($ctx->words->[0]);
51    } else {
52        return;
53    }
54}
55
56sub complete_command {
57    my $cmd = shift;
58    return grep {$_ =~ m{^\Q$cmd\E}} @BarnOwl::all_commands;
59}
60
61sub show_completions {
62    my @words = @_;
63    my $all = join(" ", map {BarnOwl::quote($_)} @words);
64    my $width = BarnOwl::getnumcols();
65    if (length($all) > $width-1) {
66        $all = substr($all, 0, $width-4) . "...";
67    }
68    BarnOwl::message($all);
69}
70
71sub common_prefix {
72    my @words = @_;
73    my $len   = max(map {length($_)} @words);
74    my $pfx = '';
75    for my $i (1..$len) {
76        $pfx = substr($words[0], 0, $i);
77        if(first {substr($_, 0, $i) ne $pfx} @words) {
78            $pfx = substr($pfx, 0, $i-1);
79            last;
80        }
81    }
82
83    return $pfx;
84}
85
861;
Note: See TracBrowser for help on using the repository browser.