dcc18377281507e8013ed744c94b58ff29c36d6b
[p5sagit/Devel-REPL.git] / lib / Devel / REPL / Plugin / Completion.pm
1 package Devel::REPL::Plugin::Completion;
2 use Devel::REPL::Plugin;
3 use Scalar::Util 'weaken';
4 use PPI;
5 use namespace::autoclean;
6
7 has current_matches => (
8    is => 'rw',
9    isa => 'ArrayRef',
10    lazy => 1,
11    default => sub { [] },
12 );
13
14 has match_index => (
15    is => 'rw',
16    isa => 'Int',
17    lazy => 1,
18    default => sub { 0 },
19 );
20
21 has no_term_class_warning => (
22    isa => "Bool",
23    is  => "rw",
24    default => 0,
25 );
26
27 has do_readline_filename_completion => (  # so default is no if Completion loaded
28    isa => "Bool",
29    is  => "rw",
30    lazy => 1,
31    default => sub { 0 },
32 );
33
34 before 'read' => sub {
35    my ($self) = @_;
36
37    if ((!$self->term->isa("Term::ReadLine::Gnu") and !$self->term->isa("Term::ReadLine::Perl"))
38          and !$self->no_term_class_warning) {
39       warn "Term::ReadLine::Gnu or Term::ReadLine::Perl is required for the Completion plugin to work";
40       $self->no_term_class_warning(1);
41    }
42
43    my $weakself = $self;
44    weaken($weakself);
45
46    if ($self->term->isa("Term::ReadLine::Gnu")) {
47       $self->term->Attribs->{attempted_completion_function} = sub {
48          $weakself->_completion(@_);
49       };
50    }
51
52    if ($self->term->isa("Term::ReadLine::Perl")) {
53       $self->term->Attribs->{completion_function} = sub {
54          $weakself->_completion(@_);
55       };
56    }
57
58 };
59
60 sub _completion {
61    my $is_trp = scalar(@_) == 4 ? 1 : 0;
62    my ($self, $text, $line, $start, $end) = @_;
63    $end = $start+length($text) if $is_trp;
64
65    # we're discarding everything after the cursor for completion purposes
66    # we can't just use $text because we want all the code before the cursor to
67    # matter, not just the current word
68    substr($line, $end) = '';
69
70    my $document = PPI::Document->new(\$line);
71    return unless defined($document);
72
73    $document->prune('PPI::Token::Whitespace');
74
75    my @matches = $self->complete($text, $document);
76
77    # iterate through the completions
78    if ($is_trp) {
79       if (scalar(@matches)) {
80          return @matches;
81       } else {
82          return ($self->do_readline_filename_completion) ? readline::rl_filename_list($text) : () ;
83       }
84    } else {
85       $self->term->Attribs->{attempted_completion_over} = 1 unless $self->do_readline_filename_completion;
86       if (scalar(@matches)) {
87          return $self->term->completion_matches($text, sub {
88                my ($text, $state) = @_;
89
90                if (!$state) {
91                   $self->current_matches(\@matches);
92                   $self->match_index(0);
93                }
94                else {
95                   $self->match_index($self->match_index + 1);
96                }
97
98                return $self->current_matches->[$self->match_index];
99             });
100       } else {
101          return;
102       }
103    }
104 }
105
106 sub complete {
107    return ();
108 }
109
110 # recursively find the last element
111 sub last_ppi_element {
112    my ($self, $document, $type) = @_;
113    my $last = $document;
114    while ($last->can('last_element') && defined($last->last_element)) {
115       $last = $last->last_element;
116       return $last if $type && $last->isa($type);
117    }
118    return $last;
119 }
120
121 1;
122
123 __END__
124
125 =head1 NAME
126
127 Devel::REPL::Plugin::Completion - Extensible tab completion
128
129 =head1 NOTE
130
131 By default, the Completion plugin explicitly does I<not> use the Gnu readline
132 or Term::ReadLine::Perl fallback filename completion.
133
134 Set the attribute C<do_readline_filename_completion> to 1 to enable this feature.
135
136 =head1 AUTHOR
137
138 Shawn M Moore, C<< <sartak at gmail dot com> >>
139
140 =cut
141