source: perl/lib/BarnOwl/Completion/Context.pm @ af21934

release-1.6release-1.7release-1.8release-1.9
Last change on this file since af21934 was af21934, checked in by David Benjamin <davidben@mit.edu>, 11 years ago
Fix leading whitespace in tokenizer and refactor Should make tests pass. Leading whitespace now works. Also, we remove the dummy '' append in tokenize() and move it as a post-processing step in Context::new. This is so tokenize() is a little more generic. Signed-off-by: David Benjamin <davidben@mit.edu>
  • Property mode set to 100644
File size: 4.2 KB
Line 
1use warnings;
2use strict;
3
4=head1 NAME
5
6BarnOwl::Completion::Context
7
8=head1 DESCRIPTION
9
10BarnOwl::Completion::Context is the context that is passed to a
11completion function by BarnOwl. It contains information on the text
12being completed.
13
14=head1 METHODS
15
16=head2 line
17
18The entire command-line currently being completed.
19
20=head2 point
21
22The index of the cursor in C<line>, in the range C<[0,len($line)]>.
23
24=head2 words
25
26The current command-line, tokenized according to BarnOwl's
27tokenization rules, as an array reference.
28
29=head2 word
30
31The current word the point is sitting in, as an index into C<words>.
32
33=head2 word_point
34
35The index of the point within C<$words->[$word]>.
36
37=cut
38
39package BarnOwl::Completion::Context;
40
41use base qw(Class::Accessor::Fast);
42use Carp qw(croak);
43
44__PACKAGE__->mk_ro_accessors(qw(line point words word word_point
45                                word_start word_end));
46
47sub new {
48    my $class = shift;
49    my $before_point = shift;
50    my $after_point = shift;
51
52    my $line  = $before_point . $after_point;
53    my $point = length ($before_point);
54    my ($words, $word, $word_point,
55        $word_start, $word_end) = tokenize($line, $point);
56    push @$words, '' if scalar @$words <= $word;
57
58    my $self = {
59        line  => $line,
60        point => $point,
61        words => $words,
62        word  => $word,
63        word_point => $word_point,
64        word_start => $word_start,
65        word_end   => $word_end
66       };
67    return bless($self, $class);
68}
69
70=head2 shift_words N
71
72Returns a new C<Context> object, with the leading C<N> words
73stripped. All fields are updated as appopriate. If C<N> > C<<
74$self->word >>, C<croak>s with an error message.
75
76=cut
77
78sub shift_words {
79    my $self = shift;
80    my $n    = shift;
81
82    if($n > $self->word) {
83        croak "Context::shift: Unable to shift $n words";
84    }
85
86    my $before = substr($self->line, 0, $self->point);
87    my $after  = substr($self->line, $self->point);
88
89    return BarnOwl::Completion::Context->new(BarnOwl::skiptokens($before, $n),
90                                             $after);
91}
92
93=for doc
94
95Ideally, this should use the same codepath we use to /actually/
96tokenize commands, but for now, make sure this is kept in sync with
97owl_parseline in util.c
98
99Unlike owl_parseline, we always return a result, even in the presence
100of parse errors, since we may be called on incomplete command-lines.
101
102The owl_parseline rules are:
103
104* Tokenize on ' ' and '\t'
105* ' and " are quote characters
106* \ has no effect
107
108=cut
109
110my $boring = qr{[^'" \t]};
111my $quote  = qr{['"]};
112my $space  = qr{[ \t]};
113
114sub tokenize {
115    my $line = shift;
116    my $point = shift;
117
118    my @words = ();
119    my $cword = 0;
120    my $cword_start;
121    my $cword_end;
122    my $word_point;
123
124    my $word = '';
125    my $wstart = 0;
126    my $skipped = 0;
127    my $have_word = 0;
128
129    pos($line) = 0;
130    while(pos($line) < length($line)) {
131        if($line =~ m{\G ($boring+) }gcx) {
132            $word .= $1;
133            $have_word = 1;
134        } elsif ($line =~ m{\G ($quote)}gcx) {
135            my $chr = $1;
136            $skipped++ if pos($line) > $point;
137            if($line =~ m{\G ([^$chr]*) $chr}gcx) {
138                $word .= $1;
139                $skipped++ if pos($line) > $point;
140            } else {
141                $word .= substr($line, pos($line));
142                pos($line) = length($line);
143            }
144            $have_word = 1;
145        }
146
147        if ($line =~ m{\G ($space+|$)}gcx) {
148            my $wend = pos($line) - length($1);
149            if ($have_word) {
150                push @words, $word;
151                $cword++ unless $wend >= $point;
152                if(($wend >= $point) && !defined($word_point)) {
153                    $word_point = length($word) - ($wend - $point) + $skipped;
154                    $cword_start = $wstart;
155                    $cword_end   = $wend;
156                }
157            }
158            # Always reset, so we get $wstart right
159            $word = '';
160            $wstart = pos($line);
161            $skipped = 0;
162            $have_word = 0;
163        }
164    }
165
166    if(length($word)) { die("Internal error, leftover=$word"); }
167
168    unless(defined($word_point)) {
169        $word_point = 0;
170        $cword_start = $cword_end = $point;
171    }
172
173    return (\@words, $cword, $word_point, $cword_start, $cword_end);
174}
175
1761;
Note: See TracBrowser for help on using the repository browser.