home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
vile-src.zip
/
vile-8.1
/
perl
/
search.pl
< prev
next >
Wrap
Perl Script
|
1998-05-27
|
6KB
|
245 lines
package Vile::Search;
#
# This package contains perl subroutines which are intended as a
# drop in replacement for vile's search facilities. Not all features
# (such as visual matches) are implemented yet.
#
# These bindings are proper motions, however, so things like 'dn'
# or 'd/foo' will work as expected.
#
# Usage
# -----
# :perl require "search.pl";
*CHUNKSIZE = \100;
my $direction = '';
#open TTY, ">/dev/tty"; # for debugging
#
# Get the pattern to search for, either from the user or from the
# previously stashed value in vile's search variable.
#
sub getpat {
my ($how, $ldirection) = @_;
if (defined($how) and $how eq 'noprompt') {
$pat = Vile::get('search')
}
else {
$direction = $ldirection;
$pat = Vile::mlreply_no_opts($direction eq 'forward'
? 'Perl search: '
: 'Reverse perl search: ',
scalar Vile::get('search'));
}
Vile::set(search => $pat) if defined($pat);
return $pat;
}
#
# Back references (e.g, \1, \2, etc.) need to be adjusted to work
# properly since our search expression contains parenthesized
# expressions too.
#
sub fixbackreferences {
my $pat = shift;
my $adj = shift;
my $lpcount = 0; # number of unescaped left parens
$lpcount++ while $pat =~ /(^|[^\\])\(/g;
if ($lpcount > 0) {
$pat =~ s/\\(\[1-9][0-9]*|.)/
"\\" . (($1 + 0 && $1 <= $lpcount) ? $1+$adj : $1)/gex;
}
return $pat;
}
#
# Search forward. This is not as straightforward as it could be since
# we attempt to fetch the lines in chunks for efficient searching.
#
sub fsearch {
my $pat = getpat(shift, 'forward');
return 0 unless defined($pat);
my $wrap = 0;
my $cb = $Vile::current_buffer;
my @start_dot = $cb->current_position;
my $lastline = ($cb->setregion(1,'$'))[2];
my $chunkstart = $start_dot[0];
my $pos = $start_dot[1]+1;
if ($pos >= ($cb->setregion($chunkstart,0,$chunkstart,'$$'))[3]) {
$pos = 0;
$chunkstart++;
$chunkstart = 1 if ($chunkstart > $lastline);
}
my $chunkend = $chunkstart + $CHUNKSIZE;
$pat = fixbackreferences($pat, 1);
while (1) {
$cb->set_region($chunkstart, $chunkend-1);
$chunk = $cb->fetch;
pos($chunk) = $pos;
$pos = 0;
if ($chunk =~ /($pat)/mg) {
my $lc = 0;
my $matchlen = length($1);
$chunk = substr($chunk, 0, pos($chunk));
$lc++ while $chunk =~ /\n/g;
$chunk =~ s/.*\n//g;
$cb->current_position($chunkstart + $lc, length($chunk) - $matchlen);
if ($wrap) {
@dot = $cb->current_position;
if ($start_dot[0] == $dot[0] and $start_dot[1] == $dot[1]) {
print "Only one occurence of pattern";
}
else {
print "[Search wrapped past end of buffer]";
}
}
return 1;
}
}
continue {
$chunkstart = $chunkend;
if ($wrap) {
last if $chunkstart > $start_dot[0];
}
elsif ($chunkstart > $lastline) {
$wrap = 1;
$chunkstart = 1;
}
$chunkend = $chunkstart + $CHUNKSIZE;
}
print "Not found";
return 0;
}
#
# Search backward
#
sub rsearch {
my $pat = getpat(shift, 'backward');
return 0 unless defined($pat);
my $wrap = 0;
my $cb = $Vile::current_buffer;
my @start_dot = $cb->current_position;
my $lastline = ($cb->setregion(1,'$'))[2];
my $chunkend = $start_dot[0]+1;
my $pmpat;
if ($start_dot[1] == 0) {
if ($chunkend <= 2) {
$chunkend = $lastline+1;
}
else {
$chunkend--;
}
$pmpat = '.*';
}
else {
$pmpat = ".{0,@{[$start_dot[1]-1]}}";
}
my $chunkstart = $chunkend - 1;
$chunkstart = 1 unless $chunkstart > 0;
$cb->set_region($chunkstart, 0, $chunkend-1, '$');
$pat = fixbackreferences($pat, 2);
# $ matches at both the newline and the position after the newline.
# Eliminate one of these cases.
$pat =~ s/(^|[^\\])\$$/$1(?=\n\$)/;
while (1) {
$chunk = $cb->fetch;
pos($chunk) = $pos;
$pos = 0;
if (my ($prematch, $match) = $chunk =~ /\A($pmpat)($pat)/mg) {
my $lc = 0;
$lc++ while ($prematch =~ /\n/g);
$prematch =~ s/.*\n//g;
$cb->current_position($chunkstart + $lc, length($prematch) );
if ($wrap) {
@dot = $cb->current_position;
if ($start_dot[0] == $dot[0] and $start_dot[1] == $dot[1]) {
print "Only one occurence of pattern";
}
else {
print "[Search wrapped past end of buffer]";
}
}
return 1;
}
}
continue {
$chunkend = $chunkstart;
if ($wrap) {
last if $chunkend <= $start_dot[0];
}
elsif ($chunkend <= 1) {
$wrap = 1;
$chunkend = $lastline + 1;
}
$chunkstart = $chunkend - $CHUNKSIZE;
$chunkstart = 1 unless $chunkstart > 0;
$cb->set_region($chunkstart, $chunkend-1);
$pmpat = "[\000-\377]*";
}
print "Not found";
return 0;
}
#
# Find next occurrence of pattern in the current direction
#
sub searchnext {
$direction eq 'forward' ? fsearch('noprompt') : rsearch('noprompt');
}
#
# Find previous occurrence of pattern in current direction
#
sub searchprev {
$direction eq 'forward' ? rsearch('noprompt') : fsearch('noprompt');
}
#
# Register the above as Vile procedures
#
Vile::register_motion 'perl-fsearch' => \&fsearch, "Forward search with perl";
Vile::register_motion 'perl-rsearch' => \&rsearch, "Reverse search with perl";
Vile::register_motion 'perl-search-next' => \&searchnext, "Search next";
Vile::register_motion 'perl-search-prev' => \&searchprev, "Search prev";
#
# Set up the standard keybindings
#
Vile::command("bind-key perl-fsearch /");
Vile::command("bind-key perl-rsearch ?");
Vile::command("bind-key perl-search-next n");
Vile::command("bind-key perl-search-prev N");
1;