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;