winapi_fixup: There is not much point for this tool so remove it.

tools/winapi/winapi_fixup

-#!/usr/bin/perl -w
-
-# Copyright 2001 Patrik Stridvall
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-use strict;
-
-BEGIN {
-    $0 =~ m%^(.*?/?tools)/winapi/winapi_fixup$%;
-    require "$1/winapi/setup.pm";
-}
-
-use config qw(
-    files_filter files_skip
-    $current_dir $wine_dir $winapi_dir
-);
-use output qw($output);
-use winapi_fixup_options qw($options);
-
-if($options->progress) {
-    $output->enable_progress;
-} else {
-    $output->disable_progress;
-}
-
-use winapi_c_parser;
-use c_parser;
-use type;
-
-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);
-
-my $progress_output;
-my $progress_current = 0;
-my $progress_max = scalar(@c_files);
-
-foreach my $file (@c_files) {
-    my $editor = new winapi_fixup_editor($file);
-
-    $progress_current++;
-    $output->progress("$file (file $progress_current of $progress_max)");
-    $output->prefix("$file:");
-
-    {
-	open(IN, "< $file") || die "Error: Can't open $file: $!\n";
-	local $/ = undef;
-	$_ = <IN>;
-	close(IN);
-    }
-
-    my $max_line = 0;
-    {
-      local $_ = $_;
-      while(s/^.*?\n//) { $max_line++; }
-      if($_) { $max_line++; }
-    }
-
-    my $parser;
-    if (1) {
-	$parser = new c_parser($file);
-    } else {
-	$parser = new winapi_c_parser($file);
-    }
-
-    my $function;
-    my $line;
-
-    my $update_output = sub {
-	my $progress = "";
-	my $prefix = "";
-
-	$progress .= "$file (file $progress_current of $progress_max)";
-	$prefix .= "$file:";
-
-	if(defined($function)) {
-	    my $name = $function->name;
-	    my $begin_line = $function->begin_line;
-	    my $begin_column = $function->begin_column;
-
-	    $progress .= ": function $name";
-	    $prefix .= "$begin_line.$begin_column: function $name: ";
-	}
-
-	if(defined($line)) {
-	    $progress .= ": line $line of $max_line";
-	}
-
-	$output->progress($progress);
-	$output->prefix($prefix);
-    };
-
-    my $found_preprocessor = sub {
-	my $begin_line = shift;
-	my $begin_column = shift;
-	my $preprocessor = shift;
-
-	# $output->write("$begin_line.$begin_column: preprocessor: $preprocessor\n");
-
-	return 1;
-    };
-
-    $parser->set_found_preprocessor_callback($found_preprocessor);
-
-    my $found_comment = sub {
-	my $begin_line = shift;
-	my $begin_column = shift;
-	my $comment = shift;
-
-	# $output->write("$begin_line.$begin_column: comment: $comment\n");
-
-	return 1;
-    };
-
-    $parser->set_found_comment_callback($found_comment);
-
-    my $found_line = sub {
-	$line = shift;
-	# local $_ = shift;
-
-	&$update_output;
-
-	# $output->progress("$file: line $line of ?");
-    };
-
-    $parser->set_found_line_callback($found_line);
-
-    my $found_declaration = sub {
-	my $begin_line = shift;
-	my $begin_column = shift;
-	my $end_line = shift;
-	my $end_column = shift;
-	my $declaration = shift;
-
-	# $output->write("$begin_line.$begin_column-$end_line.$end_column: declaration: \\\n$declaration\n");
-
-	return 1;
-    };
-
-    $parser->set_found_declaration_callback($found_declaration);
-
-    my $found_function = sub {
-	$function = shift;
-
-	&$update_output;
-
-	my $name = $function->name;
-	my $begin_line = $function->begin_line;
-	my $begin_column = $function->begin_column;
-	my $end_line = $function->end_line;
-	my $end_column = $function->end_column;
-
-	if($options->documentation) {
-	    # fixup_documentation($function, $editor);
-	}
-
-	if($options->statements) {
-	    fixup_statements($function, $editor);
-	}
-
-	my $statements = $function->statements;
-	if(!defined($statements)) {
-	    $function = undef;
-	    $output->prefix("$file: ");
-	} else {
-	    # $output->write("$begin_line.$begin_column-$end_line.$end_column: function $name\n");
-	}
-
-	return 0;
-    };
-
-    $parser->set_found_function_callback($found_function);
-
-    my $found_variable = sub {
-	my $begin_line = shift;
-	my $begin_column = shift;
-	my $linkage = shift;
-	my $type = shift;
-	my $name = shift;
-
-	# $output->write("$begin_line.$begin_column: $linkage $type $name = /* ... */\n");
-
-	return 1;
-    };
-
-    $parser->set_found_variable_callback($found_variable);
-
-    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;
-
-	$output->write("$begin_line.$begin_column-$end_line.$end_column: $name(" . join(", ", @$arguments) . ")\n");
-
-	return 1;
-    };
-
-    $parser->set_found_function_call_callback($found_function_call);
-
-    {
-	my $line = 1;
-	my $column = 0;
-	if(!$parser->parse_c_file(\$_, \$line, \$column)) {
-	    $output->write("can't parse file\n");
-	}
-    }
-
-    $output->prefix("");
-
-    $editor->flush;
-}

