[8eac1a5] | 1 | use warnings; |
---|
| 2 | use strict; |
---|
| 3 | |
---|
| 4 | =head1 NAME |
---|
| 5 | |
---|
| 6 | BarnOwl::Completion::Context |
---|
| 7 | |
---|
| 8 | =head1 DESCRIPTION |
---|
| 9 | |
---|
| 10 | BarnOwl::Completion::Context is the context that is passed to a |
---|
| 11 | completion function by BarnOwl. It contains information on the text |
---|
| 12 | being completed. |
---|
| 13 | |
---|
| 14 | =head1 METHODS |
---|
| 15 | |
---|
| 16 | =head2 line |
---|
| 17 | |
---|
| 18 | The entire command-line currently being completed. |
---|
| 19 | |
---|
| 20 | =head2 point |
---|
| 21 | |
---|
| 22 | The index of the cursor in C<line>, in the range C<[0,len($line)]>. |
---|
| 23 | |
---|
| 24 | =head2 words |
---|
| 25 | |
---|
| 26 | The current command-line, tokenized according to BarnOwl's |
---|
| 27 | tokenization rules, as an array reference. |
---|
| 28 | |
---|
| 29 | =head2 word |
---|
| 30 | |
---|
| 31 | The current word the point is sitting in, as an index into C<words>. |
---|
| 32 | |
---|
| 33 | =head2 word_point |
---|
| 34 | |
---|
| 35 | The index of the point within C<$words->[$word]>. |
---|
| 36 | |
---|
| 37 | =cut |
---|
| 38 | |
---|
| 39 | package BarnOwl::Completion::Context; |
---|
| 40 | |
---|
| 41 | use base qw(Class::Accessor::Fast); |
---|
[e97c5d05] | 42 | use Carp qw(croak); |
---|
[8eac1a5] | 43 | |
---|
[13614e7] | 44 | __PACKAGE__->mk_ro_accessors(qw(line point words word word_point |
---|
| 45 | word_start word_end)); |
---|
[8eac1a5] | 46 | |
---|
| 47 | sub 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); |
---|
[13614e7] | 54 | my ($words, $word, $word_point, |
---|
| 55 | $word_start, $word_end) = tokenize($line, $point); |
---|
[8eac1a5] | 56 | |
---|
| 57 | my $self = { |
---|
| 58 | line => $line, |
---|
| 59 | point => $point, |
---|
| 60 | words => $words, |
---|
| 61 | word => $word, |
---|
[13614e7] | 62 | word_point => $word_point, |
---|
| 63 | word_start => $word_start, |
---|
| 64 | word_end => $word_end |
---|
[8eac1a5] | 65 | }; |
---|
| 66 | return bless($self, $class); |
---|
| 67 | } |
---|
| 68 | |
---|
[e97c5d05] | 69 | =head2 shift_words N |
---|
| 70 | |
---|
| 71 | Returns a new C<Context> object, with the leading C<N> words |
---|
| 72 | stripped. All fields are updated as appopriate. If C<N> > C<< |
---|
| 73 | $self->word >>, C<croak>s with an error message. |
---|
| 74 | |
---|
| 75 | =cut |
---|
| 76 | |
---|
| 77 | sub shift_words { |
---|
| 78 | my $self = shift; |
---|
| 79 | my $n = shift; |
---|
| 80 | |
---|
| 81 | if($n > $self->word) { |
---|
| 82 | croak "Context::shift: Unable to shift $n words"; |
---|
| 83 | } |
---|
| 84 | |
---|
| 85 | my $before = substr($self->line, 0, $self->point); |
---|
| 86 | my $after = substr($self->line, $self->point); |
---|
| 87 | |
---|
| 88 | return BarnOwl::Completion::Context->new(BarnOwl::skiptokens($before, $n), |
---|
| 89 | $after); |
---|
| 90 | } |
---|
| 91 | |
---|
[8eac1a5] | 92 | =for doc |
---|
| 93 | |
---|
| 94 | Ideally, this should use the same codepath we use to /actually/ |
---|
| 95 | tokenize commands, but for now, make sure this is kept in sync with |
---|
| 96 | owl_parseline in util.c |
---|
| 97 | |
---|
| 98 | Unlike owl_parseline, we always return a result, even in the presence |
---|
| 99 | of parse errors, since we may be called on incomplete command-lines. |
---|
| 100 | |
---|
| 101 | The owl_parseline rules are: |
---|
| 102 | |
---|
| 103 | * Tokenize on ' ' and '\t' |
---|
| 104 | * ' and " are quote characters |
---|
| 105 | * \ has no effect |
---|
| 106 | |
---|
| 107 | =cut |
---|
| 108 | |
---|
| 109 | my $boring = qr{[^'" \t]}; |
---|
| 110 | my $quote = qr{['"]}; |
---|
| 111 | my $space = qr{[ \t]}; |
---|
| 112 | |
---|
| 113 | sub tokenize { |
---|
| 114 | my $line = shift; |
---|
| 115 | my $point = shift; |
---|
| 116 | |
---|
| 117 | my @words = (); |
---|
| 118 | my $cword = 0; |
---|
[13614e7] | 119 | my $cword_start; |
---|
| 120 | my $cword_end; |
---|
[8eac1a5] | 121 | my $word_point; |
---|
| 122 | |
---|
| 123 | my $word = ''; |
---|
[13614e7] | 124 | my $wstart = 0; |
---|
[8eac1a5] | 125 | my $skipped = 0; |
---|
| 126 | |
---|
| 127 | pos($line) = 0; |
---|
| 128 | while(pos($line) < length($line)) { |
---|
| 129 | if($line =~ m{\G ($boring+) }gcx) { |
---|
| 130 | $word .= $1; |
---|
| 131 | } elsif ($line =~ m{\G ($quote)}gcx) { |
---|
| 132 | my $chr = $1; |
---|
| 133 | $skipped++ if pos($line) > $point; |
---|
| 134 | if($line =~ m{\G ([^$chr]*) $chr}gcx) { |
---|
| 135 | $word .= $1; |
---|
| 136 | $skipped++ if pos($line) > $point; |
---|
| 137 | } else { |
---|
| 138 | $word .= substr($line, pos($line)); |
---|
| 139 | pos($line) = length($line); |
---|
| 140 | } |
---|
| 141 | } |
---|
| 142 | |
---|
| 143 | if ($line =~ m{\G ($space+|$)}gcx) { |
---|
| 144 | my $wend = pos($line) - length($1); |
---|
| 145 | push @words, $word; |
---|
| 146 | $cword++ unless $wend >= $point; |
---|
[13614e7] | 147 | if(($wend >= $point) && !defined($word_point)) { |
---|
[8eac1a5] | 148 | $word_point = length($word) - ($wend - $point) + $skipped; |
---|
[13614e7] | 149 | $cword_start = $wstart; |
---|
| 150 | $cword_end = $wend; |
---|
[8eac1a5] | 151 | } |
---|
| 152 | $word = ''; |
---|
[13614e7] | 153 | $wstart = pos($line); |
---|
[8eac1a5] | 154 | $skipped = 0; |
---|
| 155 | } |
---|
| 156 | } |
---|
| 157 | |
---|
| 158 | if(length($word)) { die("Internal error, leftover=$word"); } |
---|
| 159 | |
---|
[13614e7] | 160 | unless(defined($word_point)) { |
---|
| 161 | $word_point = 0; |
---|
[7be5d8b] | 162 | $cword_start = $cword_end = $point; |
---|
| 163 | push @words, '' if $point > 0; |
---|
[13614e7] | 164 | } |
---|
[8eac1a5] | 165 | |
---|
[13614e7] | 166 | return (\@words, $cword, $word_point, $cword_start, $cword_end); |
---|
[8eac1a5] | 167 | } |
---|
| 168 | |
---|
| 169 | 1; |
---|