package Text::Editor::Vip::Buffer::Plugins::GetWord ;
use strict;
use warnings ;
BEGIN
{
use Exporter ();
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = 0.01;
@ISA = qw (Exporter);
@EXPORT = qw ();
@EXPORT_OK = qw ();
%EXPORT_TAGS = ();
}
=head1 NAME
Text::Editor::Vip::Buffer::Plugins::GetWord- Vip::Buffer pluggin
=head1 SYNOPSIS
$buffer->Insert(' word1 word_2 3 word4') ;
$buffer->SetModificationCharacter(1) ;
is($buffer->GetCurrentWord() , 'word1', 'GetCurrentWord') ;
=head1 DESCRIPTION
Plugin for Vip::Buffer.
=head1 FUNCTIONS
=cut
#-------------------------------------------------------------------------------
sub GetAlphanumericFilter
{
=head2 GetAlphanumericFilter
Returns the regex set with L<SetAlphanumericFilter> or the default regex B<qr![a-zA-Z_0-9]+!>.
=cut
my $buffer = shift ;
return
(
$buffer->{'Text::Editor::Vip::Buffer::Plugins::GetWord::ALPHANUMERIC_FILTER'}
|| qr![a-zA-Z_0-9]+!
) ;
}
#-------------------------------------------------------------------------------
sub SetAlphanumericFilter
{
=head2 SetAlphanumericFilter
Sets the regex used by this plugin.
=cut
my $buffer = shift ;
$buffer->{'Text::Editor::Vip::Buffer::Plugins::GetWord::ALPHANUMERIC_FILTER'} = shift ;
}
#-------------------------------------------------------------------------------
sub GetFirstWord
{
=head2 GetFirstWord
Returns the first word matching the word regex in the B<line> passed as argument or the current
modification line if none.
$buffer->GetFirstWord(125) ;
$buffer->GetFirstWord() ; #in the current line
Returns the word( or undef if none found) and its position in the line.
=cut
my $buffer = shift ;
my $line_index = shift ;
$line_index = $buffer->GetModificationLine() unless defined $line_index ;
my $current_line_text = $buffer->GetLineText($line_index) ;
my $character_regex = $buffer->GetAlphanumericFilter() ;
$current_line_text =~ /^(\W*)($character_regex)/ ;
my $length = defined $1 ? length($1) : defined($2) ? 0 : undef ;
return($2, $length) ;
}
#-------------------------------------------------------------------------------
sub GetPreviousWord
{
=head2 GetPreviousWord
Returns the previous word matching the word regex in the the current modification line if none.
Returns the word( or undef if none found) and its position in the line.
=cut
my $buffer = shift ;
my $text = $buffer->GetLineText($buffer->GetModificationLine()) ;
#what if current character is outside the text length?
#my $corrected_selection_start_character = $selection_start_character < $line_length ? $selection_start_character : $line_length ;
my $current_character_index = $buffer->GetModificationCharacter() ;
$current_character_index = length($text) if $current_character_index > length($text) ;
my $character_regex = $buffer->GetAlphanumericFilter() ;
my $left_side = reverse substr($text, 0, $current_character_index) ;
$left_side =~ /^(\W*)($character_regex)/ ;
my $previous_word = reverse $2 if defined $2 ;
my $position ;
if(defined $previous_word)
{
my $non_word_length = defined $1 ? length($1) : 0 ;
$position = $current_character_index - ($non_word_length + length($previous_word)) ;
}
return($previous_word, $position) ;
}
#-------------------------------------------------------------------------------
sub GetCurrentWord
{
=head2 GetCurrentWord
Returns the word at the modification position or undef if no word is found.
=cut
my $buffer = shift ;
my $modification_character = $buffer->GetModificationCharacter() ;
my $current_line_text = $buffer->GetLineText($buffer->GetModificationLine()) ;
my $current_line_length = length($current_line_text) ;
return if $modification_character > $current_line_length ;
my $character_regex = $buffer->GetAlphanumericFilter() ;
my $current_character = substr($current_line_text, $modification_character, 1) ;
my $current_word ;
my $cursor_is_at_the_end_of_the_word = 1 ;
if($current_character =~ /$character_regex/)
{
$current_word = $current_character ;
for(my $character_index = $modification_character - 1 ; $character_index >= 0 ; $character_index--)
{
$current_character = substr($current_line_text, $character_index, 1) ;
if($current_character =~ /$character_regex/)
{
$current_word = $current_character . $current_word ;
}
else
{
# not character
last ;
}
}
for(my $character_index = $modification_character + 1 ; $character_index < $current_line_length ; $character_index++)
{
$current_character = substr($current_line_text, $character_index, 1) ;
if($current_character =~ /$character_regex/)
{
$current_word .= $current_character ;
$cursor_is_at_the_end_of_the_word = 0 ;
}
else
{
# not character
last ;
}
}
}
#else
# not on a character
return($current_word) ;
}
#-------------------------------------------------------------------------------
sub GetPreviousAlphanumeric
{
=head2 GetPreviousAlphanumeric
Get all the characters matching the aphanumeric regex from the current position and backwards.
=cut
my $buffer = shift ;
# Get all string contents from 0 to the cursor position and flip it round
my $line = reverse substr
(
$buffer->GetLineText($buffer->GetModificationLine())
, 0
, $buffer->GetModificationCharacter()
) ;
my $alphanumeric_filter = $buffer->GetAlphanumericFilter() ;
my ($prefix) = $line =~ /($alphanumeric_filter)/ ;
# !! reverse of undef is defined.
if(defined $prefix)
{
return(reverse $prefix) ;
}
else
{
return(undef) ;
}
}
#-------------------------------------------------------------------------------
sub GetNextAlphanumeric
{
=head2 GetNextAlphanumeric
Get all the characters matching the aphanumeric regex from the current position.
=cut
my $buffer = shift ;
my $modification_character = $buffer->GetModificationCharacter() ;
my $current_line_text = $buffer->GetLineText($buffer->GetModificationLine()) ;
my $current_line_length = length($current_line_text) ;
return if $modification_character > $current_line_length ;
my $line = substr
(
$buffer->GetLineText($buffer->GetModificationLine())
, $modification_character
) ;
my $alphanumeric_filter = $buffer->GetAlphanumericFilter() ;
my ($postfix) = $line =~ /($alphanumeric_filter)/ ;
return($postfix) ;
}
#-------------------------------------------------------------------------------
1 ;
=head1 AUTHOR
Khemir Nadim ibn Hamouda
CPAN ID: NKH
mailto:nadim@khemir.net
http:// no web site
=head1 COPYRIGHT
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the
LICENSE file included with this module.
=cut