Skip to content

Commit

Permalink
- Make commands `bin/foreign-regexp-replace-aux.*' to begin search fr…
Browse files Browse the repository at this point in the history 
…om current position.

- Make commands `bin/foreign-regexp-replace-aux.*' region aware.
- Fix bugs in commands `bin/foreign-regexp-replace-aux.*' with zero width match.
- New option `limit' for `bin/foreign-regexp-replace-aux.*'.
- New fucntion `foreign-regexp/.format-external-command-arg'.
- New option `limit' for function `foreign-regexp/replace/search-by-external-command'.
- Changed data format of the return value from external replace command.
  • Loading branch information
@k-talo
k-talo committed May 23, 2013
1 parent 4dd5ac5 commit 8437ba3
Show file tree
Hide file tree
Showing 3 changed files with 582 additions and 241 deletions.
146 changes: 106 additions & 40 deletions bin/foreign-regexp-replace-aux.pl
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
#!/usr/bin/env perl
# -*- coding: utf-8-unix -*-
use strict;
use warnings;
use 5.008;
Expand All @@ -16,13 +17,13 @@ sub interpolate_fn_gen {
#
# Special-variables in the replacement string
# will be interpolated.
eval 'sub {"'. escape_str_for_interpolate_fn_gen($_[0]) .'"}';
eval 'sub {"'. escape_str_for_interpolate_fn_gen(${$_[0]}) .'"}';
}

sub eval_fn_gen {
# Eval replacement string in environment
# which has no lexical variable.
eval 'sub {'.$_[0].'}';
eval 'sub {'.${$_[0]}.'}';
}

