Update win32.api to match the current sources.
[wine] / tools / winapi / winapi_fixup_statements.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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
17 #
18
19 package winapi_fixup_statements;
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_statements);
29
30 use config qw($wine_dir);
31 use options qw($options);
32 use output qw($output);
33
34 use c_parser;
35 use winapi_module_user qw(
36     get_message_result_kind
37     get_message_wparam_kind
38     get_message_lparam_kind
39 );
40
41 ########################################################################
42 # fixup_function_call
43
44 sub fixup_function_call($$) {
45     my $name = shift;
46     my @arguments = @{(shift)};;
47
48     return "$name(" . join(", ", @arguments) . ")";
49 }
50
51 ########################################################################
52 # _parse_makelong
53
54 sub _parse_makelong($) {
55     local $_ = shift;
56
57     my $low;
58     my $high;
59
60     my $name;
61     my @arguments;
62     my @argument_lines;
63     my @argument_columns;
64
65     my $parser = new c_parser;
66
67     my $line = 1;
68     my $column = 0;
69     if($parser->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns) &&
70        $name =~ /^MAKE(?:LONG|LPARAM|LRESULT|WPARAM)$/)
71     {
72         $low = $arguments[0];
73         $high = $arguments[1];
74     } elsif(/^(?:\(\w+\)\s*)?0L?$/) {
75         $low = "0";
76         $high = "0";
77     } else {
78         $low = "($_) & 0xffff";
79         $high = "($_) << 16";
80     }
81
82     $low =~ s/^\s*(.*?)\s*$/$1/;
83     $high =~ s/^\s*(.*?)\s*$/$1/;
84
85     return ($low, $high);
86 }
87
88 ########################################################################
89 # fixup_function_call_2_windowsx
90
91 sub fixup_user_message_2_windowsx($$) {
92     my $name = shift;
93     (my $hwnd, my $msg, my $wparam, my $lparam) = @{(shift)};
94
95     if($msg !~ /^WM_/) {
96         return undef;
97     } elsif($msg =~ /^(?:WM_BEGINDRAG|WM_ENTERMENULOOP|WM_EXITMENULOOP|WM_HELP|
98                        WM_ISACTIVEICON|WM_LBTRACKPOINT|WM_NEXTMENU)$/x)
99     {
100         return undef;
101     } elsif($msg =~ /^WM_(?:GET|SET)TEXT$/) {
102         return undef;
103     }
104
105     my $suffix;
106     $name =~ /([AW])?$/;
107     if(defined($1)) {
108         $suffix = $1;
109     } else {
110         $suffix = "";
111     }
112
113     $wparam =~ s/^\(WPARAM\)\s*//;
114     $lparam =~ s/^\(LPARAM\)\s*//;
115
116     my @arguments;
117     if(0) {
118         # Nothing
119     } elsif($msg =~ /^WM_COMMAND$/) {
120         (my $id, my $code_notify) = _parse_makelong($wparam);
121         my $hwndctl = $lparam;
122         @arguments = ($id, $hwndctl, $code_notify);
123     } elsif($msg =~ /^WM_(?:COPY|CUT|PASTE)$/) {
124         @arguments = ();
125     } elsif($msg =~ /^WM_(?:CHARTO|VKEYTO)ITEM$/) {
126         (my $key, my $caret) = _parse_makelong($wparam);
127         my $hwndctl = $lparam;
128         @arguments = ($key, $hwndctl, $caret);
129     } elsif($msg =~ /^WM_(?:COMPARE|DELETE|DRAW|MEASURE)ITEM$/) {
130         @arguments = ($lparam);
131     } elsif($msg =~ s/^WM_GETTEXT$/$&$suffix/) {
132         @arguments = ($wparam, $lparam);
133     } elsif($msg =~ /^WM_INITMENU$/) {
134         my $hmenu = $wparam;
135         @arguments =  ($hmenu);
136     } elsif($msg =~ /^WM_INITMENUPOPUP$/) {
137         my $hmenu = $wparam;
138         (my $item, my $system_menu) = _parse_makelong($lparam);
139         @arguments =  ($hmenu, $item, $system_menu);
140     } elsif($msg =~ /^WM_MENUCHAR$/) {
141         (my $ch, my $flags) = _parse_makelong($wparam);
142         my $hmenu = $lparam;
143         @arguments = ($ch, $flags, $hmenu);
144     } elsif($msg =~ /^WM_MENUSELECT$/) {
145         (my $item, my $flags) = _parse_makelong($wparam);
146         my $hmenu = $lparam;
147         my $hmenu_popup = "NULL"; # FIXME: Is this really correct?
148         @arguments = ($hmenu, $item, $hmenu_popup, $flags);
149     } elsif($msg =~ s/^WM_(NC)?LBUTTONDBLCLK$/WM_$1LBUTTONDOWN/) {
150         my $double_click = "TRUE";
151         my $key_flags = $wparam;
152         (my $x, my $y) = _parse_makelong($lparam);
153         @arguments = ($double_click, $x, $y, $key_flags);
154     } elsif($msg =~ /^WM_(NC)?LBUTTONDOWN$/) {
155         my $double_click = "FALSE";
156         my $key_flags = $wparam;
157         (my $x, my $y) = _parse_makelong($lparam);
158         @arguments = ($double_click, $x, $y, $key_flags);
159     } elsif($msg =~ /^WM_LBUTTONUP$/) {
160         my $key_flags = $wparam;
161         (my $x, my $y) = _parse_makelong($lparam);
162         @arguments = ($x, $y, $key_flags);
163     } elsif($msg =~ /^WM_SETCURSOR$/) {
164         my $hwnd_cursor = $wparam;
165         (my $code_hit_test, my $msg2) = _parse_makelong($lparam);
166         @arguments = ($hwnd_cursor, $code_hit_test, $msg2);
167     } elsif($msg =~ s/^WM_SETTEXT$/$&$suffix/) {
168         my $text = $lparam;
169         @arguments = ($text);
170     } elsif($msg =~ /^WM_(?:SYS)?KEYDOWN$/) {
171         my $vk = $wparam;
172         (my $repeat, my $flags) = _parse_makelong($lparam);
173         @arguments = ($vk, $repeat, $flags);
174     } else {
175         @arguments = ($wparam, $lparam);
176     }
177     unshift @arguments, $hwnd;
178
179     return "FORWARD_" . $msg . "(" . join(", ", @arguments) . ", $name)";
180 }
181
182 ########################################################################
183 # _get_messages
184
185 sub _get_messages($) {
186     local $_ = shift;
187
188     if(/^(?:BM|CB|EM|LB|STM|WM)_\w+(.*?)$/) {
189         if(!$1) {
190             return ($_);
191         } else {
192             return ();
193         }
194     } elsif(/^(.*?)\s*\?\s*((?:BM|CB|EM|LB|STM|WM)_\w+)\s*:\s*((?:BM|CB|EM|LB|STM|WM)_\w+)$/) {
195         return ($2, $3);
196     } elsif(/^\w+$/) {
197         return ();
198     } elsif(/^RegisterWindowMessage[AW]\s*\(.*?\)$/) {
199         return ();
200     } else {
201         $output->write("warning: _get_messages: '$_'\n");
202         return ();
203     }
204 }
205
206 ########################################################################
207 # _fixup_user_message
208
209 sub _fixup_user_message($$) {
210     my $name = shift;
211     (my $hwnd, my $msg, my $wparam, my $lparam) = @{(shift)};
212
213     my $modified = 0;
214
215     my $wkind;
216     my $lkind;
217     foreach my $msg (_get_messages($msg)) {
218         my $new_wkind = get_message_wparam_kind($msg);
219         if(defined($wkind) && $new_wkind ne $wkind) {
220             $output->write("messsages used together do not have the same type\n");
221         } else {
222             $wkind = $new_wkind;
223         }
224
225         my $new_lkind = get_message_lparam_kind($msg);
226         if(defined($lkind) && $new_lkind ne $lkind) {
227             $output->write("messsages used together do not have the same type\n");
228         } else {
229             $lkind = $new_lkind;
230         }
231     }
232
233     my @entries = (
234         [ \$wparam, $wkind, "W", "w" ],
235         [ \$lparam, $lkind, "L", "l" ]
236     );
237     foreach my $entry (@entries) {
238         (my $refparam, my $kind, my $upper, my $lower) = @$entry;
239
240         if(!defined($kind)) {
241             if($msg =~ /^WM_/) {
242                 $output->write("messsage $msg not properly defined\n");
243                 $modified = 0;
244                 last;
245             }
246         } elsif($kind eq "ptr") {
247             if($$refparam =~ /^(\(${upper}PARAM\))?\s*($lower[pP]aram)$/) {
248                 if(defined($1)) {
249                     $$refparam = $2;
250                     $modified = 1;
251                 }
252             } elsif($$refparam =~ /^(\(${upper}PARAM\))?\s*0$/) {
253                 $$refparam = "(${upper}PARAM) NULL";
254                 $modified = 1;
255             } elsif($$refparam !~ /^\(${upper}PARAM\)\s*/) {
256                 $$refparam = "(${upper}PARAM) $$refparam";
257                 $modified = 1;
258             }
259         } elsif($kind eq "long") {
260             if($$refparam =~ s/^\(${upper}PARAM\)\s*//) {
261                 $modified = 1;
262             }
263         }
264     }
265
266     if($modified) {
267         my @arguments = ($hwnd, $msg, $wparam, $lparam);
268         return "$name(" . join(", ", @arguments) . ")";
269     } else {
270         return undef;
271     }
272 }
273
274 ########################################################################
275 # fixup_statements
276
277 sub fixup_statements($$) {
278     my $function = shift;
279     my $editor = shift;
280
281     my $file = $function->file;
282     my $linkage = $function->linkage;
283     my $name = $function->name;
284     my $statements_line = $function->statements_line;
285     my $statements_column = $function->statements_column;
286     my $statements = $function->statements;
287
288     if(!defined($statements)) {
289         return;
290     }
291
292     my $parser = new c_parser($file);
293
294     my $found_function_call = sub {
295         my $begin_line = shift;
296         my $begin_column = shift;
297         my $end_line = shift;
298         my $end_column = shift;
299         my $name = shift;
300         my $arguments = shift;
301
302         foreach my $argument (@$arguments) {
303             $argument =~ s/^\s*(.*?)\s*$/$1/;
304         }
305
306         my $fixup_function_call;
307         if($name =~ /^(?:DefWindowProc|SendMessage)[AW]$/)
308         {
309             if($options->statements_windowsx) {
310                 $fixup_function_call = \&fixup_user_message_2_windowsx;
311             } else {
312                 $fixup_function_call = \&_fixup_user_message;
313             }
314         }
315
316         if(defined($fixup_function_call)) {
317             my $replace = &$fixup_function_call($name, $arguments);
318
319             if(defined($replace)) {
320                 $editor->replace($begin_line, $begin_column, $end_line, $end_column, $replace);
321             }
322         } elsif($options->debug) {
323             $output->write("$begin_line.$begin_column-$end_line.$end_column: " .
324                            "$name(" . join(", ", @$arguments) . ")\n");
325         }
326
327         return 0;
328     };
329
330     $parser->set_found_function_call_callback($found_function_call);
331
332     my $line = $statements_line;
333     my $column = 0;
334     if(!$parser->parse_c_statements(\$statements, \$line, \$column)) {
335         $output->write("error: can't parse statements\n");
336     }
337 }
338
339 1;