- Begun implementation of a C statements parser.
- More reorganizations and fixes.
This commit is contained in:
Patrik Stridvall
Alexandre Julliard
parent
b8dd37d239
commit
4b33b1322d
|
|
@ -0,0 +1,534 @@
|
|||
package c_parser;
|
||||
|
||||
use strict;
|
||||
|
||||
use options qw($options);
|
||||
use output qw($output);
|
||||
|
||||
sub _update_c_position {
|
||||
local $_ = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
|
||||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
while($_) {
|
||||
if(s/^[^\n\t\'\"]*//s) {
|
||||
$column += length($&);
|
||||
}
|
||||
|
||||
if(s/^\'//) {
|
||||
$column++;
|
||||
while(/^./ && !s/^\'//) {
|
||||
s/^([^\'\\]*)//s;
|
||||
$column += length($1);
|
||||
if(s/^\\//) {
|
||||
$column++;
|
||||
if(s/^(.)//s) {
|
||||
$column += length($1);
|
||||
if($1 eq "0") {
|
||||
s/^(\d{0,3})//s;
|
||||
$column += length($1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$column++;
|
||||
} elsif(s/^\"//) {
|
||||
$column++;
|
||||
while(/^./ && !s/^\"//) {
|
||||
s/^([^\"\\]*)//s;
|
||||
$column += length($1);
|
||||
if(s/^\\//) {
|
||||
$column++;
|
||||
if(s/^(.)//s) {
|
||||
$column += length($1);
|
||||
if($1 eq "0") {
|
||||
s/^(\d{0,3})//s;
|
||||
$column += length($1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$column++;
|
||||
} elsif(s/^\n//) {
|
||||
$line++;
|
||||
$column = 0;
|
||||
} elsif(s/^\t//) {
|
||||
$column = $column + 8 - $column % 8;
|
||||
}
|
||||
}
|
||||
|
||||
$$refline = $line;
|
||||
$$refcolumn = $column;
|
||||
}
|
||||
|
||||
sub parse_c {
|
||||
my $pattern = shift;
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
|
||||
local $_ = $$refcurrent;
|
||||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
if(s/$pattern//) {
|
||||
_update_c_position($&, \$line, \$column);
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
|
||||
$$refcurrent = $_;
|
||||
$$refline = $line;
|
||||
$$refcolumn = $column;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub parse_c_until_one_of {
|
||||
my $characters = shift;
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
my $match = shift;
|
||||
|
||||
local $_ = $$refcurrent;
|
||||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
if(!defined($line) || !defined($column)) {
|
||||
$output->write("error: \$characters = '$characters' \$_ = '$_'\n");
|
||||
exit 1;
|
||||
}
|
||||
|
||||
if(!defined($match)) {
|
||||
my $blackhole;
|
||||
$match = \$blackhole;
|
||||
}
|
||||
|
||||
$$match = "";
|
||||
while(/^[^$characters]/s) {
|
||||
my $submatch = "";
|
||||
|
||||
if(s/^[^$characters\n\t\'\"]*//s) {
|
||||
$submatch .= $&;
|
||||
}
|
||||
|
||||
if(s/^\'//) {
|
||||
$submatch .= "\'";
|
||||
while(/^./ && !s/^\'//) {
|
||||
s/^([^\'\\]*)//s;
|
||||
$submatch .= $1;
|
||||
if(s/^\\//) {
|
||||
$submatch .= "\\";
|
||||
if(s/^(.)//s) {
|
||||
$submatch .= $1;
|
||||
if($1 eq "0") {
|
||||
s/^(\d{0,3})//s;
|
||||
$submatch .= $1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$submatch .= "\'";
|
||||
|
||||
$$match .= $submatch;
|
||||
$column += length($submatch);
|
||||
} elsif(s/^\"//) {
|
||||
$submatch .= "\"";
|
||||
while(/^./ && !s/^\"//) {
|
||||
s/^([^\"\\]*)//s;
|
||||
$submatch .= $1;
|
||||
if(s/^\\//) {
|
||||
$submatch .= "\\";
|
||||
if(s/^(.)//s) {
|
||||
$submatch .= $1;
|
||||
if($1 eq "0") {
|
||||
s/^(\d{0,3})//s;
|
||||
$submatch .= $1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$submatch .= "\"";
|
||||
|
||||
$$match .= $submatch;
|
||||
$column += length($submatch);
|
||||
} elsif(s/^\n//) {
|
||||
$submatch .= "\n";
|
||||
|
||||
$$match .= $submatch;
|
||||
$line++;
|
||||
$column = 0;
|
||||
} elsif(s/^\t//) {
|
||||
$submatch .= "\t";
|
||||
|
||||
$$match .= $submatch;
|
||||
$column = $column + 8 - $column % 8;
|
||||
} else {
|
||||
$$match .= $submatch;
|
||||
$column += length($submatch);
|
||||
}
|
||||
}
|
||||
|
||||
$$refcurrent = $_;
|
||||
$$refline = $line;
|
||||
$$refcolumn = $column;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub parse_c_block {
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
my $refstatements = shift;
|
||||
my $refstatements_line = shift;
|
||||
my $refstatements_column = shift;
|
||||
|
||||
local $_ = $$refcurrent;
|
||||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
my $statements;
|
||||
if(s/^\{//) {
|
||||
$column++;
|
||||
$statements = "";
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
|
||||
my $statements_line = $line;
|
||||
my $statements_column = $column;
|
||||
|
||||
my $plevel = 1;
|
||||
while($plevel > 0) {
|
||||
my $match;
|
||||
parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
|
||||
|
||||
$column++;
|
||||
|
||||
$statements .= $match;
|
||||
if(s/^\}//) {
|
||||
$plevel--;
|
||||
if($plevel > 0) {
|
||||
$statements .= "}";
|
||||
}
|
||||
} elsif(s/^\{//) {
|
||||
$plevel++;
|
||||
$statements .= "{";
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
$$refcurrent = $_;
|
||||
$$refline = $line;
|
||||
$$refcolumn = $column;
|
||||
$$refstatements = $statements;
|
||||
$$refstatements_line = $statements_line;
|
||||
$$refstatements_column = $statements_column;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub parse_c_expression {
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
my $found_function_call_callback = shift;
|
||||
|
||||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
local $_ = $$refcurrent;
|
||||
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
|
||||
if(s/^(.*?)(\w+)(\s*)\(//s) {
|
||||
my $begin_line = $line;
|
||||
my $begin_column = $column + length($1) + 1;
|
||||
|
||||
$line = $begin_line;
|
||||
$column = $begin_column + length("$2$3") - 1;
|
||||
|
||||
my $name = $2;
|
||||
|
||||
$_ = "($'";
|
||||
|
||||
# $output->write("$name: $line.$column: '$_'\n");
|
||||
|
||||
my @arguments;
|
||||
my @argument_lines;
|
||||
my @argument_columns;
|
||||
if(!parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
if($name =~ /^sizeof$/) {
|
||||
# Nothing
|
||||
} else {
|
||||
&$found_function_call_callback($begin_line, $begin_column, $line, $column,
|
||||
$name, \@arguments);
|
||||
}
|
||||
|
||||
while(defined(my $argument = shift @arguments) &&
|
||||
defined(my $argument_line = shift @argument_lines) &&
|
||||
defined(my $argument_column = shift @argument_columns))
|
||||
{
|
||||
parse_c_expression(\$argument, \$argument_line, \$argument_column, $found_function_call_callback);
|
||||
}
|
||||
} elsif(s/^return//) {
|
||||
$column += length($&);
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
if(!parse_c_expression(\$_, \$line, \$column, $found_function_call_callback)) {
|
||||
return 0;
|
||||
}
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
|
||||
_update_c_position($_, \$line, \$column);
|
||||
|
||||
$$refcurrent = $_;
|
||||
$$refline = $line;
|
||||
$$refcolumn = $column;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub parse_c_statement {
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
my $found_function_call_callback = shift;
|
||||
|
||||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
local $_ = $$refcurrent;
|
||||
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
|
||||
if(s/^(?:case\s+)?(\w+)\s*://) {
|
||||
$column += length($&);
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
}
|
||||
|
||||
# $output->write("$line.$column: '$_'\n");
|
||||
|
||||
if(/^$/) {
|
||||
# Nothing
|
||||
} elsif(/^\{/) {
|
||||
my $statements;
|
||||
my $statements_line;
|
||||
my $statements_column;
|
||||
if(!parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
|
||||
return 0;
|
||||
}
|
||||
if(!parse_c_statements(\$statements, \$statements_line, \$statements_column, $found_function_call_callback)) {
|
||||
return 0;
|
||||
}
|
||||
} elsif(/^(for|if|switch|while)(\s*)\(/) {
|
||||
$column += length("$1$2");
|
||||
my $name = $1;
|
||||
|
||||
$_ = "($'";
|
||||
|
||||
my @arguments;
|
||||
my @argument_lines;
|
||||
my @argument_columns;
|
||||
if(!parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
if(!parse_c_statement(\$_, \$line, \$column, $found_function_call_callback)) {
|
||||
return 0;
|
||||
}
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
|
||||
while(defined(my $argument = shift @arguments) &&
|
||||
defined(my $argument_line = shift @argument_lines) &&
|
||||
defined(my $argument_column = shift @argument_columns))
|
||||
{
|
||||
parse_c_expression(\$argument, \$argument_line, \$argument_column, $found_function_call_callback);
|
||||
}
|
||||
} elsif(s/^else//) {
|
||||
$column += length($&);
|
||||
if(!parse_c_statement(\$_, \$line, \$column, $found_function_call_callback)) {
|
||||
return 0;
|
||||
}
|
||||
} elsif(parse_c_expression(\$_, \$line, \$column, $found_function_call_callback)) {
|
||||
# Nothing
|
||||
} else {
|
||||
# $output->write("error '$_'\n");
|
||||
# exit 1;
|
||||
}
|
||||
|
||||
_update_c_position($_, \$line, \$column);
|
||||
|
||||
$$refcurrent = $_;
|
||||
$$refline = $line;
|
||||
$$refcolumn = $column;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub parse_c_statements {
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
my $found_function_call_callback = shift;
|
||||
|
||||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
local $_ = $$refcurrent;
|
||||
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
my $statement = "";
|
||||
my $statement_line = $line;
|
||||
my $statement_column = $column;
|
||||
|
||||
my $blevel = 1;
|
||||
my $plevel = 1;
|
||||
while($plevel > 0 || $blevel > 0) {
|
||||
my $match;
|
||||
parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
|
||||
|
||||
# $output->write("'$match' '$_'\n");
|
||||
|
||||
$column++;
|
||||
$statement .= $match;
|
||||
if(s/^[\(\[]//) {
|
||||
$plevel++;
|
||||
$statement .= $&;
|
||||
} elsif(s/^[\)\]]//) {
|
||||
$plevel--;
|
||||
if($plevel <= 0) {
|
||||
$output->write("error $plevel: '$statement' '$match' '$_'\n");
|
||||
exit 1;
|
||||
}
|
||||
$statement .= $&;
|
||||
} elsif(s/^\{//) {
|
||||
$blevel++;
|
||||
$statement .= $&;
|
||||
} elsif(s/^\}//) {
|
||||
$blevel--;
|
||||
$statement .= $&;
|
||||
if($blevel == 1) {
|
||||
if(!parse_c_statement(\$statement, \$statement_line, \$statement_column, $found_function_call_callback)) {
|
||||
return 0;
|
||||
}
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
$statement = "";
|
||||
$statement_line = $line;
|
||||
$statement_column = $column;
|
||||
}
|
||||
} elsif(s/^;//) {
|
||||
if($plevel == 1 && $blevel == 1) {
|
||||
if(!parse_c_statement(\$statement, \$statement_line, \$statement_column, $found_function_call_callback)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
$statement = "";
|
||||
$statement_line = $line;
|
||||
$statement_column = $column;
|
||||
} else {
|
||||
$statement .= $&;
|
||||
}
|
||||
} elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
|
||||
$plevel = 0;
|
||||
$blevel = 0;
|
||||
} else {
|
||||
$output->write("error $plevel: '$statement' '$match' '$_'\n");
|
||||
exit 1;
|
||||
}
|
||||
}
|
||||
|
||||
_update_c_position($_, \$line, \$column);
|
||||
|
||||
$$refcurrent = $_;
|
||||
$$refline = $line;
|
||||
$$refcolumn = $column;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub parse_c_tuple {
|
||||
my $refcurrent = shift;
|
||||
my $refline = shift;
|
||||
my $refcolumn = shift;
|
||||
|
||||
# FIXME: Should not write directly
|
||||
my $items = shift;
|
||||
my $item_lines = shift;
|
||||
my $item_columns = shift;
|
||||
|
||||
local $_ = $$refcurrent;
|
||||
|
||||
my $line = $$refline;
|
||||
my $column = $$refcolumn;
|
||||
|
||||
my $item;
|
||||
if(s/^\(//) {
|
||||
$column++;
|
||||
$item = "";
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
|
||||
my $item_line = $line;
|
||||
my $item_column = $column + 1;
|
||||
|
||||
my $plevel = 1;
|
||||
while($plevel > 0) {
|
||||
my $match;
|
||||
parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
|
||||
|
||||
$column++;
|
||||
|
||||
$item .= $match;
|
||||
if(s/^\)//) {
|
||||
$plevel--;
|
||||
if($plevel == 0) {
|
||||
push @$item_lines, $item_line;
|
||||
push @$item_columns, $item_column;
|
||||
push @$items, $item;
|
||||
$item = "";
|
||||
} else {
|
||||
$item .= ")";
|
||||
}
|
||||
} elsif(s/^\(//) {
|
||||
$plevel++;
|
||||
$item .= "(";
|
||||
} elsif(s/^,//) {
|
||||
if($plevel == 1) {
|
||||
push @$item_lines, $item_line;
|
||||
push @$item_columns, $item_column;
|
||||
push @$items, $item;
|
||||
parse_c_until_one_of("\\S", \$_, \$line, \$column);
|
||||
$item_line = $line;
|
||||
$item_column = $column + 1;
|
||||
$item = "";
|
||||
} else {
|
||||
$item .= ",";
|
||||
}
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
$$refcurrent = $_;
|
||||
$$refline = $line;
|
||||
$$refcolumn = $column;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -143,6 +143,17 @@ sub argument_documentations {
|
|||
return $$argument_documentations;
|
||||
}
|
||||
|
||||
sub statements_line {
|
||||
my $self = shift;
|
||||
my $statements_line = \${$self->{STATEMENTS_LINE}};
|
||||
|
||||
local $_ = shift;
|
||||
|
||||
if(defined($_)) { $$statements_line = $_; }
|
||||
|
||||
return $$statements_line;
|
||||
}
|
||||
|
||||
sub statements {
|
||||
my $self = shift;
|
||||
my $statements = \${$self->{STATEMENTS}};
|
||||
|
|
|
|||
|
|
@ -38,13 +38,13 @@ while(<IN>) {
|
|||
|
||||
if($message) {
|
||||
if($file && $line) {
|
||||
if($directory && $directory ne ".") {
|
||||
if($directory && $directory ne "." && $file !~ m%^/%) {
|
||||
$output->write(&file_normalize("$directory/$file") . ":$line: $message\n");
|
||||
} else {
|
||||
$output->write("$file:$line: $message\n");
|
||||
}
|
||||
} elsif($file) {
|
||||
if($directory && $directory ne ".") {
|
||||
if($directory && $directory ne "." && $file !~ m%^/%) {
|
||||
$output->write(&file_normalize("$directory/$file") . ": $message\n");
|
||||
} else {
|
||||
$output->write("$file: $message\n");
|
||||
|
|
|
|||
|
|
@ -131,7 +131,7 @@ sub line {
|
|||
error("line");
|
||||
} elsif($tool eq "bison" && /^conflicts:\s+\d+\s+shift\/reduce$/) {
|
||||
# Nothing
|
||||
} elsif($tool eq "gcc" && /^In file included from (.+?):(\d+):$/) {
|
||||
} elsif($tool eq "gcc" && /^(?:In file included |\s*)from (.+?):(\d+)[,:]$/) {
|
||||
# Nothing
|
||||
} elsif($tool =~ /^gcc|ld$/ && s/^(.+?\.o(?:\(.*?\))?):\s*//) {
|
||||
ld_output($1, $_)
|
||||
|
|
|
|||
|
|
@ -18,14 +18,15 @@ use config qw(
|
|||
);
|
||||
use output qw($output);
|
||||
use winapi_fixup_options qw($options);
|
||||
use modules qw($modules);
|
||||
use winapi qw($win16api $win32api @winapis);
|
||||
|
||||
use type;
|
||||
use util;
|
||||
use winapi_function;
|
||||
use winapi_parser;
|
||||
|
||||
use winapi_fixup_documentation qw(&fixup_documentation);
|
||||
use winapi_fixup_editor;
|
||||
use winapi_fixup_statements qw(&fixup_statements);
|
||||
|
||||
my @c_files = $options->c_files;
|
||||
@c_files = files_skip(@c_files);
|
||||
@c_files = files_filter("winelib", @c_files);
|
||||
|
|
@ -35,400 +36,38 @@ my $progress_current = 0;
|
|||
my $progress_max = scalar(@c_files);
|
||||
|
||||
foreach my $file (@c_files) {
|
||||
my %insert_line;
|
||||
my %substitute_line;
|
||||
my %delete_line;
|
||||
|
||||
my %spec_file;
|
||||
my $editor = new winapi_fixup_editor($file);
|
||||
|
||||
$progress_current++;
|
||||
if($options->progress) {
|
||||
$output->progress("$file: file $progress_current of $progress_max");
|
||||
$output->progress("$file (file $progress_current of $progress_max)");
|
||||
}
|
||||
|
||||
my %documentation_line_used;
|
||||
|
||||
my $create_function = sub {
|
||||
return 'winapi_function'->new;
|
||||
};
|
||||
|
||||
my $found_function = sub {
|
||||
my $function = shift;
|
||||
|
||||
my $documentation_line = $function->documentation_line;
|
||||
my $documentation = $function->documentation;
|
||||
my $function_line = $function->function_line;
|
||||
my $linkage = $function->linkage;
|
||||
my $return_type = $function->return_type;
|
||||
my $calling_convention = $function->calling_convention;
|
||||
|
||||
my $internal_name = $function->internal_name;
|
||||
my $statements = $function->statements;
|
||||
|
||||
if($linkage eq "static" ||
|
||||
($linkage eq "extern" && !defined($statements)) ||
|
||||
($linkage eq "" && !defined($statements)))
|
||||
{
|
||||
return;
|
||||
if($options->progress) {
|
||||
$output->progress("$file (file $progress_current of $progress_max): $internal_name");
|
||||
}
|
||||
|
||||
my @external_names = $function->external_names;
|
||||
if($#external_names < 0) {
|
||||
return;
|
||||
}
|
||||
|
||||
if($documentation_line_used{$documentation_line}) {
|
||||
$documentation = undef;
|
||||
}
|
||||
$documentation_line_used{$documentation_line}++;
|
||||
|
||||
$output->prefix_callback(sub { return $function->prefix; });
|
||||
|
||||
my @module_ordinal_entries = ();
|
||||
foreach my $entry2 ($function->get_all_module_ordinal) {
|
||||
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
||||
if(($external_name2 eq "@" ||
|
||||
($win16api->is_module($module2) && !$win16api->is_function_stub_in_module($module2, $external_name2)) ||
|
||||
($win32api->is_module($module2) && !$win32api->is_function_stub_in_module($module2, $external_name2))) &&
|
||||
$modules->is_allowed_module_in_file($module2, "$current_dir/$file"))
|
||||
{
|
||||
push @module_ordinal_entries, $entry2;
|
||||
}
|
||||
if($options->documentation) {
|
||||
fixup_documentation($function, $editor);
|
||||
}
|
||||
|
||||
my $spec_modified = 0;
|
||||
|
||||
if($options->stub && defined($documentation)) {
|
||||
my $calling_convention16 = $function->calling_convention16;
|
||||
my $calling_convention32 = $function->calling_convention32;
|
||||
|
||||
foreach my $winapi (@winapis) {
|
||||
my @entries = ();
|
||||
my $module = $winapi->function_internal_module($internal_name);
|
||||
my $ordinal = $winapi->function_internal_ordinal($internal_name);
|
||||
|
||||
if($winapi->is_function_stub_in_module($module, $internal_name)) {
|
||||
my $external_name = $internal_name;
|
||||
if($winapi->name eq "win16") {
|
||||
$external_name =~ s/(?:_)?16([AW]?)$//;
|
||||
if(defined($1)) {
|
||||
$external_name .= $1;
|
||||
}
|
||||
}
|
||||
push @entries, [$external_name, $module, $ordinal];
|
||||
}
|
||||
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
|
||||
my $external_name = $1;
|
||||
my $module = lc($2);
|
||||
my $ordinal = $3;
|
||||
|
||||
if($external_name ne "@" &&
|
||||
$winapi->is_module($module) &&
|
||||
$winapi->is_function_stub_in_module($module, $external_name) &&
|
||||
$internal_name !~ /^\U$module\E_\Q$external_name\E$/)
|
||||
{
|
||||
push @entries, [$external_name, $module, $ordinal];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $entry (@entries) {
|
||||
(my $external_name, my $module, my $ordinal) = @$entry;
|
||||
|
||||
my $refargument_types = $function->argument_types;
|
||||
|
||||
if(!defined($refargument_types)) {
|
||||
next;
|
||||
}
|
||||
|
||||
my $abort = 0;
|
||||
my $n;
|
||||
my @argument_kinds = map {
|
||||
my $type = $_;
|
||||
my $kind;
|
||||
if($type ne "..." && !defined($kind = $winapi->translate_argument($type))) {
|
||||
$output->write("no translation defined: " . $type . "\n");
|
||||
}
|
||||
|
||||
# FIXME: Kludge
|
||||
if(defined($kind) && $kind eq "longlong") {
|
||||
$n += 2;
|
||||
("long", "long");
|
||||
} elsif(defined($kind)) {
|
||||
$n++;
|
||||
$kind;
|
||||
} elsif($type eq "...") {
|
||||
if($winapi->name eq "win16") {
|
||||
$calling_convention16 = "pascal"; # FIXME: Is this correct?
|
||||
} else {
|
||||
$calling_convention32 = "varargs";
|
||||
}
|
||||
();
|
||||
} else {
|
||||
$abort = 1;
|
||||
$n++;
|
||||
"undef";
|
||||
}
|
||||
} @$refargument_types;
|
||||
|
||||
my $substitute = {};
|
||||
$substitute->{search} = "^\\s*$ordinal\\s+stub\\s+$external_name\\s*(?:#.*?)?\$";
|
||||
|
||||
if($winapi->name eq "win16") {
|
||||
$substitute->{replace} = "$ordinal $calling_convention16 $external_name(@argument_kinds) $internal_name";
|
||||
} else {
|
||||
$substitute->{replace} = "$ordinal $calling_convention32 $external_name(@argument_kinds) $internal_name";
|
||||
}
|
||||
|
||||
if(!defined($spec_file{$module})) {
|
||||
$spec_file{$module} = [];
|
||||
}
|
||||
|
||||
if(!$abort) {
|
||||
$spec_modified = 1;
|
||||
push @{$spec_file{$module}}, $substitute;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my %found_external_names;
|
||||
foreach my $external_name (@external_names) {
|
||||
$found_external_names{$external_name} = {};
|
||||
}
|
||||
|
||||
my $documentation_modified = 0;
|
||||
|
||||
if(!$spec_modified &&
|
||||
(defined($documentation) && !$documentation_modified) &&
|
||||
($options->documentation_name || $options->documentation_ordinal ||
|
||||
$options->documentation_missing))
|
||||
{
|
||||
local $_;
|
||||
|
||||
my $line3;
|
||||
my $search;
|
||||
my $replace;
|
||||
|
||||
my $count = 0;
|
||||
my $line2 = $documentation_line - 1;
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
$line2++;
|
||||
if(/^(\s*\*\s*(\S+)\s*)((?:\s*[\(\[]\s*\w+(?:\s*\.\s*[^\s\)\]]*\s*)?[\)\]])+)(.*?)$/) {
|
||||
my $part1 = $1;
|
||||
my $external_name = $2;
|
||||
my $part3 = $3;
|
||||
my $part4 = $4;
|
||||
|
||||
$part4 =~ s/\s*$//;
|
||||
|
||||
my @entries = ();
|
||||
while($part3 =~ s/^\s*([\(\[]\s*(\w+)(?:\s*\.\s*([^\s\)\]]*)\s*)?[\)\]])//) {
|
||||
push @entries, [$1, $2, $3];
|
||||
}
|
||||
|
||||
my $found = 0;
|
||||
foreach my $external_name2 (@external_names) {
|
||||
if($external_name eq $external_name2) {
|
||||
foreach my $entry (@entries) {
|
||||
(undef, my $module, undef) = @$entry;
|
||||
$found_external_names{$external_name2}{$module} = 1;
|
||||
}
|
||||
$found = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
my $replaced = 0;
|
||||
my $replace2 = "";
|
||||
foreach my $entry (@entries) {
|
||||
my $part12 = $part1;
|
||||
(my $part32, my $module, my $ordinal) = @$entry;
|
||||
|
||||
foreach my $entry2 (@module_ordinal_entries) {
|
||||
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
||||
|
||||
if($options->documentation_name && lc($module) eq $module2 &&
|
||||
$external_name ne $external_name2)
|
||||
{
|
||||
if(!$found && $part12 =~ s/\b\Q$external_name\E\b/$external_name2/) {
|
||||
$external_name = $external_name2;
|
||||
$replaced++;
|
||||
}
|
||||
}
|
||||
|
||||
if($options->documentation_ordinal &&
|
||||
$external_name eq $external_name2 &&
|
||||
lc($module) eq $module2 &&
|
||||
($#entries > 0 || !defined($ordinal) || ($ordinal ne $ordinal2)))
|
||||
{
|
||||
if(defined($ordinal)) {
|
||||
if($part32 =~ s/\Q$module\E\s*.\s*\Q$ordinal\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
|
||||
$replaced++;
|
||||
}
|
||||
} else {
|
||||
if($part32 =~ s/\Q$module\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
|
||||
$replaced++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
if($replace2) { $replace2 .= "\n"; }
|
||||
$replace2 .= "$part12$part32$part4";
|
||||
}
|
||||
|
||||
if($replaced > 0) {
|
||||
$line3 = $line2;
|
||||
$search = "^\Q$_\E\$";
|
||||
$replace = $replace2;
|
||||
}
|
||||
$count++;
|
||||
} elsif(/^(\s*\*\s*)([^\s\(]+)(?:\(\))?\s*$/) {
|
||||
my $part1 = $1;
|
||||
my $external_name = $2;
|
||||
|
||||
if($internal_name =~ /^(?:\S+_)?\Q$external_name\E(?:16)?$/) {
|
||||
foreach my $entry (@module_ordinal_entries) {
|
||||
(my $external_name2, my $module, my $ordinal) = @$entry;
|
||||
|
||||
$line3 = $line2;
|
||||
$search = "^\Q$_\E\$";
|
||||
$replace = "$part1$external_name2 (\U$module\E.$ordinal)";
|
||||
}
|
||||
$count++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if(defined($line3) && defined($search) && defined($replace)) {
|
||||
if($count > 1 || $#external_names >= 1) {
|
||||
$output->write("multiple entries (fixup not supported)\n");
|
||||
# $output->write("s/$search/$replace/\n");
|
||||
# $output->write("@external_names\n");
|
||||
} else {
|
||||
$documentation_modified = 1;
|
||||
|
||||
$substitute_line{$line3}{search} = $search;
|
||||
$substitute_line{$line3}{replace} = $replace;
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if(!$spec_modified && !$documentation_modified &&
|
||||
$options->documentation_missing && defined($documentation))
|
||||
{
|
||||
my $part1;
|
||||
my $part2;
|
||||
my $part3;
|
||||
my $part4;
|
||||
my $line3 = 0;
|
||||
|
||||
my $line2 = $documentation_line - 1;
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
$line2++;
|
||||
if(/^(\s*\*\s*)(\S+\s*)([\(\[])\s*\w+\s*\.\s*[^\s\)\]]*\s*([\)\]]).*?$/) {
|
||||
$part1 = $1;
|
||||
$part2 = $2;
|
||||
$part3 = $3;
|
||||
$part4 = $4;
|
||||
|
||||
$part2 =~ s/\S/ /g;
|
||||
|
||||
$line3 = $line2 + 1;
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $entry2 (@module_ordinal_entries) {
|
||||
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
||||
|
||||
my $found = 0;
|
||||
foreach my $external_name (keys(%found_external_names)) {
|
||||
foreach my $module3 (keys(%{$found_external_names{$external_name}})) {
|
||||
if($external_name eq $external_name2 && uc($module2) eq $module3) {
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
# FIXME: Not 100% correct
|
||||
if(!$found &&
|
||||
!$win16api->is_function_stub_in_module($module2, $internal_name) &&
|
||||
!$win32api->is_function_stub_in_module($module2, $internal_name))
|
||||
{
|
||||
if($line3 > 0) {
|
||||
$documentation_modified = 1;
|
||||
|
||||
$part2 = $external_name2 . " " x (length($part2) - length($external_name2));
|
||||
$insert_line{$line3} = "$part1$part2$part3\U$module2\E.$ordinal2$part4\n";
|
||||
} else {
|
||||
$output->write("$external_name2 (\U$module2\E.$ordinal2) missing (fixup not supported)\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if(!$documentation_modified &&
|
||||
defined($documentation) &&
|
||||
$options->documentation_wrong)
|
||||
{
|
||||
my $line2 = $documentation_line - 1;
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
$line2++;
|
||||
if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
|
||||
my $external_name = $1;
|
||||
my $module = $2;
|
||||
my $ordinal = $3;
|
||||
|
||||
my $found = 0;
|
||||
foreach my $entry2 (@module_ordinal_entries) {
|
||||
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
||||
|
||||
if($external_name eq $external_name2 &&
|
||||
lc($module) eq $module2 &&
|
||||
$ordinal eq $ordinal2)
|
||||
{
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
if(!$found) {
|
||||
if(1) {
|
||||
$documentation_modified = 1;
|
||||
|
||||
$delete_line{$line2} = "^\Q$_\E\$";
|
||||
} else {
|
||||
$output->write("$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n");
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if(!$spec_modified && !$documentation_modified && !defined($documentation))
|
||||
{
|
||||
my $insert = "";
|
||||
foreach my $winapi (@winapis) {
|
||||
my $external_name = $winapi->function_external_name($internal_name);
|
||||
my $module = $winapi->function_internal_module($internal_name);
|
||||
my $ordinal = $winapi->function_internal_ordinal($internal_name);
|
||||
|
||||
if(defined($external_name) && defined($module) && defined($ordinal)) {
|
||||
$insert .= " *\t\t$external_name (\U$module\E.$ordinal)\n";
|
||||
}
|
||||
}
|
||||
if($insert) {
|
||||
$insert_line{$function_line} =
|
||||
"/" . "*" x 71 . "\n" .
|
||||
"$insert" .
|
||||
" */\n";
|
||||
}
|
||||
if($options->statements) {
|
||||
fixup_statements($function, $editor);
|
||||
}
|
||||
|
||||
$output->prefix("");
|
||||
};
|
||||
|
||||
|
||||
my $create_type = sub {
|
||||
return 'type'->new;
|
||||
};
|
||||
|
|
@ -444,160 +83,6 @@ foreach my $file (@c_files) {
|
|||
|
||||
&winapi_parser::parse_c_file($file, $create_function, $found_function, $create_type, $found_type, $found_preprocessor);
|
||||
|
||||
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");
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
$editor->flush;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,384 @@
|
|||
package winapi_fixup_documentation;
|
||||
|
||||
use strict;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw();
|
||||
@EXPORT_OK = qw(&fixup_documentation);
|
||||
|
||||
use config qw($current_dir $wine_dir);
|
||||
use modules qw($modules);
|
||||
use options qw($options);
|
||||
use output qw($output);
|
||||
use winapi qw($win16api $win32api @winapis);
|
||||
|
||||
my %documentation_line_used;
|
||||
|
||||
sub fixup_documentation {
|
||||
my $function = shift;
|
||||
my $editor = shift;
|
||||
|
||||
my $file = $function->file;
|
||||
my $documentation_line = $function->documentation_line;
|
||||
my $documentation = $function->documentation;
|
||||
my $function_line = $function->function_line;
|
||||
my $linkage = $function->linkage;
|
||||
my $return_type = $function->return_type;
|
||||
my $calling_convention = $function->calling_convention;
|
||||
my $internal_name = $function->internal_name;
|
||||
my $statements = $function->statements;
|
||||
|
||||
if($linkage eq "static" ||
|
||||
($linkage eq "extern" && !defined($statements)) ||
|
||||
($linkage eq "" && !defined($statements)))
|
||||
{
|
||||
return;
|
||||
}
|
||||
|
||||
my @external_names = $function->external_names;
|
||||
if($#external_names < 0) {
|
||||
return;
|
||||
}
|
||||
|
||||
if($documentation_line_used{$file}{documentation_line}) {
|
||||
$documentation = undef;
|
||||
}
|
||||
$documentation_line_used{$file}{$documentation_line}++;
|
||||
|
||||
my @module_ordinal_entries = ();
|
||||
foreach my $entry2 ($function->get_all_module_ordinal) {
|
||||
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
||||
if(($external_name2 eq "@" ||
|
||||
($win16api->is_module($module2) && !$win16api->is_function_stub_in_module($module2, $external_name2)) ||
|
||||
($win32api->is_module($module2) && !$win32api->is_function_stub_in_module($module2, $external_name2))) &&
|
||||
$modules->is_allowed_module_in_file($module2, "$current_dir/$file"))
|
||||
{
|
||||
push @module_ordinal_entries, $entry2;
|
||||
}
|
||||
}
|
||||
|
||||
my $spec_modified = 0;
|
||||
|
||||
if($options->stub && defined($documentation)) {
|
||||
my $calling_convention16 = $function->calling_convention16;
|
||||
my $calling_convention32 = $function->calling_convention32;
|
||||
|
||||
foreach my $winapi (@winapis) {
|
||||
my @entries = ();
|
||||
my $module = $winapi->function_internal_module($internal_name);
|
||||
my $ordinal = $winapi->function_internal_ordinal($internal_name);
|
||||
|
||||
if($winapi->is_function_stub_in_module($module, $internal_name)) {
|
||||
my $external_name = $internal_name;
|
||||
if($winapi->name eq "win16") {
|
||||
$external_name =~ s/(?:_)?16([AW]?)$//;
|
||||
if(defined($1)) {
|
||||
$external_name .= $1;
|
||||
}
|
||||
}
|
||||
push @entries, [$external_name, $module, $ordinal];
|
||||
}
|
||||
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
|
||||
my $external_name = $1;
|
||||
my $module = lc($2);
|
||||
my $ordinal = $3;
|
||||
|
||||
if($external_name ne "@" &&
|
||||
$winapi->is_module($module) &&
|
||||
$winapi->is_function_stub_in_module($module, $external_name) &&
|
||||
$internal_name !~ /^\U$module\E_\Q$external_name\E$/)
|
||||
{
|
||||
push @entries, [$external_name, $module, $ordinal];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $entry (@entries) {
|
||||
(my $external_name, my $module, my $ordinal) = @$entry;
|
||||
|
||||
my $refargument_types = $function->argument_types;
|
||||
|
||||
if(!defined($refargument_types)) {
|
||||
next;
|
||||
}
|
||||
|
||||
my $abort = 0;
|
||||
my $n;
|
||||
my @argument_kinds = map {
|
||||
my $type = $_;
|
||||
my $kind;
|
||||
if($type ne "..." && !defined($kind = $winapi->translate_argument($type))) {
|
||||
$output->write("no translation defined: " . $type . "\n");
|
||||
}
|
||||
|
||||
# FIXME: Kludge
|
||||
if(defined($kind) && $kind eq "longlong") {
|
||||
$n += 2;
|
||||
("long", "long");
|
||||
} elsif(defined($kind)) {
|
||||
$n++;
|
||||
$kind;
|
||||
} elsif($type eq "...") {
|
||||
if($winapi->name eq "win16") {
|
||||
$calling_convention16 = "pascal"; # FIXME: Is this correct?
|
||||
} else {
|
||||
$calling_convention32 = "varargs";
|
||||
}
|
||||
();
|
||||
} else {
|
||||
$abort = 1;
|
||||
$n++;
|
||||
"undef";
|
||||
}
|
||||
} @$refargument_types;
|
||||
|
||||
my $search = "^\\s*$ordinal\\s+stub\\s+$external_name\\s*(?:#.*?)?\$";
|
||||
my $replace;
|
||||
if($winapi->name eq "win16") {
|
||||
$replace = "$ordinal $calling_convention16 $external_name(@argument_kinds) $internal_name";
|
||||
} else {
|
||||
$replace = "$ordinal $calling_convention32 $external_name(@argument_kinds) $internal_name";
|
||||
}
|
||||
|
||||
if(!$abort) {
|
||||
$spec_modified = 1;
|
||||
$editor->replace_spec_file($module, $search, $replace);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my %found_external_names;
|
||||
foreach my $external_name (@external_names) {
|
||||
$found_external_names{$external_name} = {};
|
||||
}
|
||||
|
||||
my $documentation_modified = 0;
|
||||
|
||||
if(!$spec_modified &&
|
||||
(defined($documentation) && !$documentation_modified) &&
|
||||
($options->documentation_name || $options->documentation_ordinal ||
|
||||
$options->documentation_missing))
|
||||
{
|
||||
local $_;
|
||||
|
||||
my $line3;
|
||||
my $search;
|
||||
my $replace;
|
||||
|
||||
my $count = 0;
|
||||
my $line2 = $documentation_line - 1;
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
$line2++;
|
||||
if(/^(\s*\*\s*(\S+)\s*)((?:\s*[\(\[]\s*\w+(?:\s*\.\s*[^\s\)\]]*\s*)?[\)\]])+)(.*?)$/) {
|
||||
my $part1 = $1;
|
||||
my $external_name = $2;
|
||||
my $part3 = $3;
|
||||
my $part4 = $4;
|
||||
|
||||
$part4 =~ s/\s*$//;
|
||||
|
||||
my @entries = ();
|
||||
while($part3 =~ s/^\s*([\(\[]\s*(\w+)(?:\s*\.\s*([^\s\)\]]*)\s*)?[\)\]])//) {
|
||||
push @entries, [$1, $2, $3];
|
||||
}
|
||||
|
||||
my $found = 0;
|
||||
foreach my $external_name2 (@external_names) {
|
||||
if($external_name eq $external_name2) {
|
||||
foreach my $entry (@entries) {
|
||||
(undef, my $module, undef) = @$entry;
|
||||
$found_external_names{$external_name2}{$module} = 1;
|
||||
}
|
||||
$found = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
my $replaced = 0;
|
||||
my $replace2 = "";
|
||||
foreach my $entry (@entries) {
|
||||
my $part12 = $part1;
|
||||
(my $part32, my $module, my $ordinal) = @$entry;
|
||||
|
||||
foreach my $entry2 (@module_ordinal_entries) {
|
||||
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
||||
|
||||
if($options->documentation_name && lc($module) eq $module2 &&
|
||||
$external_name ne $external_name2)
|
||||
{
|
||||
if(!$found && $part12 =~ s/\b\Q$external_name\E\b/$external_name2/) {
|
||||
$external_name = $external_name2;
|
||||
$replaced++;
|
||||
}
|
||||
}
|
||||
|
||||
if($options->documentation_ordinal &&
|
||||
$external_name eq $external_name2 &&
|
||||
lc($module) eq $module2 &&
|
||||
($#entries > 0 || !defined($ordinal) || ($ordinal ne $ordinal2)))
|
||||
{
|
||||
if(defined($ordinal)) {
|
||||
if($part32 =~ s/\Q$module\E\s*.\s*\Q$ordinal\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
|
||||
$replaced++;
|
||||
}
|
||||
} else {
|
||||
if($part32 =~ s/\Q$module\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
|
||||
$replaced++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if($replace2) { $replace2 .= "\n"; }
|
||||
$replace2 .= "$part12$part32$part4";
|
||||
}
|
||||
|
||||
if($replaced > 0) {
|
||||
$line3 = $line2;
|
||||
$search = "^\Q$_\E\$";
|
||||
$replace = $replace2;
|
||||
}
|
||||
$count++;
|
||||
} elsif(/^(\s*\*\s*)([^\s\(]+)(?:\(\))?\s*$/) {
|
||||
my $part1 = $1;
|
||||
my $external_name = $2;
|
||||
|
||||
if($internal_name =~ /^(?:\S+_)?\Q$external_name\E(?:16)?$/) {
|
||||
foreach my $entry (@module_ordinal_entries) {
|
||||
(my $external_name2, my $module, my $ordinal) = @$entry;
|
||||
|
||||
$line3 = $line2;
|
||||
$search = "^\Q$_\E\$";
|
||||
$replace = "$part1$external_name2 (\U$module\E.$ordinal)";
|
||||
}
|
||||
$count++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if(defined($line3) && defined($search) && defined($replace)) {
|
||||
if($count > 1 || $#external_names >= 1) {
|
||||
$output->write("multiple entries (fixup not supported)\n");
|
||||
# $output->write("s/$search/$replace/\n");
|
||||
# $output->write("@external_names\n");
|
||||
} else {
|
||||
$documentation_modified = 1;
|
||||
$editor->substitute_line($line3, $search, $replace);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if(!$spec_modified && !$documentation_modified &&
|
||||
$options->documentation_missing && defined($documentation))
|
||||
{
|
||||
my $part1;
|
||||
my $part2;
|
||||
my $part3;
|
||||
my $part4;
|
||||
my $line3 = 0;
|
||||
|
||||
my $line2 = $documentation_line - 1;
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
$line2++;
|
||||
if(/^(\s*\*\s*)(\S+\s*)([\(\[])\s*\w+\s*\.\s*[^\s\)\]]*\s*([\)\]]).*?$/) {
|
||||
$part1 = $1;
|
||||
$part2 = $2;
|
||||
$part3 = $3;
|
||||
$part4 = $4;
|
||||
|
||||
$part2 =~ s/\S/ /g;
|
||||
|
||||
$line3 = $line2 + 1;
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $entry2 (@module_ordinal_entries) {
|
||||
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
||||
|
||||
my $found = 0;
|
||||
foreach my $external_name (keys(%found_external_names)) {
|
||||
foreach my $module3 (keys(%{$found_external_names{$external_name}})) {
|
||||
if($external_name eq $external_name2 && uc($module2) eq $module3) {
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
# FIXME: Not 100% correct
|
||||
if(!$found &&
|
||||
!$win16api->is_function_stub_in_module($module2, $internal_name) &&
|
||||
!$win32api->is_function_stub_in_module($module2, $internal_name))
|
||||
{
|
||||
if($line3 > 0) {
|
||||
$documentation_modified = 1;
|
||||
$part2 = $external_name2 . " " x (length($part2) - length($external_name2));
|
||||
$editor->insert_line($line3, "$part1$part2$part3\U$module2\E.$ordinal2$part4\n");
|
||||
} else {
|
||||
$output->write("$external_name2 (\U$module2\E.$ordinal2) missing (fixup not supported)\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if(!$documentation_modified &&
|
||||
defined($documentation) &&
|
||||
$options->documentation_wrong)
|
||||
{
|
||||
my $line2 = $documentation_line - 1;
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
$line2++;
|
||||
if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
|
||||
my $external_name = $1;
|
||||
my $module = $2;
|
||||
my $ordinal = $3;
|
||||
|
||||
my $found = 0;
|
||||
foreach my $entry2 (@module_ordinal_entries) {
|
||||
(my $external_name2, my $module2, my $ordinal2) = @$entry2;
|
||||
|
||||
if($external_name eq $external_name2 &&
|
||||
lc($module) eq $module2 &&
|
||||
$ordinal eq $ordinal2)
|
||||
{
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
if(!$found) {
|
||||
if(1) {
|
||||
$documentation_modified = 1;
|
||||
|
||||
$editor->delete_line($line2, "^\Q$_\E\$");
|
||||
} else {
|
||||
$output->write("$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n");
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if(!$spec_modified && !$documentation_modified && !defined($documentation))
|
||||
{
|
||||
my $insert = "";
|
||||
foreach my $winapi (@winapis) {
|
||||
my $external_name = $winapi->function_external_name($internal_name);
|
||||
my $module = $winapi->function_internal_module($internal_name);
|
||||
my $ordinal = $winapi->function_internal_ordinal($internal_name);
|
||||
|
||||
if(defined($external_name) && defined($module) && defined($ordinal)) {
|
||||
$insert .= " *\t\t$external_name (\U$module\E.$ordinal)\n";
|
||||
}
|
||||
}
|
||||
if($insert) {
|
||||
$editor->insert_line($function_line,
|
||||
"/" . "*" x 71 . "\n" .
|
||||
"$insert" .
|
||||
" */\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,389 @@
|
|||
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;
|
||||
|
|
@ -28,6 +28,8 @@ my %options_long = (
|
|||
"documentation-name" => { default => 1, parent => "documentation", description => "documentation name fixup" },
|
||||
"documentation-ordinal" => { default => 1, parent => "documentation", description => "documentation ordinal fixup" },
|
||||
"documentation-wrong" => { default => 1, parent => "documentation", description => "documentation wrong fixup" },
|
||||
"statements" => { default => 1, parent => "local", description => "statements fixup" },
|
||||
"statements-windowsx" => { default => 1, parent => "local", description => "statements windowsx fixup" },
|
||||
"stub" => { default => 0, parent => "local", description => "stub fixup" },
|
||||
|
||||
"global" => { default => 1, description => "global fixup" },
|
||||
|
|
|
|||
|
|
@ -0,0 +1,198 @@
|
|||
package winapi_fixup_statements;
|
||||
|
||||
use strict;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw();
|
||||
@EXPORT_OK = qw(&fixup_statements);
|
||||
|
||||
use options qw($options);
|
||||
use output qw($output);
|
||||
|
||||
use c_parser;
|
||||
|
||||
sub fixup_function_call {
|
||||
my $name = shift;
|
||||
my @arguments = @{(shift)};;
|
||||
|
||||
return "$name(" . join(", ", @arguments) . ")";
|
||||
}
|
||||
|
||||
sub _parse_makelong {
|
||||
my $value = shift;
|
||||
|
||||
my $low;
|
||||
my $high;
|
||||
if($value =~ /^
|
||||
(?:\(\w+\)\s*)?
|
||||
MAKE(?:LONG|LPARAM|LRESULT|WPARAM)\s*
|
||||
\(\s*(.*?)\s*,\s*(.*?)\s*\)$/sx)
|
||||
{
|
||||
$low = $1;
|
||||
$high = $2;
|
||||
} elsif($value =~ /^(?:\(\w+\)\s*)?0L?$/) {
|
||||
$low = "0";
|
||||
$high = "0";
|
||||
} else {
|
||||
$low = "($value) & 0xffff";
|
||||
$high = "($value) << 16";
|
||||
}
|
||||
|
||||
return ($low, $high);
|
||||
}
|
||||
|
||||
sub fixup_function_call_2_forward_wm_call {
|
||||
my $name = shift;
|
||||
(my $hwnd, my $msg, my $wparam, my $lparam) = @{(shift)};
|
||||
|
||||
if($msg =~ /^(?:WM_BEGINDRAG|WM_ENTERMENULOOP|WM_EXITMENULOOP|WM_HELP|
|
||||
WM_ISACTIVEICON|WM_LBTRACKPOINT|WM_NEXTMENU)$/x)
|
||||
{
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $suffix;
|
||||
$name =~ /([AW])?$/;
|
||||
if(defined($1)) {
|
||||
$suffix = $1;
|
||||
} else {
|
||||
$suffix = "";
|
||||
}
|
||||
|
||||
$wparam =~ s/^\(WPARAM\)//;
|
||||
$lparam =~ s/^\(LPARAM\)//;
|
||||
|
||||
my @arguments;
|
||||
if(0) {
|
||||
# Nothing
|
||||
} elsif($msg =~ /^WM_COMMAND$/) {
|
||||
(my $id, my $code_notify) = _parse_makelong($wparam);
|
||||
my $hwndctl = $lparam;
|
||||
@arguments = ($id, $hwndctl, $code_notify);
|
||||
} elsif($msg =~ /^WM_(?:COPY|CUT|PASTE)$/) {
|
||||
@arguments = ();
|
||||
} elsif($msg =~ /^WM_(?:CHARTO|VKEYTO)ITEM$/) {
|
||||
(my $key, my $caret) = _parse_makelong($wparam);
|
||||
my $hwndctl = $lparam;
|
||||
@arguments = ($key, $hwndctl, $caret);
|
||||
} elsif($msg =~ /^WM_(?:COMPARE|DELETE|DRAW|MEASURE)ITEM$/) {
|
||||
@arguments = ($lparam);
|
||||
} elsif($msg =~ s/^WM_GETTEXT$/$&$suffix/) {
|
||||
@arguments = ($wparam, $lparam);
|
||||
} elsif($msg =~ /^WM_INITMENU$/) {
|
||||
my $hmenu = $wparam;
|
||||
@arguments = ($hmenu);
|
||||
} elsif($msg =~ /^WM_INITMENUPOPUP$/) {
|
||||
my $hmenu = $wparam;
|
||||
(my $item, my $system_menu) = _parse_makelong($lparam);
|
||||
@arguments = ($hmenu, $item, $system_menu);
|
||||
} elsif($msg =~ /^WM_MENUCHAR$/) {
|
||||
(my $ch, my $flags) = _parse_makelong($wparam);
|
||||
my $hmenu = $lparam;
|
||||
@arguments = ($ch, $flags, $hmenu);
|
||||
} elsif($msg =~ /^WM_MENUSELECT$/) {
|
||||
(my $item, my $flags) = _parse_makelong($wparam);
|
||||
my $hmenu = $lparam;
|
||||
my $hmenu_popup = "NULL"; # FIXME: Is this really correct?
|
||||
@arguments = ($hmenu, $item, $hmenu_popup, $flags);
|
||||
} elsif($msg =~ s/^WM_(NC)?LBUTTONDBLCLK$/WM_$1LBUTTONDOWN/) {
|
||||
my $double_click = "TRUE";
|
||||
my $key_flags = $wparam;
|
||||
(my $x, my $y) = _parse_makelong($lparam);
|
||||
@arguments = ($double_click, $x, $y, $key_flags);
|
||||
} elsif($msg =~ /^WM_(NC)?LBUTTONDOWN$/) {
|
||||
my $double_click = "FALSE";
|
||||
my $key_flags = $wparam;
|
||||
(my $x, my $y) = _parse_makelong($lparam);
|
||||
@arguments = ($double_click, $x, $y, $key_flags);
|
||||
} elsif($msg =~ /^WM_LBUTTONUP$/) {
|
||||
my $key_flags = $wparam;
|
||||
(my $x, my $y) = _parse_makelong($lparam);
|
||||
@arguments = ($x, $y, $key_flags);
|
||||
} elsif($msg =~ /^WM_SETCURSOR$/) {
|
||||
my $hwnd_cursor = $wparam;
|
||||
(my $code_hit_test, my $msg2) = _parse_makelong($lparam);
|
||||
@arguments = ($hwnd_cursor, $code_hit_test, $msg2);
|
||||
} elsif($msg =~ s/^WM_SETTEXT$/$&$suffix/) {
|
||||
my $text = $lparam;
|
||||
@arguments = ($text);
|
||||
} elsif($msg =~ /^WM_(?:SYS)?KEYDOWN$/) {
|
||||
my $vk = $wparam;
|
||||
(my $repeat, my $flags) = _parse_makelong($lparam);
|
||||
@arguments = ($vk, $repeat, $flags);
|
||||
} else {
|
||||
@arguments = ($wparam, $lparam);
|
||||
}
|
||||
unshift @arguments, $hwnd;
|
||||
|
||||
return "FORWARD_" . $msg . "(" . join(", ", @arguments) . ", $name)";
|
||||
}
|
||||
|
||||
sub fixup_statements {
|
||||
my $function = shift;
|
||||
my $editor = shift;
|
||||
|
||||
my $linkage = $function->linkage;
|
||||
my $internal_name = $function->internal_name;
|
||||
my $statements_line = $function->statements_line;
|
||||
my $statements = $function->statements;
|
||||
|
||||
if(($linkage eq "extern" && !defined($statements)) ||
|
||||
($linkage eq "" && !defined($statements)))
|
||||
{
|
||||
return;
|
||||
}
|
||||
|
||||
if($options->statements_windowsx && defined($statements)) {
|
||||
my $found_function_call = sub {
|
||||
my $begin_line = shift;
|
||||
my $begin_column = shift;
|
||||
my $end_line = shift;
|
||||
my $end_column = shift;
|
||||
my $name = shift;
|
||||
my $arguments = shift;
|
||||
|
||||
foreach my $argument (@$arguments) {
|
||||
$argument =~ s/^\s*(.*?)\s*$/$1/;
|
||||
}
|
||||
|
||||
if($options->statements_windowsx &&
|
||||
$name =~ /^(?:DefWindowProc|SendMessage)[AW]$/ &&
|
||||
$$arguments[1] =~ /^WM_\w+$/)
|
||||
{
|
||||
fixup_replace(\&fixup_function_call_2_forward_wm_call, $editor,
|
||||
$begin_line, $begin_column, $end_line, $end_column,
|
||||
$name, $arguments);
|
||||
} elsif(0) {
|
||||
$output->write("$begin_line.$begin_column-$end_line.$end_column: " .
|
||||
"$name(" . join(", ", @$arguments) . ")\n");
|
||||
}
|
||||
};
|
||||
my $line = $statements_line;
|
||||
my $column = 1;
|
||||
|
||||
if(!&c_parser::parse_c_statements(\$statements, \$line, \$column, $found_function_call)) {
|
||||
$output->write("error: can't parse statements\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub fixup_replace {
|
||||
my $function = shift;
|
||||
my $editor = shift;
|
||||
my $begin_line = shift;
|
||||
my $begin_column = shift;
|
||||
my $end_line = shift;
|
||||
my $end_column = shift;
|
||||
|
||||
my $replace = &$function(@_);
|
||||
|
||||
if(defined($replace)) {
|
||||
$editor->replace($begin_line, $begin_column, $end_line, $end_column, $replace);
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -6,7 +6,6 @@ DWORD
|
|||
HANDLE
|
||||
HBITMAP
|
||||
HDROP
|
||||
HGLOBAL
|
||||
HMENU
|
||||
HICON
|
||||
HINSTANCE
|
||||
|
|
|
|||
|
|
@ -20,19 +20,17 @@ DEVMODEA *
|
|||
DOCINFOA *
|
||||
DWORD *
|
||||
INT *
|
||||
LPCVOID
|
||||
LPDEVMODEA
|
||||
LPINT
|
||||
LPLOGFONTW
|
||||
LPSIZE
|
||||
LPVOID
|
||||
POINT *
|
||||
RECT *
|
||||
TEXTMETRICW *
|
||||
void *
|
||||
|
||||
%ptr # --forbidden
|
||||
|
||||
SEGPTR
|
||||
|
||||
%str
|
||||
|
||||
LPCSTR
|
||||
|
|
|
|||
|
|
@ -56,10 +56,6 @@ WINDOWPOS *
|
|||
WND *
|
||||
void *
|
||||
|
||||
%ptr # --forbidden
|
||||
|
||||
SEGPTR
|
||||
|
||||
%str
|
||||
|
||||
LPCSTR
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@ sub parse_c_file {
|
|||
my $argument_types;
|
||||
my $argument_names;
|
||||
my $argument_documentations;
|
||||
my $statements_line;
|
||||
my $statements;
|
||||
|
||||
$function_begin = sub {
|
||||
|
|
@ -64,6 +65,7 @@ sub parse_c_file {
|
|||
};
|
||||
|
||||
$function_end = sub {
|
||||
$statements_line = shift;
|
||||
$statements = shift;
|
||||
|
||||
my $function = &$function_create_callback();
|
||||
|
|
@ -90,6 +92,7 @@ sub parse_c_file {
|
|||
if(defined($argument_documentations)) {
|
||||
$function->argument_documentations([@$argument_documentations]);
|
||||
}
|
||||
$function->statements_line($statements_line);
|
||||
$function->statements($statements);
|
||||
|
||||
&$function_found_callback($function);
|
||||
|
|
@ -127,6 +130,7 @@ sub parse_c_file {
|
|||
my %regs_entrypoints;
|
||||
my @comment_lines = ();
|
||||
my @comments = ();
|
||||
my $statements_line;
|
||||
my $statements;
|
||||
my $level = 0;
|
||||
my $extern_c = 0;
|
||||
|
|
@ -163,9 +167,15 @@ sub parse_c_file {
|
|||
}
|
||||
|
||||
# remove C comments
|
||||
if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) {
|
||||
if(/^(.*?)(\/\*(.*?)\*\/)(.*)$/s) {
|
||||
my @lines = split(/\n/, $2);
|
||||
push @comment_lines, $.;
|
||||
push @comments, $2;
|
||||
push @comments, $2;
|
||||
if($#lines <= 0) {
|
||||
$_ = "$1 $4";
|
||||
} else {
|
||||
$_ = $1 . ("\n" x $#lines) . $4;
|
||||
}
|
||||
$again = 1;
|
||||
next;
|
||||
}
|
||||
|
|
@ -175,23 +185,25 @@ sub parse_c_file {
|
|||
}
|
||||
|
||||
# remove C++ comments
|
||||
while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1 }
|
||||
while(s/^(.*?)\/\/.*?$/$1/s) { $again = 1 }
|
||||
if($again) { next; }
|
||||
|
||||
# remove empty rows
|
||||
if(/^\s*$/) { next; }
|
||||
|
||||
# remove preprocessor directives
|
||||
if(s/^\s*\#/\#/m) {
|
||||
if(/^\\#.*?\\$/m) {
|
||||
if(s/^\s*\#/\#/s) {
|
||||
if(/^\#.*?\\$/s) {
|
||||
$lookahead = 1;
|
||||
next;
|
||||
} elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
|
||||
} elsif(s/^\#\s*(\w+)((?:\s+(.*?))?\s*)$//s) {
|
||||
my @lines = split(/\n/, $2);
|
||||
if($#lines > 0) {
|
||||
$_ = "\n" x $#lines;
|
||||
}
|
||||
if(defined($3)) {
|
||||
&$preprocessor_found_callback($1, $3);
|
||||
} else {
|
||||
&$preprocessor_found_callback($1, "");
|
||||
}
|
||||
$again = 1;
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
|
@ -282,6 +294,7 @@ sub parse_c_file {
|
|||
$line .= "{";
|
||||
print "+1: \{$_\n" if $options->debug >= 2;
|
||||
$level++;
|
||||
$statements .= $line;
|
||||
} elsif(s/^\}//) {
|
||||
$_ = $'; $again = 1;
|
||||
$line .= "}" if $level > 1;
|
||||
|
|
@ -291,15 +304,14 @@ sub parse_c_file {
|
|||
$extern_c = 0;
|
||||
$level = 0;
|
||||
}
|
||||
}
|
||||
|
||||
if($line !~ /^\s*$/) {
|
||||
$statements .= $line;
|
||||
} else {
|
||||
$statements .= "$line\n";
|
||||
}
|
||||
|
||||
if($level == 0) {
|
||||
if($in_function) {
|
||||
&$function_end($statements);
|
||||
&$function_end($statements_line, $statements);
|
||||
$statements = undef;
|
||||
} elsif($in_type) {
|
||||
if(/^\s*(?:WINE_PACKED\s+)?((?:\*\s*)?\w+\s*(?:\s*,\s*(?:\*+\s*)?\w+)*\s*);/s) {
|
||||
|
|
@ -404,8 +416,9 @@ sub parse_c_file {
|
|||
$function_line, $linkage, $return_type, $calling_convention, $name,
|
||||
\@argument_types,\@argument_names,\@argument_documentations);
|
||||
if($level == 0) {
|
||||
&$function_end(undef);
|
||||
&$function_end(undef, undef);
|
||||
}
|
||||
$statements_line = $.;
|
||||
$statements = "";
|
||||
} elsif(/__ASM_GLOBAL_FUNC\(\s*(.*?)\s*,/s) {
|
||||
my @lines = split(/\n/, $&);
|
||||
|
|
@ -415,7 +428,7 @@ sub parse_c_file {
|
|||
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "void", "__asm", $1);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
} elsif(/WAVEIN_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
|
||||
my @lines = split(/\n/, $&);
|
||||
my $function_line = $. - scalar(@lines) + 1;
|
||||
|
|
@ -425,10 +438,10 @@ sub parse_c_file {
|
|||
my @arguments32 = ("HWAVEIN");
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "UINT16", "WINAPI", "waveIn" . $1 . "16", \@arguments16);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "UINT", "WINAPI", "waveIn" . $1, \@arguments32);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
} elsif(/WAVEOUT_SHORTCUT_0\s*\(\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
|
||||
my @lines = split(/\n/, $&);
|
||||
my $function_line = $. - scalar(@lines) + 1;
|
||||
|
|
@ -439,10 +452,10 @@ sub parse_c_file {
|
|||
my @arguments32 = ("HWAVEOUT");
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "UINT16", "WINAPI", "waveOut" . $1 . "16", \@arguments16);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "UINT", "WINAPI", "waveOut" . $1, \@arguments32);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
} elsif(/WAVEOUT_SHORTCUT_(1|2)\s*\(\s*(.*?)\s*,\s*(.*?)\s*,\s*(.*?)\s*\)/s) {
|
||||
my @lines = split(/\n/, $&);
|
||||
my $function_line = $. - scalar(@lines) + 1;
|
||||
|
|
@ -454,19 +467,19 @@ sub parse_c_file {
|
|||
my @arguments32 = ("HWAVEOUT", $4);
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "UINT16", "WINAPI", "waveOut" . $2 . "16", \@arguments16);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
} elsif($1 eq 2) {
|
||||
my @arguments16 = ("UINT16", $4);
|
||||
my @arguments32 = ("UINT", $4);
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "UINT16", "WINAPI", "waveOut". $2 . "16", \@arguments16);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
&$function_begin($documentation_line, $documentation,
|
||||
$function_line, "", "UINT", "WINAPI", "waveOut" . $2, \@arguments32);
|
||||
&$function_end("");
|
||||
&$function_end($., "");
|
||||
}
|
||||
} elsif(/DEFINE_REGS_ENTRYPOINT_\d+\(\s*(\S*)\s*,\s*([^\s,\)]*).*?\)/s) {
|
||||
$_ = $'; $again = 1;
|
||||
|
|
|
|||
Loading…
Reference in New Issue