hhctrl.ocx: Update win32.api to fix the winapi_check warnings.
[wine] / tools / winapi / winapi_fixup_documentation.pm
1 #
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
3 #
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
8 #
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12 # Lesser General Public License for more details.
13 #
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17 #
18
19 package winapi_fixup_documentation;
20
21 use strict;
22
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
24 require Exporter;
25
26 @ISA = qw(Exporter);
27 @EXPORT = qw();
28 @EXPORT_OK = qw(fixup_documentation);
29
30 use config qw($current_dir $wine_dir);
31 use modules qw($modules);
32 use options qw($options);
33 use output qw($output);
34 use winapi qw($win16api $win32api @winapis);
35
36 my %documentation_line_used;
37
38 sub fixup_documentation($$) {
39     my $function = shift;
40     my $editor = shift;
41
42     my $file = $function->file;
43     my $documentation_line = $function->documentation_line;
44     my $documentation = $function->documentation;
45     my $function_line = $function->function_line;
46     my $linkage = $function->linkage;
47     my $return_type = $function->return_type;
48     my $calling_convention = $function->calling_convention;
49     my $internal_name = $function->internal_name;
50     my $statements = $function->statements;
51
52     if($linkage eq "static" ||
53        ($linkage eq "extern" && !defined($statements)) ||
54        ($linkage eq "" && !defined($statements)))
55     {
56         return;
57     }
58
59     my @external_names = $function->external_names;
60     if($#external_names < 0) {
61         return;
62     }
63
64     if($documentation_line_used{$file}{documentation_line}) {
65         $documentation = undef;
66     }
67     $documentation_line_used{$file}{$documentation_line}++;
68
69     my @module_ordinal_entries = ();
70     foreach my $entry2 ($function->get_all_module_ordinal) {
71         (my $external_name2, my $module2, my $ordinal2) = @$entry2;
72         if(($external_name2 eq "@" ||
73             ($win16api->is_module($module2) && !$win16api->is_function_stub_in_module($module2, $external_name2)) ||
74             ($win32api->is_module($module2) && !$win32api->is_function_stub_in_module($module2, $external_name2))) &&
75                $modules->is_allowed_module_in_file($module2, "$current_dir/$file"))
76         {
77             push @module_ordinal_entries, $entry2;
78         }
79     }
80
81     my $spec_modified = 0;
82
83     if($options->stub && defined($documentation)) {
84         my $calling_convention16 = $function->calling_convention16;
85         my $calling_convention32 = $function->calling_convention32;
86
87         foreach my $winapi (@winapis) {
88             my @entries = ();
89             my $module = $winapi->function_internal_module($internal_name);
90             my $ordinal = $winapi->function_internal_ordinal($internal_name);
91
92             if($winapi->is_function_stub_in_module($module, $internal_name)) {
93                 my $external_name = $internal_name;
94                 if($winapi->name eq "win16") {
95                     $external_name =~ s/(?:_)?16([AW]?)$//;
96                     if(defined($1)) {
97                         $external_name .= $1;
98                     }
99                 }
100                 push @entries, [$external_name, $module, $ordinal];
101             }
102
103             foreach (split(/\n/, $documentation)) {
104                 if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
105                     my $external_name = $1;
106                     my $module = lc($2);
107                     my $ordinal = $3;
108
109                     if($external_name ne "@" &&
110                        $winapi->is_module($module) &&
111                        $winapi->is_function_stub_in_module($module, $external_name) &&
112                        $internal_name !~ /^\U$module\E_\Q$external_name\E$/)
113                     {
114                         push @entries, [$external_name, $module, $ordinal];
115                     }
116                 }
117             }
118
119             foreach my $entry (@entries) {
120                 (my $external_name, my $module, my $ordinal) = @$entry;
121
122                 my $refargument_types = $function->argument_types;
123
124                 if(!defined($refargument_types)) {
125                     next;
126                 }
127
128                 my $abort = 0;
129                 my $n;
130                 my @argument_kinds = map {
131                     my $type = $_;
132                     my $kind;
133                     if($type ne "..." && !defined($kind = $winapi->translate_argument($type))) {
134                         $output->write("no win*.api translation defined: " . $type . "\n");
135                     }
136
137                     # FIXME: Kludge
138                     if(defined($kind) && $kind eq "longlong") {
139                         $n += 2;
140                         ("long", "long");
141                     } elsif(defined($kind)) {
142                         $n++;
143                         $kind;
144                     } elsif($type eq "...") {
145                         if($winapi->name eq "win16") {
146                             $calling_convention16 = "pascal"; # FIXME: Is this correct?
147                         } else {
148                             $calling_convention32 = "varargs";
149                         }
150                         ();
151                     } else {
152                         $abort = 1;
153                         $n++;
154                         "undef";
155                     }
156                 } @$refargument_types;
157
158                 my $search = "^\\s*$ordinal\\s+stub\\s+$external_name\\s*(?:#.*?)?\$";
159                 my $replace;
160                 if($winapi->name eq "win16") {
161                     $replace = "$ordinal $calling_convention16 $external_name(@argument_kinds) $internal_name";
162                 } else {
163                     $replace = "$ordinal $calling_convention32 $external_name(@argument_kinds) $internal_name";
164                 }
165
166                 if(!$abort) {
167                     $spec_modified = 1;
168                     $editor->replace_spec_file($module, $search, $replace);
169                 }
170             }
171         }
172     }
173
174     my %found_external_names;
175     foreach my $external_name (@external_names) {
176         $found_external_names{$external_name} = {};
177     }
178
179     my $documentation_modified = 0;
180
181     if(!$spec_modified &&
182        (defined($documentation) && !$documentation_modified) &&
183        ($options->documentation_name || $options->documentation_ordinal ||
184         $options->documentation_missing))
185     {
186         local $_;
187
188         my $line3;
189         my $search;
190         my $replace;
191
192         my $count = 0;
193         my $line2 = $documentation_line - 1;
194         foreach (split(/\n/, $documentation)) {
195             $line2++;
196             if(/^(\s*\*\s*(\S+)\s*)((?:\s*[\(\[]\s*\w+(?:\s*\.\s*[^\s\)\]]*\s*)?[\)\]])+)(.*?)$/) {
197                 my $part1 = $1;
198                 my $external_name = $2;
199                 my $part3 = $3;
200                 my $part4 = $4;
201
202                 $part4 =~ s/\s*$//;
203
204                 my @entries = ();
205                 while($part3 =~ s/^\s*([\(\[]\s*(\w+)(?:\s*\.\s*([^\s\)\]]*)\s*)?[\)\]])//) {
206                     push @entries, [$1, $2, $3];
207                 }
208
209                 my $found = 0;
210                 foreach my $external_name2 (@external_names) {
211                     if($external_name eq $external_name2) {
212                         foreach my $entry (@entries) {
213                             (undef, my $module, undef) = @$entry;
214                             $found_external_names{$external_name2}{$module} = 1;
215                         }
216                         $found = 1;
217                         last;
218                         }
219                 }
220
221                 my $replaced = 0;
222                 my $replace2 = "";
223                 foreach my $entry (@entries) {
224                     my $part12 = $part1;
225                     (my $part32, my $module, my $ordinal) = @$entry;
226
227                     foreach my $entry2 (@module_ordinal_entries) {
228                         (my $external_name2, my $module2, my $ordinal2) = @$entry2;
229
230                         if($options->documentation_name && lc($module) eq $module2 &&
231                            $external_name ne $external_name2)
232                         {
233                             if(!$found && $part12 =~ s/\b\Q$external_name\E\b/$external_name2/) {
234                                 $external_name = $external_name2;
235                                 $replaced++;
236                             }
237                         }
238
239                         if($options->documentation_ordinal &&
240                            $external_name eq $external_name2 &&
241                            lc($module) eq $module2 &&
242                            ($#entries > 0 || !defined($ordinal) || ($ordinal ne $ordinal2)))
243                         {
244                             if(defined($ordinal)) {
245                                 if($part32 =~ s/\Q$module\E\s*.\s*\Q$ordinal\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
246                                     $replaced++;
247                                 }
248                             } else {
249                                 if($part32 =~ s/\Q$module\E/\U$module2\E.$ordinal2/ || $#entries > 0) {
250                                     $replaced++;
251                                 }
252                             }
253                         }
254                     }
255                     if($replace2) { $replace2 .= "\n"; }
256                     $replace2 .= "$part12$part32$part4";
257                 }
258
259                 if($replaced > 0) {
260                     $line3 = $line2;
261                     $search = "^\Q$_\E\$";
262                     $replace = $replace2;
263                 }
264                 $count++;
265             } elsif(/^(\s*\*\s*)([^\s\(]+)(?:\(\))?\s*$/) {
266                 my $part1 = $1;
267                 my $external_name = $2;
268
269                 if($internal_name =~ /^(?:\S+_)?\Q$external_name\E(?:16)?$/) {
270                     foreach my $entry (@module_ordinal_entries) {
271                         (my $external_name2, my $module, my $ordinal) = @$entry;
272
273                         $line3 = $line2;
274                         $search = "^\Q$_\E\$";
275                         $replace = "$part1$external_name2 (\U$module\E.$ordinal)";
276                     }
277                     $count++;
278                 }
279             }
280         }
281
282         if(defined($line3) && defined($search) && defined($replace)) {
283             if($count > 1 || $#external_names >= 1) {
284                 $output->write("multiple entries (fixup not supported)\n");
285                 # $output->write("s/$search/$replace/\n");
286                 # $output->write("@external_names\n");
287             } else {
288                 $documentation_modified = 1;
289                 $editor->substitute_line($line3, $search, $replace);
290             }
291         }
292     }
293
294     if(!$spec_modified && !$documentation_modified &&
295        $options->documentation_missing && defined($documentation))
296     {
297         my $part1;
298         my $part2;
299         my $part3;
300         my $part4;
301         my $line3 = 0;
302
303         my $line2 = $documentation_line - 1;
304         foreach (split(/\n/, $documentation)) {
305             $line2++;
306             if(/^(\s*\*\s*)(\S+\s*)([\(\[])\s*\w+\s*\.\s*[^\s\)\]]*\s*([\)\]]).*?$/) {
307                 $part1 = $1;
308                 $part2 = $2;
309                 $part3 = $3;
310                 $part4 = $4;
311
312                 $part2 =~ s/\S/ /g;
313
314                 $line3 = $line2 + 1;
315             }
316         }
317
318         foreach my $entry2 (@module_ordinal_entries) {
319             (my $external_name2, my $module2, my $ordinal2) = @$entry2;
320
321             my $found = 0;
322             foreach my $external_name (keys(%found_external_names)) {
323                 foreach my $module3 (keys(%{$found_external_names{$external_name}})) {
324                     if($external_name eq $external_name2 && uc($module2) eq $module3) {
325                         $found = 1;
326                     }
327                 }
328             }
329             # FIXME: Not 100% correct
330             if(!$found &&
331                !$win16api->is_function_stub_in_module($module2, $internal_name) &&
332                !$win32api->is_function_stub_in_module($module2, $internal_name))
333             {
334                 if($line3 > 0) {
335                     $documentation_modified = 1;
336                     $part2 = $external_name2 . " " x (length($part2) - length($external_name2));
337                     $editor->insert_line($line3, "$part1$part2$part3\U$module2\E.$ordinal2$part4\n");
338                 } else {
339                     $output->write("$external_name2 (\U$module2\E.$ordinal2) missing (fixup not supported)\n");
340                 }
341             }
342         }
343     }
344
345     if(!$documentation_modified &&
346        defined($documentation) &&
347        $options->documentation_wrong)
348     {
349         my $line2 = $documentation_line - 1;
350         foreach (split(/\n/, $documentation)) {
351             $line2++;
352             if(/^\s*\*\s*(\S+)\s*[\(\[]\s*(\w+)\s*\.\s*([^\s\)\]]*)\s*[\)\]].*?$/) {
353                 my $external_name = $1;
354                 my $module = $2;
355                 my $ordinal = $3;
356
357                 my $found = 0;
358                 foreach my $entry2 (@module_ordinal_entries) {
359                     (my $external_name2, my $module2, my $ordinal2) = @$entry2;
360
361                     if($external_name eq $external_name2 &&
362                        lc($module) eq $module2 &&
363                        $ordinal eq $ordinal2)
364                     {
365                         $found = 1;
366                     }
367                 }
368                 if(!$found) {
369                     if(1) {
370                         $documentation_modified = 1;
371
372                         $editor->delete_line($line2, "^\Q$_\E\$");
373                     } else {
374                         $output->write("$external_name (\U$module\E.$ordinal) wrong (fixup not supported)\n");
375                     };
376                 }
377             }
378         }
379     }
380
381     if(!$spec_modified && !$documentation_modified && !defined($documentation))
382     {
383         my $insert = "";
384         foreach my $winapi (@winapis) {
385             my $external_name = $winapi->function_external_name($internal_name);
386             my $module = $winapi->function_internal_module($internal_name);
387             my $ordinal = $winapi->function_internal_ordinal($internal_name);
388
389             if(defined($external_name) && defined($module) && defined($ordinal)) {
390                 $insert .= " *\t\t$external_name (\U$module\E.$ordinal)\n";
391             }
392         }
393         if($insert) {
394             $editor->insert_line($function_line,
395                                  "/" . "*" x 71 . "\n" .
396                                  "$insert" .
397                                  " */\n");
398         }
399     }
400 }
401
402 1;