- New common code for the winapi tools.
- New tool for extracting source code information.
- New tool for automatically modifying (fixing) the source code.
diff --git a/tools/winapi/config.pm b/tools/winapi/config.pm
new file mode 100644
index 0000000..9149317
--- /dev/null
+++ b/tools/winapi/config.pm
@@ -0,0 +1,83 @@
+package config;
+
+use strict;
+
+use setup qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(
+ &file_type &file_skip &files_skip &get_spec_files
+);
+@EXPORT_OK = qw(
+ $current_dir $wine_dir $winapi_dir $winapi_check_dir
+);
+
+use vars qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
+
+sub file_type {
+ my $file = shift;
+
+ my $file_dir = $file;
+ if(!($file_dir =~ s/^(.*?)\/[^\/]*$/$1/)) {
+ $file_dir = ".";
+ }
+
+ $file_dir =~ s/^$wine_dir\///;
+
+ if($file_dir =~ /^(libtest|programs|rc|server|tests|tools)/ ||
+ $file =~ /dbgmain\.c$/ ||
+ $file =~ /wineclipsrv\.c$/) # FIXME: Kludge
+ {
+ return "application";
+ } elsif($file_dir =~ /^(debugger|miscemu)/) {
+ return "emulator";
+ } else {
+ return "library";
+ }
+}
+
+sub file_skip {
+ local $_ = shift;
+
+ $_ = "$current_dir/$_";
+ s%^\./%%;
+
+ m%^(?:libtest|programs|rc|server|tests|tools)/% && return 1;
+ m%^(?:debugger|miscemu|tsx11|server|unicode)/% && return 1;
+ m%^dlls/wineps/data/% && return 1;
+ m%^windows/x11drv/wineclipsrv.c% && return 1;
+ m%^dlls/winmm/wineoss/midipatch.c% && return 1;
+
+ return 0;
+}
+
+sub files_skip {
+ my @files;
+ foreach my $file (@_) {
+ if(!file_skip($file)) {
+ push @files, $file;
+ }
+ }
+
+ return @files;
+}
+
+sub get_spec_files {
+ output->progress("$wine_dir: searching for *.spec");
+
+ my @spec_files = map {
+ s/^$wine_dir\/(.*)$/$1/;
+ if(file_type($_) eq "library") {
+ $_;
+ } else {
+ ();
+ }
+ } split(/\n/, `find $wine_dir -name \\*.spec`);
+
+ return @spec_files;
+}
+
+1;
diff --git a/tools/winapi/options.pm b/tools/winapi/options.pm
new file mode 100644
index 0000000..b6ba052
--- /dev/null
+++ b/tools/winapi/options.pm
@@ -0,0 +1,348 @@
+package options;
+
+use strict;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&parse_comma_list);
+@EXPORT_OK = qw();
+
+sub parse_comma_list {
+ my $prefix = shift;
+ my $value = shift;
+ if(defined($prefix) && $prefix eq "no") {
+ return { active => 0, filter => 0, hash => {} };
+ } elsif(defined($value)) {
+ my %names;
+ for my $name (split /,/, $value) {
+ $names{$name} = 1;
+ }
+ return { active => 1, filter => 1, hash => \%names };
+ } else {
+ return { active => 1, filter => 0, hash => {} };
+ }
+}
+
+my $_options;
+
+sub new {
+ my $self = shift;
+ $_options = _options->new(@_);
+ return $_options;
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+
+ my $name = $options::AUTOLOAD;
+ $name =~ s/^.*::(.[^:]*)$/$1/;
+
+ return $_options->$name(@_);
+}
+
+package _options;
+
+use strict;
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+
+ my $options_long = \%{$self->{OPTIONS_LONG}};
+ my $options_short = \%{$self->{OPTIONS_SHORT}};
+ my $options_usage = \${$self->{OPTIONS_USAGE}};
+
+ my $refoptions_long = shift;
+ my $refoptions_short = shift;
+ $$options_usage = shift;
+
+ %$options_long = %{$refoptions_long};
+ %$options_short = %{$refoptions_short};
+
+ $self->options_set("default");
+
+ my $c_files = \@{$self->{C_FILES}};
+ my $h_files = \@{$self->{H_FILES}};
+ my @files;
+
+ while(defined($_ = shift @ARGV)) {
+ if(/^--(all|none)$/) {
+ $self->options_set("$1");
+ next;
+ } elsif(/^-([^=]*)(=(.*))?$/) {
+ my $name;
+ my $value;
+ if(defined($2)) {
+ $name = $1;
+ $value = $3;
+ } else {
+ $name = $1;
+ }
+
+ if($name =~ /^([^-].*)$/) {
+ $name = $$options_short{$1};
+ } else {
+ $name =~ s/^-(.*)$/$1/;
+ }
+
+ my $prefix;
+ if(defined($name) && $name =~ /^no-(.*)$/) {
+ $name = $1;
+ $prefix = "no";
+ if(defined($value)) {
+ output->write("options with prefix 'no' can't take parameters\n");
+
+ return undef;
+ }
+ }
+
+ my $option;
+ if(defined($name)) {
+ $option = $$options_long{$name};
+ }
+
+ if(defined($option)) {
+ my $key = $$option{key};
+ my $parser = $$option{parser};
+ my $refvalue = \${$self->{$key}};
+ my @parents = ();
+
+ if(defined($$option{parent})) {
+ if(ref($$option{parent}) eq "ARRAY") {
+ @parents = @{$$option{parent}};
+ } else {
+ @parents = $$option{parent};
+ }
+ }
+
+ if(defined($parser)) {
+ $$refvalue = &$parser($prefix,$value);
+ } else {
+ if(defined($value)) {
+ $$refvalue = $value;
+ } elsif(!defined($prefix)) {
+ $$refvalue = 1;
+ } else {
+ $$refvalue = 0;
+ }
+ }
+
+ if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
+ while($#parents >= 0) {
+ my @old_parents = @parents;
+ @parents = ();
+ foreach my $parent (@old_parents) {
+ my $parentkey = $$options_long{$parent}{key};
+ my $refparentvalue = \${$self->{$parentkey}};
+
+ $$refparentvalue = 1;
+
+ if(defined($$options_long{$parent}{parent})) {
+ if(ref($$options_long{$parent}{parent}) eq "ARRAY") {
+ push @parents, @{$$options_long{$parent}{parent}};
+ } else {
+ push @parents, $$options_long{$parent}{parent};
+ }
+ }
+ }
+ }
+ }
+ next;
+ }
+ }
+
+ if(/^-(.*)$/) {
+ output->write("unknown option: $_\n");
+ output->write($$options_usage);
+ exit 1;
+ } else {
+ if(!-e $_) {
+ output->write("$_: no such file or directory\n");
+ exit 1;
+ }
+
+ push @files, $_;
+ }
+ }
+
+ if($self->help) {
+ output->write($$options_usage);
+ $self->show_help;
+ exit 0;
+ }
+
+ my @paths = ();
+ my @c_files = ();
+ my @h_files = ();
+ foreach my $file (@files) {
+ if($file =~ /\.c$/) {
+ push @c_files, $file;
+ } elsif($file =~ /\.h$/) {
+ push @h_files, $file;
+ } else {
+ push @paths, $file;
+ }
+ }
+
+ if($#c_files == -1 && $#h_files == -1 && $#paths == -1)
+ {
+ @paths = ".";
+ }
+
+ if($#paths != -1 || $#c_files != -1) {
+ my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
+ my %found;
+ @$c_files = sort(map {
+ s/^\.\/(.*)$/$1/;
+ if(defined($found{$_}) || /glue\.c|spec\.c$/) {
+ ();
+ } else {
+ $found{$_}++;
+ $_;
+ }
+ } split(/\n/, `$c_command`));
+ }
+
+ if($#h_files != -1) {
+ my $h_command = "find " . join(" ", @h_files) . " -name \\*.h";
+ my %found;
+
+ @$h_files = sort(map {
+ s/^\.\/(.*)$/$1/;
+ if(defined($found{$_})) {
+ ();
+ } else {
+ $found{$_}++;
+ $_;
+ }
+ } split(/\n/, `$h_command`));
+ }
+
+ return $self;
+}
+
+sub DESTROY {
+}
+
+sub options_set {
+ my $self = shift;
+
+ my $options_long = \%{$self->{OPTIONS_LONG}};
+ my $options_short = \%{$self->{OPTIONS_SHORT}};
+
+ local $_ = shift;
+ for my $name (sort(keys(%$options_long))) {
+ my $option = $$options_long{$name};
+ my $key = uc($name);
+ $key =~ tr/-/_/;
+ $$option{key} = $key;
+ my $refvalue = \${$self->{$key}};
+
+ if(/^default$/) {
+ $$refvalue = $$option{default};
+ } elsif(/^all$/) {
+ if($name !~ /^help|debug|verbose|module$/) {
+ if(ref($$refvalue) ne "HASH") {
+ $$refvalue = 1;
+ } else {
+ $$refvalue = { active => 1, filter => 0, hash => {} };
+ }
+ }
+ } elsif(/^none$/) {
+ if($name !~ /^help|debug|verbose|module$/) {
+ if(ref($$refvalue) ne "HASH") {
+ $$refvalue = 0;
+ } else {
+ $$refvalue = { active => 0, filter => 0, hash => {} };
+ }
+ }
+ }
+ }
+}
+
+sub show_help {
+ my $self = shift;
+
+ my $options_long = \%{$self->{OPTIONS_LONG}};
+ my $options_short = \%{$self->{OPTIONS_SHORT}};
+
+ my $maxname = 0;
+ for my $name (sort(keys(%$options_long))) {
+ if(length($name) > $maxname) {
+ $maxname = length($name);
+ }
+ }
+
+ for my $name (sort(keys(%$options_long))) {
+ my $option = $$options_long{$name};
+ my $description = $$option{description};
+ my $default = $$option{default};
+ my $current = ${$self->{$$option{key}}};
+
+ my $value = $current;
+
+ my $command;
+ if(ref($value) ne "HASH") {
+ if($value) {
+ $command = "--no-$name";
+ } else {
+ $command = "--$name";
+ }
+ } else {
+ if($value->{active}) {
+ $command = "--[no-]$name\[=<value>]";
+ } else {
+ $command = "--$name\[=<value>]";
+ }
+ }
+
+ output->write($command);
+ for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { output->write(" "); }
+ if(ref($value) ne "HASH") {
+ if($value) {
+ output->write("Disable ");
+ } else {
+ output->write("Enable ");
+ }
+ } else {
+ if($value->{active}) {
+ output->write("(Disable) ");
+ } else {
+ output->write("Enable ");
+ }
+ }
+ if($default == $current) {
+ output->write("$description (default)\n");
+ } else {
+ output->write("$description\n");
+ }
+ }
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+
+ my $name = $_options::AUTOLOAD;
+ $name =~ s/^.*::(.[^:]*)$/\U$1/;
+
+ my $refvalue = $self->{$name};
+ if(!defined($refvalue)) {
+ die "<internal>: options.pm: member $name does not exists\n";
+ }
+
+ if(ref($$refvalue) ne "HASH") {
+ return $$refvalue;
+ } else {
+ return $$refvalue->{active};
+ }
+}
+
+sub c_files { my $self = shift; return @{$self->{C_FILES}}; }
+
+sub h_files { my $self = shift; return @{$self->{H_FILES}}; }
+
+1;
diff --git a/tools/winapi/output.pm b/tools/winapi/output.pm
new file mode 100644
index 0000000..a085f95
--- /dev/null
+++ b/tools/winapi/output.pm
@@ -0,0 +1,132 @@
+package output;
+
+use strict;
+
+my $_output;
+
+sub new {
+ my $self = shift;
+ $_output = _output->new(@_);
+ return $_output;
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+
+ my $name = $output::AUTOLOAD;
+ $name =~ s/^.*::(.[^:]*)$/$1/;
+
+ return $_output->$name(@_);
+}
+
+package _output;
+
+use strict;
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+
+ my $progress = \${$self->{PROGRESS}};
+ my $last_progress = \${$self->{LAST_PROGRESS}};
+ my $progress_count = \${$self->{PROGRESS_COUNT}};
+ my $prefix = \${$self->{PREFIX}};
+
+ $$progress = "";
+ $$last_progress = "";
+ $$progress_count = 0;
+ $$prefix = "";
+
+ return $self;
+}
+
+
+sub show_progress {
+ my $self = shift;
+ my $progress = \${$self->{PROGRESS}};
+ my $last_progress = \${$self->{LAST_PROGRESS}};
+ my $progress_count = \${$self->{PROGRESS_COUNT}};
+
+ $$progress_count++;
+
+ if($$progress_count > 0 && $$progress) {
+ print STDERR $$progress;
+ $$last_progress = $$progress;
+ }
+}
+
+sub hide_progress {
+ my $self = shift;
+ my $progress = \${$self->{PROGRESS}};
+ my $last_progress = \${$self->{LAST_PROGRESS}};
+ my $progress_count = \${$self->{PROGRESS_COUNT}};
+
+ $$progress_count--;
+
+ if($$last_progress) {
+ my $message;
+ for (1..length($$last_progress)) {
+ $message .= " ";
+ }
+ print STDERR $message;
+ undef $$last_progress;
+ }
+}
+
+sub update_progress {
+ my $self = shift;
+ my $progress = \${$self->{PROGRESS}};
+ my $last_progress = \${$self->{LAST_PROGRESS}};
+
+ my $prefix = "";
+ my $suffix = "";
+ if($$last_progress) {
+ for (1..length($$last_progress)) {
+ $prefix .= "";
+ }
+
+ my $diff = length($$last_progress)-length($$progress);
+ if($diff > 0) {
+ for (1..$diff) {
+ $suffix .= " ";
+ }
+ for (1..$diff) {
+ $suffix .= "";
+ }
+ }
+ }
+ print STDERR $prefix . $$progress . $suffix;
+ $$last_progress = $$progress;
+}
+
+sub progress {
+ my $self = shift;
+ my $progress = \${$self->{PROGRESS}};
+
+ $$progress = shift;
+
+ $self->update_progress;
+}
+
+sub prefix {
+ my $self = shift;
+ my $prefix = \${$self->{PREFIX}};
+
+ $$prefix = shift;
+}
+
+sub write {
+ my $self = shift;
+
+ my $message = shift;
+
+ my $prefix = \${$self->{PREFIX}};
+
+ $self->hide_progress;
+ print $$prefix . $message;
+ $self->show_progress;
+}
+
+1;
diff --git a/tools/winapi/setup.pm b/tools/winapi/setup.pm
new file mode 100644
index 0000000..15d2e16
--- /dev/null
+++ b/tools/winapi/setup.pm
@@ -0,0 +1,58 @@
+package setup;
+
+use strict;
+
+BEGIN {
+ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+ require Exporter;
+
+ @ISA = qw(Exporter);
+ @EXPORT = qw();
+ @EXPORT_OK = qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
+
+ use vars qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
+
+ my $dir;
+ my $tool;
+
+ if($0 =~ m%^((.*?)/?tools/([^/]+))/([^/]+)$%)
+ {
+ $winapi_dir = $1;
+ $winapi_check_dir = $1;
+ $dir = $3;
+ $tool = $4;
+
+ if(defined($2) && $2 ne "")
+ {
+ $wine_dir = $2;
+ } else {
+ $wine_dir = ".";
+
+ }
+
+ if($wine_dir =~ /^\./) {
+ $current_dir = ".";
+ my $pwd; chomp($pwd = `pwd`);
+ foreach my $n (1..((length($wine_dir) + 1) / 3)) {
+ $pwd =~ s/\/([^\/]*)$//;
+ $current_dir = "$1/$current_dir";
+ }
+ $current_dir =~ s%/\.$%%;
+ }
+
+ $winapi_dir =~ s%^\./%%;
+ $winapi_dir =~ s/$dir/winapi/g;
+
+ $winapi_check_dir =~ s%^\./%%;
+ $winapi_check_dir =~ s/$dir/winapi_check/g;
+ } else {
+ print STDERR "$tool: You must run this tool in the main Wine directory or a sub directory\n";
+ exit 1;
+ }
+
+ push @INC, ($winapi_check_dir, $winapi_dir) if $tool eq "winapi_check";
+ push @INC, ($winapi_dir, $winapi_check_dir) if $tool eq "winapi_extract";
+ push @INC, ($winapi_dir, $winapi_check_dir) if $tool eq "winapi_fixup";
+}
+
+1;
diff --git a/tools/winapi/util.pm b/tools/winapi/util.pm
new file mode 100644
index 0000000..a7e3f94
--- /dev/null
+++ b/tools/winapi/util.pm
@@ -0,0 +1,89 @@
+package util;
+
+use strict;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(append_file edit_file read_file replace_file);
+@EXPORT_OK = qw();
+%EXPORT_TAGS = ();
+
+########################################################################
+# append_file
+
+sub append_file {
+ my $filename = shift;
+ my $function = shift;
+
+ open(OUT, ">> $filename") || die "Can't open file '$filename'";
+ my $result = &$function(\*OUT, @_);
+ close(OUT);
+
+ return $result;
+}
+
+########################################################################
+# edit_file
+
+sub edit_file {
+ my $filename = shift;
+ my $function = shift;
+
+ open(IN, "< $filename") || die "Can't open file '$filename'";
+ open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
+
+ my $result = &$function(\*IN, \*OUT, @_);
+
+ close(IN);
+ close(OUT);
+
+ if($result) {
+ unlink("$filename");
+ rename("$filename.tmp", "$filename");
+ } else {
+ unlink("$filename.tmp");
+ }
+
+ return $result;
+}
+
+########################################################################
+# read_file
+
+sub read_file {
+ my $filename = shift;
+ my $function = shift;
+
+ open(IN, "< $filename") || die "Can't open file '$filename'";
+ my $result = &$function(\*IN, @_);
+ close(IN);
+
+ return $result;
+}
+
+########################################################################
+# replace_file
+
+sub replace_file {
+ my $filename = shift;
+ my $function = shift;
+
+ open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
+
+ my $result = &$function(\*OUT, @_);
+
+ close(OUT);
+
+ if($result) {
+ unlink("$filename");
+ rename("$filename.tmp", "$filename");
+ } else {
+ unlink("$filename.tmp");
+ }
+
+ return $result;
+}
+
+1;
diff --git a/tools/winapi/winapi_extract b/tools/winapi/winapi_extract
new file mode 100755
index 0000000..71a77ed
--- /dev/null
+++ b/tools/winapi/winapi_extract
@@ -0,0 +1,245 @@
+#!/usr/bin/perl -w
+
+# Copyright 2001 Patrik Stridvall
+
+use strict;
+
+BEGIN {
+ $0 =~ m%^(.*?/?tools)/winapi/winapi_extract$%;
+ require "$1/winapi/setup.pm";
+}
+
+use config qw(
+ &file_type &file_skip &files_skip &get_spec_files
+ $current_dir $wine_dir $winapi_dir $winapi_check_dir
+);
+use output;
+use options;
+use winapi;
+use winapi_parser;
+
+my $output = output->new;
+
+my %options_long = (
+ "debug" => { default => 0, description => "debug mode" },
+ "help" => { default => 0, description => "help mode" },
+ "verbose" => { default => 0, description => "verbose mode" },
+
+ "progress" => { default => 1, description => "show progress" },
+
+ "win16" => { default => 1, description => "Win16 extraction" },
+ "win32" => { default => 1, description => "Win32 extraction" },
+
+ "local" => { default => 1, description => "local extraction" },
+ "global" => { default => 1, description => "global extraction" },
+
+ "spec-files" => { default => 1, parent => "global", description => "spec files extraction" },
+);
+
+my %options_short = (
+ "d" => "debug",
+ "?" => "help",
+ "v" => "verbose"
+);
+
+my $options_usage = "usage: winapi_extract [--help] [<files>]\n";
+
+my $options = options->new(\%options_long, \%options_short, $options_usage);
+
+my %module2spec_file;
+my %module2type;
+{
+ local $_;
+
+ foreach my $spec_file (get_spec_files) {
+ my $module;
+ my $type;
+
+ open(IN, "< $wine_dir/$spec_file");
+ while(<IN>) {
+ s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begining and end of line
+ s/^(.*?)\s*#.*$/$1/; # remove comments
+ /^$/ && next; # skip empty lines
+
+ if(/^name\s+(.*?)$/) {
+ $module = $1;
+ $module2spec_file{$module} = $spec_file;
+ } elsif(/^type\s+(.*?)$/) {
+ $type = $1;
+ $module2type{$module} = $type;
+ }
+ }
+ close(IN);
+ }
+}
+
+my $win16api = winapi->new($options, $output, "win16", "$winapi_check_dir/win16");
+my $win32api = winapi->new($options, $output, "win32", "$winapi_check_dir/win32");
+my @winapis = ($win16api, $win32api);
+
+my %specifications;
+
+my @files = files_skip($options->c_files);
+
+my $progress_output;
+my $progress_current = 0;
+my $progress_max = scalar(@files);
+
+foreach my $file (@files) {
+ my $functions = 0;
+
+ $progress_current++;
+ if($options->progress) {
+ output->progress("$file: file $progress_current of $progress_max");
+ }
+
+ my $found_function = sub {
+ my $line = shift;
+ my $refdebug_channels = shift;
+ my @debug_channels = @$refdebug_channels;
+ my $documentation = shift;
+ my $linkage = shift;
+ my $return_type = shift;
+ my $calling_convention = shift;
+ my $internal_name = shift;
+ my $refargument_types = shift;
+ my @argument_types = @$refargument_types;
+ my $refargument_names = shift;
+ my @argument_names = @$refargument_names;
+ my $refargument_documentations = shift;
+ my @argument_documentations = @$refargument_documentations;
+ my $statements = shift;
+
+ $functions++;
+
+ if($linkage eq "static") {
+ return;
+ }
+
+ local $_;
+ foreach (split(/\n/, $documentation)) {
+ if(/^ \*\s*(\w+)\s*[\(\[]\s*(\w+)\.\s*(\@|\d+)\s*[\)\]]/m) {
+ my $name = $1;
+ my $module = lc($2);
+ my $ordinal = $3;
+
+ if($ordinal eq "@") {
+ $specifications{$module}{unfixed}{$name}{debug_channels} = [@debug_channels];
+ $specifications{$module}{unfixed}{$name}{name} = $name;
+ $specifications{$module}{unfixed}{$name}{ordinal} = $ordinal;
+ $specifications{$module}{unfixed}{$name}{arguments} = [@argument_types];
+ } else {
+ $specifications{$module}{fixed}{$ordinal}{debug_channels} = [@debug_channels];
+ $specifications{$module}{fixed}{$ordinal}{ordinal} = $ordinal;
+ $specifications{$module}{fixed}{$ordinal}{name} = $name;
+ $specifications{$module}{fixed}{$ordinal}{arguments} = [@argument_types];
+ }
+
+ if($options->debug) {
+ output->write("$file: $name ($module.$ordinal)\n");
+ }
+ }
+ }
+ };
+
+
+ my $found_preprocessor = sub {
+ my $directive = shift;
+ my $argument = shift;
+ };
+
+ winapi_parser::parse_c_file $options, $output, $file, $found_function, $found_preprocessor;
+
+ if($functions == 0) {
+ output->write("$file: doesn't contain any functions\n");
+ }
+}
+
+sub output_function {
+ local *OUT = shift;
+ my $type = shift;
+ my $function = shift;
+
+ my $name = $function->{name};
+ my $ordinal = $function->{ordinal};
+ my @arguments = @{$function->{arguments}};
+
+ my @arguments2;
+ foreach my $argument (@arguments) {
+ my $argument2;
+ if($type eq "win16") {
+ $argument2 = $win16api->translate_argument($argument);
+ } else {
+ $argument2 = $win32api->translate_argument($argument);
+ }
+ if(!defined($argument2)) {
+ $argument2 = "undef";
+ }
+ push @arguments2, $argument2;
+ }
+
+ if($type eq "win16") {
+ print OUT "$ordinal pascal $name(@arguments2) $name\n";
+ } else {
+ print OUT "$ordinal stdcall $name(@arguments2) $name\n";
+ }
+}
+
+if($options->spec_files) {
+ foreach my $module (keys(%specifications)) {
+ my $spec_file = $module2spec_file{$module};
+ my $type = $module2type{$module};
+
+ if(!defined($spec_file) || !defined($type)) {
+ output->write("$module: doesn't exist\n");
+ next;
+ }
+
+ $spec_file .= "2";
+
+ output->progress("$spec_file");
+ open(OUT, "> $wine_dir/$spec_file");
+
+ print OUT "name $module\n";
+ print OUT "type $type\n";
+ print OUT "\n";
+
+ my %debug_channels;
+ foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
+ my $function = $specifications{$module}{fixed}{$ordinal};
+ foreach my $debug_channel (@{$function->{debug_channels}}) {
+ $debug_channels{$debug_channel}++;
+ }
+ }
+ foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
+ my $function = $specifications{$module}{unfixed}{$name};
+ foreach my $debug_channel (@{$function->{debug_channels}}) {
+ $debug_channels{$debug_channel}++;
+ }
+ }
+
+ my @debug_channels = sort(keys(%debug_channels));
+ if($#debug_channels >= 0) {
+ print OUT "debug_channels (" . join(" ", @debug_channels) . ")\n";
+ print OUT "\n";
+ }
+
+ my $empty = 1;
+ foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
+ my $function = $specifications{$module}{fixed}{$ordinal};
+ output_function(\*OUT, $type, $function);
+ $empty = 0;
+ }
+
+ foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
+ if(!$empty) {
+ print OUT "\n";
+ $empty = 1;
+ }
+ my $function = $specifications{$module}{unfixed}{$name};
+ output_function(\*OUT, $type, $function);
+ }
+ close(OUT);
+ }
+}
+output->hide_progress;
diff --git a/tools/winapi/winapi_fixup b/tools/winapi/winapi_fixup
new file mode 100755
index 0000000..6f0e1a3
--- /dev/null
+++ b/tools/winapi/winapi_fixup
@@ -0,0 +1,194 @@
+#!/usr/bin/perl -w
+
+# Copyright 2001 Patrik Stridvall
+
+use strict;
+
+BEGIN {
+ $0 =~ m%^(.*?/?tools)/winapi/winapi_fixup$%;
+ require "$1/winapi/setup.pm";
+}
+
+use config qw(
+ &file_type &file_skip &files_skip &get_spec_files
+ $current_dir $wine_dir $winapi_dir $winapi_check_dir
+);
+use output;
+use options;
+use modules;
+use util;
+use winapi;
+use winapi_parser;
+
+my $output = output->new;
+
+my %options_long = (
+ "debug" => { default => 0, description => "debug mode" },
+ "help" => { default => 0, description => "help mode" },
+ "verbose" => { default => 0, description => "verbose mode" },
+
+ "progress" => { default => 1, description => "show progress" },
+
+ "win16" => { default => 1, description => "Win16 fixup" },
+ "win32" => { default => 1, description => "Win32 fixup" },
+
+ "local" => { default => 1, description => "local fixup" },
+ "global" => { default => 1, description => "global fixup" },
+
+ "modify" => { default => 0, description => "global fixup" },
+);
+
+my %options_short = (
+ "d" => "debug",
+ "?" => "help",
+ "v" => "verbose"
+);
+
+my $options_usage = "usage: winapi_fixup [--help] [<files>]\n";
+
+my $options = options->new(\%options_long, \%options_short, $options_usage);
+
+my $modules = modules->new($options, $output, $wine_dir, $current_dir, \&file_type, "$winapi_check_dir/modules.dat");
+
+my $win16api = winapi->new($options, $output, "win16", "$winapi_check_dir/win16");
+my $win32api = winapi->new($options, $output, "win32", "$winapi_check_dir/win32");
+my @winapis = ($win16api, $win32api);
+
+if($wine_dir eq ".") {
+ winapi->read_all_spec_files($modules, $wine_dir, $current_dir, \&file_type, $win16api, $win32api);
+} else {
+ my @spec_files = $modules->allowed_spec_files($wine_dir, $current_dir);
+ winapi->read_spec_files($modules, $wine_dir, $current_dir, \@spec_files, $win16api, $win32api);
+}
+
+my %substitute;
+my %insert_line;
+
+my @c_files = files_skip(options->c_files);
+
+my $progress_output;
+my $progress_current = 0;
+my $progress_max = scalar(@c_files);
+
+foreach my $file (@c_files) {
+ $progress_current++;
+ if(options->progress) {
+ output->progress("$file: file $progress_current of $progress_max");
+ }
+
+ my $found_function = sub {
+ my $line = shift;
+ my $refdebug_channels = shift;
+ my @debug_channels = @$refdebug_channels;
+ my $documentation = shift;
+ my $linkage = shift;
+ my $return_type = shift;
+ my $calling_convention = shift;
+ my $internal_name = shift;
+ my $refargument_types = shift;
+ my @argument_types = @$refargument_types;
+ my $refargument_names = shift;
+ my @argument_names = @$refargument_names;
+ my $refargument_documentations = shift;
+ my @argument_documentations = @$refargument_documentations;
+ my $statements = shift;
+
+ if($linkage eq "static" || $linkage eq "extern") {
+ return;
+ }
+
+ if($documentation) {
+ local $_;
+ foreach (split(/\n/, $documentation)) {
+ if(/^(\s*\*\s*\w+\s*)([\(\[]\s*\w+\.\s*(?:\@|\d+)\s*[\)\]])\s*([\(\[]\s*\w+\.\s*(?:\@|\d+)\s*[\)\]])/m) {
+ $substitute{$_}{search} = $_;
+ $substitute{$_}{replace} = "$1$2\n$1$3";
+ } elsif(/^\s*\*\s*(\w+)\s*[\(\[]\s*(\w+)\.\s*(\@|\d+)\s*[\)\]]/m) {
+ my $name = $1;
+ my $module = $2;
+ my $ordinal = $3;
+
+ my $module2;
+ my $ordinal2;
+ foreach my $winapi (@winapis) {
+ $module2 = ($winapi->function_module($internal_name) || $module2);
+ $ordinal2 = ($winapi->function_ordinal($internal_name) || $ordinal2);
+ if(defined($module2) || defined($ordinal2)) { last; }
+ }
+
+ if(!defined($module2) || !defined($ordinal2)) {
+ output->write("$file: $internal_name: unknown error\n");
+ } elsif(lc($module) eq $module2 && $ordinal ne $ordinal2) {
+ $substitute{$_}{search} = "$module.$ordinal";
+ $substitute{$_}{replace} = "\U$module2\E.$ordinal2";
+ }
+ }
+ }
+ } elsif(0) {
+ my $name;
+ my $module;
+ my $ordinal;
+ foreach my $winapi (@winapis) {
+ $name = ($winapi->function_external_name($internal_name) || $name);
+ $module = ($winapi->function_module($internal_name) || $module);
+ $ordinal = ($winapi->function_ordinal($internal_name) || $ordinal);
+ if(defined($name) || defined($module) || defined($ordinal)) { last; }
+ }
+
+ if(defined($name) && defined($module) && defined($ordinal)) {
+ $insert_line{$line} =
+ "/" . "*" x 71 . "\n" .
+ " *\t\t$name (\U$module\E.$ordinal)\n" .
+ " */\n";
+ }
+ }
+ };
+
+ my $found_preprocessor = sub {
+ my $directive = shift;
+ my $argument = shift;
+ };
+
+ winapi_parser::parse_c_file $options, $output, $file, $found_function, $found_preprocessor;
+
+ my $editor = sub {
+ local *IN = shift;
+ local *OUT = shift;
+
+ my $modified = 0;
+ while(<IN>) {
+ chomp;
+
+ my $line = $insert_line{$.};
+ if(defined($line)) {
+ if(options->modify) {
+ $_ = "$line$_";
+ $modified = 1;
+ } else {
+ output->write("$file: $.: insert : '$line'\n");
+ }
+ }
+
+ my $search = $substitute{$_}{search};
+ my $replace = $substitute{$_}{replace};
+
+ if(defined($search) && defined($replace)) {
+ if(options->modify) {
+ if(s/\Q$search\E/$replace/) {
+ $modified = 1;
+ }
+ } else {
+ output->write("$file: $.: search : '$search'\n");
+ output->write("$file: $.: replace: '$replace'\n");
+ }
+ }
+ print OUT "$_\n";
+ }
+
+ return $modified;
+ };
+
+ edit_file($file, $editor);
+}
+
+output->hide_progress;