tools/winapi/winapi_fixup_documentation.pm

-#
-# Copyright 1999, 2000, 2001 Patrik Stridvall
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-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 win*.api 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;

tools/winapi/winapi_fixup_editor.pm

-#
-# Copyright 1999, 2000, 2001 Patrik Stridvall
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-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;

tools/winapi/winapi_fixup_options.pm

-#
-# Copyright 1999, 2000, 2001 Patrik Stridvall
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-package winapi_fixup_options;
-use base qw(options);
-
-use strict;
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-require Exporter;
-
-@ISA = qw(Exporter);
-@EXPORT = qw();
-@EXPORT_OK = qw($options);
-
-use options qw($options);
-
-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" },
-    "documentation" => { default => 1, parent => "local", description => "documentation fixup" },
-    "documentation-missing" => { default => 1, parent => "documentation", description => "documentation missing fixup" },
-    "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 => 0, parent => "local", description => "statements windowsx fixup" },
-    "stub" => { default => 0, parent => "local", description => "stub fixup" },
-
-    "global" => { default => 1, description => "global fixup" },
-
-    "modify" => { default => 0, description => "actually perform the fixups" },
-);
-
-my %options_short = (
-    "d" => "debug",
-    "?" => "help",
-    "v" => "verbose"
-);
-
-my $options_usage = "usage: winapi_fixup [--help] [<files>]\n";
-
-$options = '_options'->new(\%options_long, \%options_short, $options_usage);
-
-1;

tools/winapi/winapi_fixup_statements.pm

