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;