Sweden-Number/tools/winapi/winapi_fixup_editor.pm

390 lines
7.4 KiB
Perl

package winapi_fixup_editor;
use strict;
use options qw($options);
use output qw($output);
use winapi qw($win16api $win32api @winapis);
use util;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
my $file = \${$self->{FILE}};
$$file = shift;
return $self;
}
sub add_trigger {
my $self = shift;
my $triggers = \%{$self->{TRIGGERS}};
my $line = shift;
my $action = shift;
if(!defined($$triggers{$line})) {
$$triggers{$line} = [];
}
push @{$$triggers{$line}}, $action;
}
sub replace {
my $self = shift;
my $begin_line = shift;
my $begin_column = shift;
my $end_line = shift;
my $end_column = shift;
my $replace = shift;
my $file = \${$self->{FILE}};
my $line = $begin_line;
my $action = {};
$self->add_trigger($begin_line, {
type => "replace",
begin_line => $begin_line,
begin_column => $begin_column,
end_line => $end_line,
end_column => $end_column,
replace => $replace
});
}
sub flush {
my $self = shift;
my $file = \${$self->{FILE}};
my $triggers = \%{$self->{TRIGGERS}};
my $editor = sub {
local *IN = shift;
local *OUT = shift;
my $modified = 0;
my $again = 0;
my $lookahead = 0;
my $lookahead_count = 0;
LINE: while($again || defined(my $current = <IN>)) {
if(!$again) {
chomp $current;
if($lookahead) {
$lookahead = 0;
$_ .= "\n" . $current;
$lookahead_count++;
} else {
$_ = $current;
$lookahead_count = 0;
}
} else {
$lookahead_count = 0;
$again = 0;
}
my $line = $. - $lookahead_count;
foreach my $action (@{$$triggers{$line}}) {
if($. < $action->{end_line}) {
$lookahead = 1;
next LINE;
}
my $type = $action->{type};
my $begin_line = $action->{begin_line};
my $begin_column = $action->{begin_column};
my $end_line = $action->{end_line};
my $end_column = $action->{end_column};
if($type eq "replace") {
my $replace = $action->{replace};
my @lines = split(/\n/, $_);
if($#lines < 0) {
@lines = ($_);
}
my $begin = "";
my $column = 0;
$_ = $lines[0];
while($column < $begin_column - 1 && s/^.//) {
$begin .= $&;
if($& eq "\t") {
$column = $column + 8 - $column % 8;
} else {
$column++;
}
}
my $column2 = 0;
$_ = $lines[$#lines];
while($column2 < $end_column && s/^.//) {
if($& eq "\t") {
$column2 = $column2 + 8 - $column2 % 8;
} else {
$column2++;
}
}
my $end = $_;
$_ = "$begin$replace$end";
if($options->modify) {
$modified = 1;
} else {
$output->write("$$file:$begin_line.$begin_column-$end_line.$end_column: $replace\n");
}
}
}
print OUT "$_\n";
}
return $modified;
};
my $modified = 0;
if(1) {
$modified = edit_file($$file, $editor);
}
if(!$modified) {
$self->flush_old;
}
}
########################################################################
# Hack for backward compabillity
#
my %insert_line;
my %substitute_line;
my %delete_line;
my %spec_file;
sub flush_old {
my $self = shift;
my $file = ${$self->{FILE}};
my $editor = sub {
local *IN = shift;
local *OUT = shift;
my $modified = 0;
while(<IN>) {
chomp;
my $line;
$line = $insert_line{$.};
if(defined($line)) {
if($options->modify) {
$_ = "$line$_";
$modified = 1;
} else {
my $line2 = $line; chomp($line2);
my @line2 = split(/\n/, $line2);
if($#line2 > 0) {
$output->write("$file: $.: insert: \\\n");
foreach my $line2 (@line2) {
$output->write("'$line2'\n");
}
} else {
$output->write("$file: $.: insert: '$line2'\n");
}
}
}
my $search = $substitute_line{$.}{search};
my $replace = $substitute_line{$.}{replace};
if(defined($search) && defined($replace)) {
my $modified2 = 0;
if(s/$search/$replace/) {
if($options->modify) {
$modified = 1;
}
$modified2 = 1;
}
if(!$options->modify || !$modified2) {
my $search2;
my $replace2;
if(!$modified2) {
$search2 = "unmatched search";
$replace2 = "unmatched replace";
} else {
$search2 = "search";
$replace2 = "replace";
}
$output->write("$file: $.: $search2 : '$search'\n");
my @replace2 = split(/\n/, $replace);
if($#replace2 > 0) {
$output->write("$file: $.: $replace2: \\\n");
foreach my $replace2 (@replace2) {
$output->write("'$replace2'\n");
}
} else {
$output->write("$file: $.: $replace2: '$replace'\n");
}
}
}
$line = $delete_line{$.};
if(defined($line)) {
if(/$line/) {
if($options->modify) {
$modified = 1;
next;
} else {
$output->write("$file: $.: delete: '$line'\n");
}
} else {
$output->write("$file: $.: unmatched delete: '$line'\n");
}
}
print OUT "$_\n";
}
return $modified;
};
my $n = 0;
while(defined(each %insert_line)) { $n++; }
while(defined(each %substitute_line)) { $n++; }
while(defined(each %delete_line)) { $n++; }
if($n > 0) {
edit_file($file, $editor);
}
foreach my $module (sort(keys(%spec_file))) {
my $file;
foreach my $winapi (@winapis) {
$file = ($winapi->module_file($module) || $file);
}
if(defined($file)) {
$file = file_normalize($file);
}
my @substitutes = @{$spec_file{$module}};
my $editor = sub {
local *IN = shift;
local *OUT = shift;
my $modified = 0;
while(<IN>) {
chomp;
my @substitutes2 = ();
foreach my $substitute (@substitutes) {
my $search = $substitute->{search};
my $replace = $substitute->{replace};
if(s/$search/$replace/) {
if($options->modify) {
$modified = 1;
} else {
$output->write("$file: search : '$search'\n");
$output->write("$file: replace: '$replace'\n");
}
next;
} else {
push @substitutes2, $substitute;
}
}
@substitutes = @substitutes2;
print OUT "$_\n";
}
return $modified;
};
if(defined($file)) {
edit_file($file, $editor);
} else {
$output->write("$module: doesn't have any spec file\n");
}
if($#substitutes >= 0) {
foreach my $substitute (@substitutes) {
my $search = $substitute->{search};
my $replace = $substitute->{replace};
$output->write("$file: unmatched search : '$search'\n");
$output->write("$file: unmatched replace: '$replace'\n");
}
}
}
%insert_line = ();
%substitute_line = ();
%delete_line = ();
%spec_file = ();
}
sub delete_line {
my $self = shift;
my $line = shift;
my $pattern = shift;
$delete_line{$line} = $pattern;
}
sub insert_line {
my $self = shift;
my $line = shift;
my $insert = shift;
$insert_line{$line} = $insert;
}
sub substitute_line {
my $self = shift;
my $line = shift;
my $search = shift;
my $replace = shift;
$substitute_line{$line}{search} = $search;
$substitute_line{$line}{replace} = $replace;
}
sub replace_spec_file {
my $self = shift;
my $module = shift;
my $search = shift;
my $replace = shift;
my $substitute = {};
$substitute->{search} = $search;
$substitute->{replace} = $replace;
if(!defined($spec_file{$module})) {
$spec_file{$module} = [];
}
push @{$spec_file{$module}}, $substitute;
}
1;