-#
-# Copyright 1999, 2000, 2001 Patrik Stridvall
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
-#
-
-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 config qw($wine_dir);
-use options qw($options);
-use output qw($output);
-
-use c_parser;
-use winapi_module_user qw(
-    get_message_result_kind
-    get_message_wparam_kind
-    get_message_lparam_kind
-);
-
-########################################################################
-# fixup_function_call
-
-sub fixup_function_call($$) {
-    my $name = shift;
-    my @arguments = @{(shift)};;
-
-    return "$name(" . join(", ", @arguments) . ")";
-}
-
-########################################################################
-# _parse_makelong
-
-sub _parse_makelong($) {
-    local $_ = shift;
-
-    my $low;
-    my $high;
-
-    my $name;
-    my @arguments;
-    my @argument_lines;
-    my @argument_columns;
-
-    my $parser = new c_parser;
-
-    my $line = 1;
-    my $column = 0;
-    if($parser->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns) &&
-       $name =~ /^MAKE(?:LONG|LPARAM|LRESULT|WPARAM)$/)
-    {
-	$low = $arguments[0];
-	$high = $arguments[1];
-    } elsif(/^(?:\(\w+\)\s*)?0L?$/) {
-	$low = "0";
-	$high = "0";
-    } else {
-	$low = "($_) & 0xffff";
-	$high = "($_) << 16";
-    }
-
-    $low =~ s/^\s*(.*?)\s*$/$1/;
-    $high =~ s/^\s*(.*?)\s*$/$1/;
-
-    return ($low, $high);
-}
-
-########################################################################
-# fixup_function_call_2_windowsx
-
-sub fixup_user_message_2_windowsx($$) {
-    my $name = shift;
-    (my $hwnd, my $msg, my $wparam, my $lparam) = @{(shift)};
-
-    if($msg !~ /^WM_/) {
-	return undef;
-    } elsif($msg =~ /^(?:WM_BEGINDRAG|WM_ENTERMENULOOP|WM_EXITMENULOOP|WM_HELP|
-		       WM_ISACTIVEICON|WM_LBTRACKPOINT|WM_NEXTMENU)$/x)
-    {
-	return undef;
-    } elsif($msg =~ /^WM_(?:GET|SET)TEXT$/) {
-	return undef;
-    }
-
-    my $suffix;
-    $name =~ /([AW])?$/;
-    if(defined($1)) {
-	$suffix = $1;
-    } else {
-	$suffix = "";
-    }
-
-    $wparam =~ s/^\(WPARAM\)\s*//;
-    $lparam =~ s/^\(LPARAM\)\s*//;
-
-    my @arguments;
-    if($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)";
-}
-
-########################################################################
-# _get_messages
-
-sub _get_messages($) {
-    local $_ = shift;
-
-    if(/^(?:BM|CB|EM|LB|STM|WM)_\w+(.*?)$/) {
-	if(!$1) {
-	    return ($_);
-	} else {
-	    return ();
-	}
-    } elsif(/^(.*?)\s*\?\s*((?:BM|CB|EM|LB|STM|WM)_\w+)\s*:\s*((?:BM|CB|EM|LB|STM|WM)_\w+)$/) {
-	return ($2, $3);
-    } elsif(/^\w+$/) {
-	return ();
-    } elsif(/^RegisterWindowMessage[AW]\s*\(.*?\)$/) {
-	return ();
-    } else {
-	$output->write("warning: _get_messages: '$_'\n");
-	return ();
-    }
-}
-
-########################################################################
-# _fixup_user_message
-
-sub _fixup_user_message($$) {
-    my $name = shift;
-    (my $hwnd, my $msg, my $wparam, my $lparam) = @{(shift)};
-
-    my $modified = 0;
-
-    my $wkind;
-    my $lkind;
-    foreach my $msg (_get_messages($msg)) {
-	my $new_wkind = get_message_wparam_kind($msg);
-	if(defined($wkind) && $new_wkind ne $wkind) {
-	    $output->write("messsages used together do not have the same type\n");
-	} else {
-	    $wkind = $new_wkind;
-	}
-
-	my $new_lkind = get_message_lparam_kind($msg);
-	if(defined($lkind) && $new_lkind ne $lkind) {
-	    $output->write("messsages used together do not have the same type\n");
-	} else {
-	    $lkind = $new_lkind;
-	}
-    }
-
-    my @entries = (
-	[ \$wparam, $wkind, "W", "w" ],
-	[ \$lparam, $lkind, "L", "l" ]
-    );
-    foreach my $entry (@entries) {
-	(my $refparam, my $kind, my $upper, my $lower) = @$entry;
-
-	if(!defined($kind)) {
-	    if($msg =~ /^WM_/) {
-		$output->write("messsage $msg not properly defined\n");
-		$modified = 0;
-		last;
-	    }
-	} elsif($kind eq "ptr") {
-	    if($$refparam =~ /^(\(${upper}PARAM\))?\s*($lower[pP]aram)$/) {
-		if(defined($1)) {
-		    $$refparam = $2;
-		    $modified = 1;
-		}
-	    } elsif($$refparam =~ /^(\(${upper}PARAM\))?\s*0$/) {
-	        $$refparam = "(${upper}PARAM) NULL";
-		$modified = 1;
-	    } elsif($$refparam !~ /^\(${upper}PARAM\)\s*/) {
-                $$refparam = "(${upper}PARAM) $$refparam";
-		$modified = 1;
-	    }
-	} elsif($kind eq "long") {
-	    if($$refparam =~ s/^\(${upper}PARAM\)\s*//) {
-		$modified = 1;
-	    }
-	}
-    }
-
-    if($modified) {
-	my @arguments = ($hwnd, $msg, $wparam, $lparam);
-	return "$name(" . join(", ", @arguments) . ")";
-    } else {
-	return undef;
-    }
-}
-
-########################################################################
-# fixup_statements
-
-sub fixup_statements($$) {
-    my $function = shift;
-    my $editor = shift;
-
-    my $file = $function->file;
-    my $linkage = $function->linkage;
-    my $name = $function->name;
-    my $statements_line = $function->statements_line;
-    my $statements_column = $function->statements_column;
-    my $statements = $function->statements;
-
-    if(!defined($statements)) {
-	return;
-    }
-
-    my $parser = new c_parser($file);
-
-    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/;
-	}
-
-	my $fixup_function_call;
-	if($name =~ /^(?:DefWindowProc|SendMessage)[AW]$/)
-	{
-	    if($options->statements_windowsx) {
-		$fixup_function_call = \&fixup_user_message_2_windowsx;
-	    } else {
-		$fixup_function_call = \&_fixup_user_message;
-	    }
-	}
-
-	if(defined($fixup_function_call)) {
-	    my $replace = &$fixup_function_call($name, $arguments);
-
-	    if(defined($replace)) {
-		$editor->replace($begin_line, $begin_column, $end_line, $end_column, $replace);
-	    }
-	} elsif($options->debug) {
-	    $output->write("$begin_line.$begin_column-$end_line.$end_column: " .
-			   "$name(" . join(", ", @$arguments) . ")\n");
-	}
-
-	return 0;
-    };
-
-    $parser->set_found_function_call_callback($found_function_call);
-
-    my $line = $statements_line;
-    my $column = 0;
-    if(!$parser->parse_c_statements(\$statements, \$line, \$column)) {
-	$output->write("error: can't parse statements\n");
-    }
-}
-
-1;