wine.inf: Register actxprxy.dll and create a fake DLL for it.
[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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 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($msg =~ /^WM_COMMAND$/) {
118         (my $id, my $code_notify) = _parse_makelong($wparam);
119         my $hwndctl = $lparam;
120         @arguments = ($id, $hwndctl, $code_notify);
121     } elsif($msg =~ /^WM_(?:COPY|CUT|PASTE)$/) {
122         @arguments = ();
123     } elsif($msg =~ /^WM_(?:CHARTO|VKEYTO)ITEM$/) {
124         (my $key, my $caret) = _parse_makelong($wparam);
125         my $hwndctl = $lparam;
126         @arguments = ($key, $hwndctl, $caret);
127     } elsif($msg =~ /^WM_(?:COMPARE|DELETE|DRAW|MEASURE)ITEM$/) {
128         @arguments = ($lparam);
129     } elsif($msg =~ s/^WM_GETTEXT$/$&$suffix/) {
130         @arguments = ($wparam, $lparam);
131     } elsif($msg =~ /^WM_INITMENU$/) {
132         my $hmenu = $wparam;
133         @arguments =  ($hmenu);
134     } elsif($msg =~ /^WM_INITMENUPOPUP$/) {
135         my $hmenu = $wparam;
136         (my $item, my $system_menu) = _parse_makelong($lparam);
137         @arguments =  ($hmenu, $item, $system_menu);
138     } elsif($msg =~ /^WM_MENUCHAR$/) {
139         (my $ch, my $flags) = _parse_makelong($wparam);
140         my $hmenu = $lparam;
141         @arguments = ($ch, $flags, $hmenu);
142     } elsif($msg =~ /^WM_MENUSELECT$/) {
143         (my $item, my $flags) = _parse_makelong($wparam);
144         my $hmenu = $lparam;
145         my $hmenu_popup = "NULL"; # FIXME: Is this really correct?
146         @arguments = ($hmenu, $item, $hmenu_popup, $flags);
147     } elsif($msg =~ s/^WM_(NC)?LBUTTONDBLCLK$/WM_$1LBUTTONDOWN/) {
148         my $double_click = "TRUE";
149         my $key_flags = $wparam;
150         (my $x, my $y) = _parse_makelong($lparam);
151         @arguments = ($double_click, $x, $y, $key_flags);
152     } elsif($msg =~ /^WM_(NC)?LBUTTONDOWN$/) {
153         my $double_click = "FALSE";
154         my $key_flags = $wparam;
155         (my $x, my $y) = _parse_makelong($lparam);
156         @arguments = ($double_click, $x, $y, $key_flags);
157     } elsif($msg =~ /^WM_LBUTTONUP$/) {
158         my $key_flags = $wparam;
159         (my $x, my $y) = _parse_makelong($lparam);
160         @arguments = ($x, $y, $key_flags);
161     } elsif($msg =~ /^WM_SETCURSOR$/) {
162         my $hwnd_cursor = $wparam;
163         (my $code_hit_test, my $msg2) = _parse_makelong($lparam);
164         @arguments = ($hwnd_cursor, $code_hit_test, $msg2);
165     } elsif($msg =~ s/^WM_SETTEXT$/$&$suffix/) {
166         my $text = $lparam;
167         @arguments = ($text);
168     } elsif($msg =~ /^WM_(?:SYS)?KEYDOWN$/) {
169         my $vk = $wparam;
170         (my $repeat, my $flags) = _parse_makelong($lparam);
171         @arguments = ($vk, $repeat, $flags);
172     } else {
173         @arguments = ($wparam, $lparam);
174     }
175     unshift @arguments, $hwnd;
176
177     return "FORWARD_" . $msg . "(" . join(", ", @arguments) . ", $name)";
178 }
179
180 ########################################################################
181 # _get_messages
182
183 sub _get_messages($) {
184     local $_ = shift;
185
186     if(/^(?:BM|CB|EM|LB|STM|WM)_\w+(.*?)$/) {
187         if(!$1) {
188             return ($_);
189         } else {
190             return ();
191         }
192     } elsif(/^(.*?)\s*\?\s*((?:BM|CB|EM|LB|STM|WM)_\w+)\s*:\s*((?:BM|CB|EM|LB|STM|WM)_\w+)$/) {
193         return ($2, $3);
194     } elsif(/^\w+$/) {
195         return ();
196     } elsif(/^RegisterWindowMessage[AW]\s*\(.*?\)$/) {
197         return ();
198     } else {
199         $output->write("warning: _get_messages: '$_'\n");
200         return ();
201     }
202 }
203
204 ########################################################################
205 # _fixup_user_message
206
207 sub _fixup_user_message($$) {
208     my $name = shift;
209     (my $hwnd, my $msg, my $wparam, my $lparam) = @{(shift)};
210
211     my $modified = 0;
212
213     my $wkind;
214     my $lkind;
215     foreach my $msg (_get_messages($msg)) {
216         my $new_wkind = get_message_wparam_kind($msg);
217         if(defined($wkind) && $new_wkind ne $wkind) {
218             $output->write("messsages used together do not have the same type\n");
219         } else {
220             $wkind = $new_wkind;
221         }
222
223         my $new_lkind = get_message_lparam_kind($msg);
224         if(defined($lkind) && $new_lkind ne $lkind) {
225             $output->write("messsages used together do not have the same type\n");
226         } else {
227             $lkind = $new_lkind;
228         }
229     }
230
231     my @entries = (
232         [ \$wparam, $wkind, "W", "w" ],
233         [ \$lparam, $lkind, "L", "l" ]
234     );
235     foreach my $entry (@entries) {
236         (my $refparam, my $kind, my $upper, my $lower) = @$entry;
237
238         if(!defined($kind)) {
239             if($msg =~ /^WM_/) {
240                 $output->write("messsage $msg not properly defined\n");
241                 $modified = 0;
242                 last;
243             }
244         } elsif($kind eq "ptr") {
245             if($$refparam =~ /^(\(${upper}PARAM\))?\s*($lower[pP]aram)$/) {
246                 if(defined($1)) {
247                     $$refparam = $2;
248                     $modified = 1;
249                 }
250             } elsif($$refparam =~ /^(\(${upper}PARAM\))?\s*0$/) {
251                 $$refparam = "(${upper}PARAM) NULL";
252                 $modified = 1;
253             } elsif($$refparam !~ /^\(${upper}PARAM\)\s*/) {
254                 $$refparam = "(${upper}PARAM) $$refparam";
255                 $modified = 1;
256             }
257         } elsif($kind eq "long") {
258             if($$refparam =~ s/^\(${upper}PARAM\)\s*//) {
259                 $modified = 1;
260             }
261         }
262     }
263
264     if($modified) {
265         my @arguments = ($hwnd, $msg, $wparam, $lparam);
266         return "$name(" . join(", ", @arguments) . ")";
267     } else {
268         return undef;
269     }
270 }
271
272 ########################################################################
273 # fixup_statements
274
275 sub fixup_statements($$) {
276     my $function = shift;
277     my $editor = shift;
278
279     my $file = $function->file;
280     my $linkage = $function->linkage;
281     my $name = $function->name;
282     my $statements_line = $function->statements_line;
283     my $statements_column = $function->statements_column;
284     my $statements = $function->statements;
285
286     if(!defined($statements)) {
287         return;
288     }
289
290     my $parser = new c_parser($file);
291
292     my $found_function_call = sub {
293         my $begin_line = shift;
294         my $begin_column = shift;
295         my $end_line = shift;
296         my $end_column = shift;
297         my $name = shift;
298         my $arguments = shift;
299
300         foreach my $argument (@$arguments) {
301             $argument =~ s/^\s*(.*?)\s*$/$1/;
302         }
303
304         my $fixup_function_call;
305         if($name =~ /^(?:DefWindowProc|SendMessage)[AW]$/)
306         {
307             if($options->statements_windowsx) {
308                 $fixup_function_call = \&fixup_user_message_2_windowsx;
309             } else {
310                 $fixup_function_call = \&_fixup_user_message;
311             }
312         }
313
314         if(defined($fixup_function_call)) {
315             my $replace = &$fixup_function_call($name, $arguments);
316
317             if(defined($replace)) {
318                 $editor->replace($begin_line, $begin_column, $end_line, $end_column, $replace);
319             }
320         } elsif($options->debug) {
321             $output->write("$begin_line.$begin_column-$end_line.$end_column: " .
322                            "$name(" . join(", ", @$arguments) . ")\n");
323         }
324
325         return 0;
326     };
327
328     $parser->set_found_function_call_callback($found_function_call);
329
330     my $line = $statements_line;
331     my $column = 0;
332     if(!$parser->parse_c_statements(\$statements, \$line, \$column)) {
333         $output->write("error: can't parse statements\n");
334     }
335 }
336
337 1;