sub escape_str_for_interpolate_fn_gen {
Expand All @@ -38,61 +39,126 @@ sub escape_perl_str_for_emacs {
${$r_txt} =~ s/"/\\"/og;
}

sub process_replace {
my $r_str_body = shift;
my $r_str_regx = shift;
my $r_str_repl = shift;
my $dot_p = shift;
my $case_p = shift;
my $ext_p = shift;
my $eval_p = shift;
my $limit = shift;
my $pos_start = shift;
my $rgn_beg = shift;
my $rgn_end = shift;

my $pos_wrap_end = undef;
my $count = 0;

my $regx = eval ("qr/\${\$r_str_regx}/mo" .
( $dot_p ? "s" : "") .
(!$case_p ? "i" : "") .
( $ext_p ? "x" : ""));
die $EVAL_ERROR if $EVAL_ERROR;

my $interpolate_fn = ($eval_p
? eval_fn_gen($r_str_repl)
: interpolate_fn_gen($r_str_repl));
die "Syntax error in replacement \"${$r_str_repl}\":\n${EVAL_ERROR}" if $EVAL_ERROR;

my $replace_fn = sub {
my $rgn_beg = shift;
my $rgn_end = shift;
my $wrap_p = shift;


pos(${$r_str_body}) = $rgn_beg;

while (((defined $limit) ? ($count < $limit) : 1) && (${$r_str_body} =~ m/${regx}/g)) {
my $match_beg = $LAST_MATCH_START[0];
my $match_end = $LAST_MATCH_END [0];

last if (($match_beg > $rgn_end) || ($match_end > $rgn_end));
last if ($wrap_p && (defined $pos_wrap_end) && ($pos_wrap_end <= $match_beg));
$pos_wrap_end = $match_beg if ((not $wrap_p) && (not (defined $pos_wrap_end)));

my $replacement = eval { $interpolate_fn->() };
die "Error while interpolating replacement \"${$r_str_repl}\":\n${EVAL_ERROR}" if $EVAL_ERROR;

escape_perl_str_for_emacs(\$replacement);

print " ((";
print $match_beg, ' ';
print $match_end, ' ';
foreach my $i (1 .. $#LAST_MATCH_START) {
print $LAST_MATCH_START[$i], ' ';
print $LAST_MATCH_END [$i], ' ';
}
print " )";
print '"', $replacement, '"';
print " )", "\n";

++$count;
}
};

$rgn_beg = $rgn_beg || 0;
$rgn_end = $rgn_end || length(${$r_str_body});
$pos_start = (($pos_start < $rgn_beg)
? $rgn_beg
: (($pos_start > $rgn_end)
? $rgn_end
: $pos_start));

print "(setq result '(";
print " (";
$replace_fn->($pos_start, $rgn_end, 0);
print " )";

# Search wrap around.
print " (";
$replace_fn->($rgn_beg,
(defined $pos_wrap_end) ? $pos_wrap_end : $rgn_end,
1);
print " )";
print "))", "\n";
print ";;; EOF", "\n";
}

sub main () {
my $fn_in = shift @ARGV or die "No input file name!";
my $fn_body = shift @ARGV or die "No input file name!";
my $fn_out = shift @ARGV or die "No output file name!";
my $fn_pat = shift @ARGV or die "No pattern file name!";
my $fn_regx = shift @ARGV or die "No regexp file name!";
my $fn_repl = shift @ARGV or die "No replacement file name!";
my $dot_p = @ARGV ? shift(@ARGV) : die "No dot matches new line flag.";
my $case_p = @ARGV ? shift(@ARGV) : die "No case sensitive flag.";
my $ext_p = @ARGV ? shift(@ARGV) : die "No extended regular expression flag.";
my $eval_p = @ARGV ? shift(@ARGV) : die "No eval flag.";
my $eval_p = @ARGV ? shift(@ARGV) : die "No eval replacement flag.";
my $limit = @ARGV ? shift(@ARGV) : die "No search limit.";
my $pos_start = shift @ARGV;
my $rgn_beg = shift @ARGV;
my $rgn_end = shift @ARGV;

my $code = 'utf8';

my($str_in, $str_pat, $str_repl);

my($str_body, $str_regx, $str_repl);

use PerlIO::encoding;
local $PerlIO::encoding::fallback = Encode::FB_CROAK(); # Die on invalid char.
{
local $INPUT_RECORD_SEPARATOR = undef;
$str_in = FileHandle->new($fn_in, "<:encoding($code)")->getline;
$str_pat = FileHandle->new($fn_pat, "<:encoding($code)")->getline;
$str_body = FileHandle->new($fn_body, "<:encoding($code)")->getline;
$str_regx = FileHandle->new($fn_regx, "<:encoding($code)")->getline;
$str_repl = FileHandle->new($fn_repl, "<:encoding($code)")->getline;
}
my $pat = eval("qr/\${str_pat}/om" .
( $dot_p ? "s" : "") .
(!$case_p ? "i" : "") .
( $ext_p ? "x" : ""));
die $EVAL_ERROR if $EVAL_ERROR;

my $interpolate_fn;
if ($eval_p) {
$interpolate_fn = eval_fn_gen($str_repl);
} else {
$interpolate_fn = interpolate_fn_gen($str_repl);
}
die "Syntax error in replacement \"${str_repl}\":\n${EVAL_ERROR}" if $EVAL_ERROR;

umask 0177;
my $fh_out = FileHandle->new($fn_out, ">:encoding($code)");
*STDOUT = FileHandle->new($fn_out, ">:encoding($code)");

print $fh_out "(setq result '(", "\n";

while ($str_in =~ m/${pat}/omg) {
my $replacement = eval { $interpolate_fn->() };
die "Error while interpolating replacement \"${str_repl}\":\n${EVAL_ERROR}" if $EVAL_ERROR;

escape_perl_str_for_emacs(\$replacement);

print $fh_out " (";
print $fh_out $LAST_MATCH_START[0], ' ';
print $fh_out $LAST_MATCH_END [0], ' ';
print $fh_out '"', $replacement, '"';
print $fh_out " )", "\n";
}
process_replace(\$str_body, \$str_regx, \$str_repl,
$dot_p, $case_p, $ext_p, $eval_p,
length($limit) ? $limit : undef,, $pos_start, $rgn_beg, $rgn_end);

print $fh_out "))", "\n";
print $fh_out ";;; EOF", "\n";

exit 0;
}

Expand Down
137 changes: 101 additions & 36 deletions bin/foreign-regexp-replace-aux.rb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,58 +12,123 @@ def escape_ruby_str_for_emacs! (str)
str.gsub!(/"/ ) {'\\"'}
end

def process_replace (__str_in__, __pat__, __str_rpl__, __eval_p__)
begin
interpolate_fn = if __eval_p__
then eval 'Proc.new {'+__str_rpl__+'}'
else eval 'Proc.new {"'+escape_str_for_interpolate_fn_gen(__str_rpl__)+'"}' end
rescue SyntaxError
$stderr.print "Syntax error in replacement \"#{__str_rpl__}\".\n"
$stderr.print $!.message
exit 1
end
def process_replace (__str_body__, __str_regx__, __str_repl__,
__dot_p__, __case_p__, __ext_p__, __eval_p__,
__limit__, __pos_start__, __rgn_beg__, __rgn_end__)
__pos_wrap_end__ = nil
__count__ = 0

print "(setq result '("
__regx__ = Regexp.new(__str_regx__, ((__dot_p__ ? Regexp::MULTILINE : 0) |
(__case_p__ ? 0 : Regexp::IGNORECASE) |
(__ext_p__ ? Regexp::EXTENDED : 0)))
__interpolate_fn__ = begin
(__eval_p__ ?
eval('Proc.new {'+__str_repl__+'}') :
eval('Proc.new {"'+escape_str_for_interpolate_fn_gen(__str_repl__)+'"}'))
rescue SyntaxError
$stderr.print "Syntax error in replacement \"#{__str_repl__}\".\n"
$stderr.print $!.message
exit! 1
end

__str_in__.scan( __pat__ ) do |m|
begin
__replacement__ = interpolate_fn.call(m).to_s
__replace_fn__ = Proc.new { |__rgn_beg__, __rgn_end__, __wrap_p__|
__pos__ = __rgn_beg__
__last_0_width_pos__ = nil

while ((__limit__ ? (__count__ < __limit__) : true)&& __str_body__.match(__regx__, __pos__)) do
m = Regexp.last_match

__match_beg__ = m.begin(0)
__match_end__ = m.end (0)
__0_width_p__ = (__match_beg__ == __match_end__)

break if ((__match_beg__ > __rgn_end__) || (__match_end__ > __rgn_end__))
break if (__wrap_p__ && __pos_wrap_end__ && (__pos_wrap_end__ <= __match_beg__))
__pos_wrap_end__ = __match_beg__ if ((not __wrap_p__) && (not __pos_wrap_end__))

if (__0_width_p__ && __last_0_width_pos__ && (__match_beg__ == __last_0_width_pos__)) then
# Do not enter into endless loop.
__pos__ += 1
break if (__pos__ > __rgn_end__)
next
elsif __0_width_p__ then
__last_0_width_pos__ = __match_beg__
else
__last_0_width_pos__ = nil
end

__replacement__ = begin
__interpolate_fn__.call(m).to_s
rescue Exception
$stderr.print "Error while evaluating replacement \"#{__str_repl__}\".\n"
$stderr.print $!.message, "\n"
exit! 1
end

escape_ruby_str_for_emacs!(__replacement__)
rescue Exception
$stderr.print "Error while evaluating replacement \"#{__str_rpl__}\".\n"
$stderr.print $!.message
exit 1

print '(('
m.length.times {|i|
print m.begin(i), ' '
print m.end(i), ' '
}
print ')'
print '"', __replacement__, '"'
print ')'
__count__ += 1
__pos__ = __match_end__
end

print '('
print Regexp.last_match.begin(0), ' '
print Regexp.last_match.end(0), ' '
print '"', __replacement__, '"'
print ')'
end
}

__rgn_beg__ = __rgn_beg__ || 0
__rgn_end__ = __rgn_end__ || __str_body__.length
__pos_start__ = ((__pos_start__ < __rgn_beg__) ?
__rgn_beg__ :
((__pos_start__ > __rgn_end__) ?
__rgn_end__ :
__pos_start__))

print "(setq result '("
print "("
__replace_fn__.call(__pos_start__, __rgn_end__, nil)
print ")"

print "("
__replace_fn__.call(__rgn_beg__,
__pos_wrap_end__ ? __pos_wrap_end__ : __rgn_end__,
true)
print ")"
print "))\n"
print ";;; EOF\n"
end

def main ()
fn_in, fn_out, fn_pat, fn_rpl, dot_p, case_p, ext_p, eval_p = ARGV
fn_body, fn_out, fn_regx, fn_repl,
dot_p, case_p, ext_p, eval_p,
limit, pt_start, rgn_beg, rgn_end = ARGV

str_in = open(fn_in, 'r:UTF-8') {|f| f.read}
str_pat = open(fn_pat, 'r:UTF-8') {|f| f.read}
str_rpl = open(fn_rpl, 'r:UTF-8') {|f| f.read}

pat = Regexp.new(str_pat, ((dot_p.empty? ? 0 : Regexp::MULTILINE) |
(case_p.empty? ? Regexp::IGNORECASE : 0) |
(ext_p.empty? ? 0 : Regexp::EXTENDED)))
first_match_beg = nil

str_body = open(fn_body, 'r:UTF-8') {|f| f.read}
str_regx = open(fn_regx, 'r:UTF-8') {|f| f.read}
str_repl = open(fn_repl, 'r:UTF-8') {|f| f.read}

File.umask(0177)
$stdout = open(fn_out, 'w:UTF-8')

process_replace(str_in, pat, str_rpl, eval_p.empty? ? nil : true)
process_replace(str_body, str_regx, str_repl,
dot_p.empty? ? nil : true,
case_p.empty? ? nil : true,
ext_p.empty? ? nil : true,
eval_p.empty? ? nil : true,
limit.empty? ? nil : limit.to_i,
pt_start.empty? ? nil : pt_start.to_i,
rgn_beg.empty? ? nil : rgn_beg.to_i,
rgn_end.empty? ? nil : rgn_end.to_i)

rescue Exception
$stderr.print $!.message
exit 1
$stderr.print $!.message, "\n"
exit! 1
end

main()
Expand Down
Loading

0 comments on commit 8437ba3

Please sign in to comment.