Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
W
wine-winehq
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Registry
Registry
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
wine
wine-winehq
Commits
a5924303
Commit
a5924303
authored
May 26, 2009
by
Francois Gouget
Committed by
Alexandre Julliard
May 26, 2009
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
winapi_fixup: There is not much point for this tool so remove it.
parent
1ccfab17
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
0 additions
and
1044 deletions
+0
-1044
winapi_fixup
tools/winapi/winapi_fixup
+0
-232
winapi_fixup_documentation.pm
tools/winapi/winapi_fixup_documentation.pm
+0
-0
winapi_fixup_editor.pm
tools/winapi/winapi_fixup_editor.pm
+0
-407
winapi_fixup_options.pm
tools/winapi/winapi_fixup_options.pm
+0
-68
winapi_fixup_statements.pm
tools/winapi/winapi_fixup_statements.pm
+0
-337
No files found.
tools/winapi/winapi_fixup
deleted
100755 → 0
View file @
1ccfab17
#!/usr/bin/perl -w
# Copyright 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
#
use
strict
;
BEGIN
{
$0
=~
m%^(.*?/?tools)/winapi/winapi_fixup$%
;
require
"$1/winapi/setup.pm"
;
}
use
config
qw(
files_filter files_skip
$current_dir $wine_dir $winapi_dir
)
;
use
output
qw($output)
;
use
winapi_fixup_options
qw($options)
;
if
(
$options
->
progress
)
{
$output
->
enable_progress
;
}
else
{
$output
->
disable_progress
;
}
use
winapi_c_parser
;
use
c_parser
;
use
type
;
use
winapi_fixup_documentation
qw(fixup_documentation)
;
use
winapi_fixup_editor
;
use
winapi_fixup_statements
qw(fixup_statements)
;
my
@c_files
=
$options
->
c_files
;
@c_files
=
files_skip
(
@c_files
);
@c_files
=
files_filter
(
"winelib"
,
@c_files
);
my
$progress_output
;
my
$progress_current
=
0
;
my
$progress_max
=
scalar
(
@c_files
);
foreach
my
$file
(
@c_files
)
{
my
$editor
=
new
winapi_fixup_editor
(
$file
);
$progress_current
++
;
$output
->
progress
(
"$file (file $progress_current of $progress_max)"
);
$output
->
prefix
(
"$file:"
);
{
open
(
IN
,
"< $file"
)
||
die
"Error: Can't open $file: $!\n"
;
local
$/
=
undef
;
$_
=
<
IN
>
;
close
(
IN
);
}
my
$max_line
=
0
;
{
local
$_
=
$_
;
while
(
s/^.*?\n//
)
{
$max_line
++
;
}
if
(
$_
)
{
$max_line
++
;
}
}
my
$parser
;
if
(
1
)
{
$parser
=
new
c_parser
(
$file
);
}
else
{
$parser
=
new
winapi_c_parser
(
$file
);
}
my
$function
;
my
$line
;
my
$update_output
=
sub
{
my
$progress
=
""
;
my
$prefix
=
""
;
$progress
.=
"$file (file $progress_current of $progress_max)"
;
$prefix
.=
"$file:"
;
if
(
defined
(
$function
))
{
my
$name
=
$function
->
name
;
my
$begin_line
=
$function
->
begin_line
;
my
$begin_column
=
$function
->
begin_column
;
$progress
.=
": function $name"
;
$prefix
.=
"$begin_line.$begin_column: function $name: "
;
}
if
(
defined
(
$line
))
{
$progress
.=
": line $line of $max_line"
;
}
$output
->
progress
(
$progress
);
$output
->
prefix
(
$prefix
);
};
my
$found_preprocessor
=
sub
{
my
$begin_line
=
shift
;
my
$begin_column
=
shift
;
my
$preprocessor
=
shift
;
# $output->write("$begin_line.$begin_column: preprocessor: $preprocessor\n");
return
1
;
};
$parser
->
set_found_preprocessor_callback
(
$found_preprocessor
);
my
$found_comment
=
sub
{
my
$begin_line
=
shift
;
my
$begin_column
=
shift
;
my
$comment
=
shift
;
# $output->write("$begin_line.$begin_column: comment: $comment\n");
return
1
;
};
$parser
->
set_found_comment_callback
(
$found_comment
);
my
$found_line
=
sub
{
$line
=
shift
;
# local $_ = shift;
&
$update_output
;
# $output->progress("$file: line $line of ?");
};
$parser
->
set_found_line_callback
(
$found_line
);
my
$found_declaration
=
sub
{
my
$begin_line
=
shift
;
my
$begin_column
=
shift
;
my
$end_line
=
shift
;
my
$end_column
=
shift
;
my
$declaration
=
shift
;
# $output->write("$begin_line.$begin_column-$end_line.$end_column: declaration: \\\n$declaration\n");
return
1
;
};
$parser
->
set_found_declaration_callback
(
$found_declaration
);
my
$found_function
=
sub
{
$function
=
shift
;
&
$update_output
;
my
$name
=
$function
->
name
;
my
$begin_line
=
$function
->
begin_line
;
my
$begin_column
=
$function
->
begin_column
;
my
$end_line
=
$function
->
end_line
;
my
$end_column
=
$function
->
end_column
;
if
(
$options
->
documentation
)
{
# fixup_documentation($function, $editor);
}
if
(
$options
->
statements
)
{
fixup_statements
(
$function
,
$editor
);
}
my
$statements
=
$function
->
statements
;
if
(
!
defined
(
$statements
))
{
$function
=
undef
;
$output
->
prefix
(
"$file: "
);
}
else
{
# $output->write("$begin_line.$begin_column-$end_line.$end_column: function $name\n");
}
return
0
;
};
$parser
->
set_found_function_callback
(
$found_function
);
my
$found_variable
=
sub
{
my
$begin_line
=
shift
;
my
$begin_column
=
shift
;
my
$linkage
=
shift
;
my
$type
=
shift
;
my
$name
=
shift
;
# $output->write("$begin_line.$begin_column: $linkage $type $name = /* ... */\n");
return
1
;
};
$parser
->
set_found_variable_callback
(
$found_variable
);
my
$found_function_call
=
sub
{
my
$begin_line
=
shift
;
my
$begin_column
=
shift
;
my
$end_line
=
shift
;
my
$end_column
=
shift
;
my
$name
=
shift
;
my
$arguments
=
shift
;
$output
->
write
(
"$begin_line.$begin_column-$end_line.$end_column: $name("
.
join
(
", "
,
@$arguments
)
.
")\n"
);
return
1
;
};
$parser
->
set_found_function_call_callback
(
$found_function_call
);
{
my
$line
=
1
;
my
$column
=
0
;
if
(
!
$parser
->
parse_c_file
(
\
$_
,
\
$line
,
\
$column
))
{
$output
->
write
(
"can't parse file\n"
);
}
}
$output
->
prefix
(
""
);
$editor
->
flush
;
}
tools/winapi/winapi_fixup_documentation.pm
deleted
100644 → 0
View file @
1ccfab17
This diff is collapsed.
Click to expand it.
tools/winapi/winapi_fixup_editor.pm
deleted
100644 → 0
View file @
1ccfab17
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
#
package
winapi_fixup_editor
;
use
strict
;
use
options
qw($options)
;
use
output
qw($output)
;
use
winapi
qw($win16api $win32api @winapis)
;
use
util
;
sub
new
($$)
{
my
$proto
=
shift
;
my
$class
=
ref
(
$proto
)
||
$proto
;
my
$self
=
{};
bless
(
$self
,
$class
);
my
$file
=
\
$
{
$self
->
{
FILE
}};
$$file
=
shift
;
return
$self
;
}
sub
add_trigger
($$$)
{
my
$self
=
shift
;
my
$triggers
=
\%
{
$self
->
{
TRIGGERS
}};
my
$line
=
shift
;
my
$action
=
shift
;
if
(
!
defined
(
$$triggers
{
$line
}))
{
$$triggers
{
$line
}
=
[]
;
}
push
@
{
$$triggers
{
$line
}},
$action
;
}
sub
replace
($$$$$$)
{
my
$self
=
shift
;
my
$begin_line
=
shift
;
my
$begin_column
=
shift
;
my
$end_line
=
shift
;
my
$end_column
=
shift
;
my
$replace
=
shift
;
my
$file
=
\
$
{
$self
->
{
FILE
}};
my
$line
=
$begin_line
;
my
$action
=
{};
$self
->
add_trigger
(
$begin_line
,
{
type
=>
"replace"
,
begin_line
=>
$begin_line
,
begin_column
=>
$begin_column
,
end_line
=>
$end_line
,
end_column
=>
$end_column
,
replace
=>
$replace
});
}
sub
flush
($)
{
my
$self
=
shift
;
my
$file
=
\
$
{
$self
->
{
FILE
}};
my
$triggers
=
\%
{
$self
->
{
TRIGGERS
}};
my
$editor
=
sub
{
local
*
IN
=
shift
;
local
*
OUT
=
shift
;
my
$modified
=
0
;
my
$again
=
0
;
my
$lookahead
=
0
;
my
$lookahead_count
=
0
;
LINE:
while
(
$again
||
defined
(
my
$current
=
<
IN
>
))
{
if
(
!
$again
)
{
chomp
$current
;
if
(
$lookahead
)
{
$lookahead
=
0
;
$_
.=
"\n"
.
$current
;
$lookahead_count
++
;
}
else
{
$_
=
$current
;
$lookahead_count
=
0
;
}
}
else
{
$lookahead_count
=
0
;
$again
=
0
;
}
my
$line
=
$.
-
$lookahead_count
;
foreach
my
$action
(
@
{
$$triggers
{
$line
}})
{
if
(
$.
<
$action
->
{
end_line
})
{
$lookahead
=
1
;
next
LINE
;
}
my
$type
=
$action
->
{
type
};
my
$begin_line
=
$action
->
{
begin_line
};
my
$begin_column
=
$action
->
{
begin_column
};
my
$end_line
=
$action
->
{
end_line
};
my
$end_column
=
$action
->
{
end_column
};
if
(
$type
eq
"replace"
)
{
my
$replace
=
$action
->
{
replace
};
my
@lines
=
split
(
/\n/
,
$_
);
if
(
$#lines
<
0
)
{
@lines
=
(
$_
);
}
my
$begin
=
""
;
my
$column
=
0
;
$_
=
$lines
[
0
];
while
(
$column
<
$begin_column
-
1
&&
s/^.//
)
{
$begin
.=
$&
;
if
(
$&
eq
"\t"
)
{
$column
=
$column
+
8
-
$column
%
8
;
}
else
{
$column
++
;
}
}
my
$column2
=
0
;
$_
=
$lines
[
$#lines
];
while
(
$column2
<
$end_column
&&
s/^.//
)
{
if
(
$&
eq
"\t"
)
{
$column2
=
$column2
+
8
-
$column2
%
8
;
}
else
{
$column2
++
;
}
}
my
$end
=
$_
;
$_
=
"$begin$replace$end"
;
if
(
$options
->
modify
)
{
$modified
=
1
;
}
else
{
$output
->
write
(
"$$file:$begin_line.$begin_column-$end_line.$end_column: $replace\n"
);
}
}
}
print
OUT
"$_\n"
;
}
return
$modified
;
};
my
$modified
=
0
;
if
(
1
)
{
$modified
=
edit_file
(
$$file
,
$editor
);
}
if
(
!
$modified
)
{
$self
->
flush_old
;
}
}
########################################################################
# Hack for backward compabillity
#
my
%
insert_line
;
my
%
substitute_line
;
my
%
delete_line
;
my
%
spec_file
;
sub
flush_old
($)
{
my
$self
=
shift
;
my
$file
=
$
{
$self
->
{
FILE
}};
my
$editor
=
sub
{
local
*
IN
=
shift
;
local
*
OUT
=
shift
;
my
$modified
=
0
;
while
(
<
IN
>
)
{
chomp
;
my
$line
;
$line
=
$insert_line
{
$.
};
if
(
defined
(
$line
))
{
if
(
$options
->
modify
)
{
$_
=
"$line$_"
;
$modified
=
1
;
}
else
{
my
$line2
=
$line
;
chomp
(
$line2
);
my
@line2
=
split
(
/\n/
,
$line2
);
if
(
$#line2
>
0
)
{
$output
->
write
(
"$file: $.: insert: \\\n"
);
foreach
my
$line2
(
@line2
)
{
$output
->
write
(
"'$line2'\n"
);
}
}
else
{
$output
->
write
(
"$file: $.: insert: '$line2'\n"
);
}
}
}
my
$search
=
$substitute_line
{
$.
}{
search
};
my
$replace
=
$substitute_line
{
$.
}{
replace
};
if
(
defined
(
$search
)
&&
defined
(
$replace
))
{
my
$modified2
=
0
;
if
(
s/$search/$replace/
)
{
if
(
$options
->
modify
)
{
$modified
=
1
;
}
$modified2
=
1
;
}
if
(
!
$options
->
modify
||
!
$modified2
)
{
my
$search2
;
my
$replace2
;
if
(
!
$modified2
)
{
$search2
=
"unmatched search"
;
$replace2
=
"unmatched replace"
;
}
else
{
$search2
=
"search"
;
$replace2
=
"replace"
;
}
$output
->
write
(
"$file: $.: $search2 : '$search'\n"
);
my
@replace2
=
split
(
/\n/
,
$replace
);
if
(
$#replace2
>
0
)
{
$output
->
write
(
"$file: $.: $replace2: \\\n"
);
foreach
my
$replace2
(
@replace2
)
{
$output
->
write
(
"'$replace2'\n"
);
}
}
else
{
$output
->
write
(
"$file: $.: $replace2: '$replace'\n"
);
}
}
}
$line
=
$delete_line
{
$.
};
if
(
defined
(
$line
))
{
if
(
/$line/
)
{
if
(
$options
->
modify
)
{
$modified
=
1
;
next
;
}
else
{
$output
->
write
(
"$file: $.: delete: '$line'\n"
);
}
}
else
{
$output
->
write
(
"$file: $.: unmatched delete: '$line'\n"
);
}
}
print
OUT
"$_\n"
;
}
return
$modified
;
};
my
$n
=
0
;
while
(
defined
(
each
%
insert_line
))
{
$n
++
;
}
while
(
defined
(
each
%
substitute_line
))
{
$n
++
;
}
while
(
defined
(
each
%
delete_line
))
{
$n
++
;
}
if
(
$n
>
0
)
{
edit_file
(
$file
,
$editor
);
}
foreach
my
$module
(
sort
(
keys
(
%
spec_file
)))
{
my
$file
;
foreach
my
$winapi
(
@winapis
)
{
$file
=
(
$winapi
->
module_file
(
$module
)
||
$file
);
}
if
(
defined
(
$file
))
{
$file
=
file_normalize
(
$file
);
}
my
@substitutes
=
@
{
$spec_file
{
$module
}};
my
$editor
=
sub
{
local
*
IN
=
shift
;
local
*
OUT
=
shift
;
my
$modified
=
0
;
while
(
<
IN
>
)
{
chomp
;
my
@substitutes2
=
();
foreach
my
$substitute
(
@substitutes
)
{
my
$search
=
$substitute
->
{
search
};
my
$replace
=
$substitute
->
{
replace
};
if
(
s/$search/$replace/
)
{
if
(
$options
->
modify
)
{
$modified
=
1
;
}
else
{
$output
->
write
(
"$file: search : '$search'\n"
);
$output
->
write
(
"$file: replace: '$replace'\n"
);
}
next
;
}
else
{
push
@substitutes2
,
$substitute
;
}
}
@substitutes
=
@substitutes2
;
print
OUT
"$_\n"
;
}
return
$modified
;
};
if
(
defined
(
$file
))
{
edit_file
(
$file
,
$editor
);
}
else
{
$output
->
write
(
"$module: doesn't have any spec file\n"
);
}
if
(
$#substitutes
>=
0
)
{
foreach
my
$substitute
(
@substitutes
)
{
my
$search
=
$substitute
->
{
search
};
my
$replace
=
$substitute
->
{
replace
};
$output
->
write
(
"$file: unmatched search : '$search'\n"
);
$output
->
write
(
"$file: unmatched replace: '$replace'\n"
);
}
}
}
%
insert_line
=
();
%
substitute_line
=
();
%
delete_line
=
();
%
spec_file
=
();
}
sub
delete_line
($$$)
{
my
$self
=
shift
;
my
$line
=
shift
;
my
$pattern
=
shift
;
$delete_line
{
$line
}
=
$pattern
;
}
sub
insert_line
($$$)
{
my
$self
=
shift
;
my
$line
=
shift
;
my
$insert
=
shift
;
$insert_line
{
$line
}
=
$insert
;
}
sub
substitute_line
($$$$)
{
my
$self
=
shift
;
my
$line
=
shift
;
my
$search
=
shift
;
my
$replace
=
shift
;
$substitute_line
{
$line
}{
search
}
=
$search
;
$substitute_line
{
$line
}{
replace
}
=
$replace
;
}
sub
replace_spec_file
($$$$)
{
my
$self
=
shift
;
my
$module
=
shift
;
my
$search
=
shift
;
my
$replace
=
shift
;
my
$substitute
=
{};
$substitute
->
{
search
}
=
$search
;
$substitute
->
{
replace
}
=
$replace
;
if
(
!
defined
(
$spec_file
{
$module
}))
{
$spec_file
{
$module
}
=
[]
;
}
push
@
{
$spec_file
{
$module
}},
$substitute
;
}
1
;
tools/winapi/winapi_fixup_options.pm
deleted
100644 → 0
View file @
1ccfab17
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
#
package
winapi_fixup_options
;
use
base
qw(options)
;
use
strict
;
use
vars
qw($VERSION @ISA @EXPORT @EXPORT_OK)
;
require
Exporter
;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw()
;
@EXPORT_OK
=
qw($options)
;
use
options
qw($options)
;
my
%
options_long
=
(
"debug"
=>
{
default
=>
0
,
description
=>
"debug mode"
},
"help"
=>
{
default
=>
0
,
description
=>
"help mode"
},
"verbose"
=>
{
default
=>
0
,
description
=>
"verbose mode"
},
"progress"
=>
{
default
=>
1
,
description
=>
"show progress"
},
"win16"
=>
{
default
=>
1
,
description
=>
"Win16 fixup"
},
"win32"
=>
{
default
=>
1
,
description
=>
"Win32 fixup"
},
"local"
=>
{
default
=>
1
,
description
=>
"local fixup"
},
"documentation"
=>
{
default
=>
1
,
parent
=>
"local"
,
description
=>
"documentation fixup"
},
"documentation-missing"
=>
{
default
=>
1
,
parent
=>
"documentation"
,
description
=>
"documentation missing fixup"
},
"documentation-name"
=>
{
default
=>
1
,
parent
=>
"documentation"
,
description
=>
"documentation name fixup"
},
"documentation-ordinal"
=>
{
default
=>
1
,
parent
=>
"documentation"
,
description
=>
"documentation ordinal fixup"
},
"documentation-wrong"
=>
{
default
=>
1
,
parent
=>
"documentation"
,
description
=>
"documentation wrong fixup"
},
"statements"
=>
{
default
=>
1
,
parent
=>
"local"
,
description
=>
"statements fixup"
},
"statements-windowsx"
=>
{
default
=>
0
,
parent
=>
"local"
,
description
=>
"statements windowsx fixup"
},
"stub"
=>
{
default
=>
0
,
parent
=>
"local"
,
description
=>
"stub fixup"
},
"global"
=>
{
default
=>
1
,
description
=>
"global fixup"
},
"modify"
=>
{
default
=>
0
,
description
=>
"actually perform the fixups"
},
);
my
%
options_short
=
(
"d"
=>
"debug"
,
"?"
=>
"help"
,
"v"
=>
"verbose"
);
my
$options_usage
=
"usage: winapi_fixup [--help] [<files>]\n"
;
$options
=
'_options'
->
new
(
\%
options_long
,
\%
options_short
,
$options_usage
);
1
;
tools/winapi/winapi_fixup_statements.pm
deleted
100644 → 0
View file @
1ccfab17
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
#
package
winapi_fixup_statements
;
use
strict
;
use
vars
qw($VERSION @ISA @EXPORT @EXPORT_OK)
;
require
Exporter
;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw()
;
@EXPORT_OK
=
qw(fixup_statements)
;
use
config
qw($wine_dir)
;
use
options
qw($options)
;
use
output
qw($output)
;
use
c_parser
;
use
winapi_module_user
qw(
get_message_result_kind
get_message_wparam_kind
get_message_lparam_kind
)
;
########################################################################
# fixup_function_call
sub
fixup_function_call
($$)
{
my
$name
=
shift
;
my
@arguments
=
@
{(
shift
)};;
return
"$name("
.
join
(
", "
,
@arguments
)
.
")"
;
}
########################################################################
# _parse_makelong
sub
_parse_makelong
($)
{
local
$_
=
shift
;
my
$low
;
my
$high
;
my
$name
;
my
@arguments
;
my
@argument_lines
;
my
@argument_columns
;
my
$parser
=
new
c_parser
;
my
$line
=
1
;
my
$column
=
0
;
if
(
$parser
->
parse_c_function_call
(
\
$_
,
\
$line
,
\
$column
,
\
$name
,
\
@arguments
,
\
@argument_lines
,
\
@argument_columns
)
&&
$name
=~
/^MAKE(?:LONG|LPARAM|LRESULT|WPARAM)$/
)
{
$low
=
$arguments
[
0
];
$high
=
$arguments
[
1
];
}
elsif
(
/^(?:\(\w+\)\s*)?0L?$/
)
{
$low
=
"0"
;
$high
=
"0"
;
}
else
{
$low
=
"($_) & 0xffff"
;
$high
=
"($_) << 16"
;
}
$low
=~
s/^\s*(.*?)\s*$/$1/
;
$high
=~
s/^\s*(.*?)\s*$/$1/
;
return
(
$low
,
$high
);
}
########################################################################
# fixup_function_call_2_windowsx
sub
fixup_user_message_2_windowsx
($$)
{
my
$name
=
shift
;
(
my
$hwnd
,
my
$msg
,
my
$wparam
,
my
$lparam
)
=
@
{(
shift
)};
if
(
$msg
!~
/^WM_/
)
{
return
undef
;
}
elsif
(
$msg
=~
/^
(?:
WM_BEGINDRAG
|
WM_ENTERMENULOOP
|
WM_EXITMENULOOP
|
WM_HELP
|
WM_ISACTIVEICON
|
WM_LBTRACKPOINT
|
WM_NEXTMENU
)
$
/
x
)
{
return
undef
;
}
elsif
(
$msg
=~
/^WM_(?:GET|SET)TEXT$/
)
{
return
undef
;
}
my
$suffix
;
$name
=~
/([AW])?$/
;
if
(
defined
(
$1
))
{
$suffix
=
$1
;
}
else
{
$suffix
=
""
;
}
$wparam
=~
s/^\(WPARAM\)\s*//
;
$lparam
=~
s/^\(LPARAM\)\s*//
;
my
@arguments
;
if
(
$msg
=~
/^WM_COMMAND$/
)
{
(
my
$id
,
my
$code_notify
)
=
_parse_makelong
(
$wparam
);
my
$hwndctl
=
$lparam
;
@arguments
=
(
$id
,
$hwndctl
,
$code_notify
);
}
elsif
(
$msg
=~
/^WM_(?:COPY|CUT|PASTE)$/
)
{
@arguments
=
();
}
elsif
(
$msg
=~
/^WM_(?:CHARTO|VKEYTO)ITEM$/
)
{
(
my
$key
,
my
$caret
)
=
_parse_makelong
(
$wparam
);
my
$hwndctl
=
$lparam
;
@arguments
=
(
$key
,
$hwndctl
,
$caret
);
}
elsif
(
$msg
=~
/^WM_(?:COMPARE|DELETE|DRAW|MEASURE)ITEM$/
)
{
@arguments
=
(
$lparam
);
}
elsif
(
$msg
=~
s/^WM_GETTEXT$/$&$suffix/
)
{
@arguments
=
(
$wparam
,
$lparam
);
}
elsif
(
$msg
=~
/^WM_INITMENU$/
)
{
my
$hmenu
=
$wparam
;
@arguments
=
(
$hmenu
);
}
elsif
(
$msg
=~
/^WM_INITMENUPOPUP$/
)
{
my
$hmenu
=
$wparam
;
(
my
$item
,
my
$system_menu
)
=
_parse_makelong
(
$lparam
);
@arguments
=
(
$hmenu
,
$item
,
$system_menu
);
}
elsif
(
$msg
=~
/^WM_MENUCHAR$/
)
{
(
my
$ch
,
my
$flags
)
=
_parse_makelong
(
$wparam
);
my
$hmenu
=
$lparam
;
@arguments
=
(
$ch
,
$flags
,
$hmenu
);
}
elsif
(
$msg
=~
/^WM_MENUSELECT$/
)
{
(
my
$item
,
my
$flags
)
=
_parse_makelong
(
$wparam
);
my
$hmenu
=
$lparam
;
my
$hmenu_popup
=
"NULL"
;
# FIXME: Is this really correct?
@arguments
=
(
$hmenu
,
$item
,
$hmenu_popup
,
$flags
);
}
elsif
(
$msg
=~
s/^WM_(NC)?LBUTTONDBLCLK$/WM_$1LBUTTONDOWN/
)
{
my
$double_click
=
"TRUE"
;
my
$key_flags
=
$wparam
;
(
my
$x
,
my
$y
)
=
_parse_makelong
(
$lparam
);
@arguments
=
(
$double_click
,
$x
,
$y
,
$key_flags
);
}
elsif
(
$msg
=~
/^WM_(NC)?LBUTTONDOWN$/
)
{
my
$double_click
=
"FALSE"
;
my
$key_flags
=
$wparam
;
(
my
$x
,
my
$y
)
=
_parse_makelong
(
$lparam
);
@arguments
=
(
$double_click
,
$x
,
$y
,
$key_flags
);
}
elsif
(
$msg
=~
/^WM_LBUTTONUP$/
)
{
my
$key_flags
=
$wparam
;
(
my
$x
,
my
$y
)
=
_parse_makelong
(
$lparam
);
@arguments
=
(
$x
,
$y
,
$key_flags
);
}
elsif
(
$msg
=~
/^WM_SETCURSOR$/
)
{
my
$hwnd_cursor
=
$wparam
;
(
my
$code_hit_test
,
my
$msg2
)
=
_parse_makelong
(
$lparam
);
@arguments
=
(
$hwnd_cursor
,
$code_hit_test
,
$msg2
);
}
elsif
(
$msg
=~
s/^WM_SETTEXT$/$&$suffix/
)
{
my
$text
=
$lparam
;
@arguments
=
(
$text
);
}
elsif
(
$msg
=~
/^WM_(?:SYS)?KEYDOWN$/
)
{
my
$vk
=
$wparam
;
(
my
$repeat
,
my
$flags
)
=
_parse_makelong
(
$lparam
);
@arguments
=
(
$vk
,
$repeat
,
$flags
);
}
else
{
@arguments
=
(
$wparam
,
$lparam
);
}
unshift
@arguments
,
$hwnd
;
return
"FORWARD_"
.
$msg
.
"("
.
join
(
", "
,
@arguments
)
.
", $name)"
;
}
########################################################################
# _get_messages
sub
_get_messages
($)
{
local
$_
=
shift
;
if
(
/^(?:BM|CB|EM|LB|STM|WM)_\w+(.*?)$/
)
{
if
(
!
$1
)
{
return
(
$_
);
}
else
{
return
();
}
}
elsif
(
/^(.*?)\s*\?\s*((?:BM|CB|EM|LB|STM|WM)_\w+)\s*:\s*((?:BM|CB|EM|LB|STM|WM)_\w+)$/
)
{
return
(
$2
,
$3
);
}
elsif
(
/^\w+$/
)
{
return
();
}
elsif
(
/^RegisterWindowMessage[AW]\s*\(.*?\)$/
)
{
return
();
}
else
{
$output
->
write
(
"warning: _get_messages: '$_'\n"
);
return
();
}
}
########################################################################
# _fixup_user_message
sub
_fixup_user_message
($$)
{
my
$name
=
shift
;
(
my
$hwnd
,
my
$msg
,
my
$wparam
,
my
$lparam
)
=
@
{(
shift
)};
my
$modified
=
0
;
my
$wkind
;
my
$lkind
;
foreach
my
$msg
(
_get_messages
(
$msg
))
{
my
$new_wkind
=
get_message_wparam_kind
(
$msg
);
if
(
defined
(
$wkind
)
&&
$new_wkind
ne
$wkind
)
{
$output
->
write
(
"messsages used together do not have the same type\n"
);
}
else
{
$wkind
=
$new_wkind
;
}
my
$new_lkind
=
get_message_lparam_kind
(
$msg
);
if
(
defined
(
$lkind
)
&&
$new_lkind
ne
$lkind
)
{
$output
->
write
(
"messsages used together do not have the same type\n"
);
}
else
{
$lkind
=
$new_lkind
;
}
}
my
@entries
=
(
[
\
$wparam
,
$wkind
,
"W"
,
"w"
],
[
\
$lparam
,
$lkind
,
"L"
,
"l"
]
);
foreach
my
$entry
(
@entries
)
{
(
my
$refparam
,
my
$kind
,
my
$upper
,
my
$lower
)
=
@$entry
;
if
(
!
defined
(
$kind
))
{
if
(
$msg
=~
/^WM_/
)
{
$output
->
write
(
"messsage $msg not properly defined\n"
);
$modified
=
0
;
last
;
}
}
elsif
(
$kind
eq
"ptr"
)
{
if
(
$$refparam
=~
/^(\(${upper}PARAM\))?\s*($lower[pP]aram)$/
)
{
if
(
defined
(
$1
))
{
$$refparam
=
$2
;
$modified
=
1
;
}
}
elsif
(
$$refparam
=~
/^(\(${upper}PARAM\))?\s*0$/
)
{
$$refparam
=
"(${upper}PARAM) NULL"
;
$modified
=
1
;
}
elsif
(
$$refparam
!~
/^\(${upper}PARAM\)\s*/
)
{
$$refparam
=
"(${upper}PARAM) $$refparam"
;
$modified
=
1
;
}
}
elsif
(
$kind
eq
"long"
)
{
if
(
$$refparam
=~
s/^\(${upper}PARAM\)\s*//
)
{
$modified
=
1
;
}
}
}
if
(
$modified
)
{
my
@arguments
=
(
$hwnd
,
$msg
,
$wparam
,
$lparam
);
return
"$name("
.
join
(
", "
,
@arguments
)
.
")"
;
}
else
{
return
undef
;
}
}
########################################################################
# fixup_statements
sub
fixup_statements
($$)
{
my
$function
=
shift
;
my
$editor
=
shift
;
my
$file
=
$function
->
file
;
my
$linkage
=
$function
->
linkage
;
my
$name
=
$function
->
name
;
my
$statements_line
=
$function
->
statements_line
;
my
$statements_column
=
$function
->
statements_column
;
my
$statements
=
$function
->
statements
;
if
(
!
defined
(
$statements
))
{
return
;
}
my
$parser
=
new
c_parser
(
$file
);
my
$found_function_call
=
sub
{
my
$begin_line
=
shift
;
my
$begin_column
=
shift
;
my
$end_line
=
shift
;
my
$end_column
=
shift
;
my
$name
=
shift
;
my
$arguments
=
shift
;
foreach
my
$argument
(
@$arguments
)
{
$argument
=~
s/^\s*(.*?)\s*$/$1/
;
}
my
$fixup_function_call
;
if
(
$name
=~
/^(?:DefWindowProc|SendMessage)[AW]$/
)
{
if
(
$options
->
statements_windowsx
)
{
$fixup_function_call
=
\&
fixup_user_message_2_windowsx
;
}
else
{
$fixup_function_call
=
\&
_fixup_user_message
;
}
}
if
(
defined
(
$fixup_function_call
))
{
my
$replace
=
&
$fixup_function_call
(
$name
,
$arguments
);
if
(
defined
(
$replace
))
{
$editor
->
replace
(
$begin_line
,
$begin_column
,
$end_line
,
$end_column
,
$replace
);
}
}
elsif
(
$options
->
debug
)
{
$output
->
write
(
"$begin_line.$begin_column-$end_line.$end_column: "
.
"$name("
.
join
(
", "
,
@$arguments
)
.
")\n"
);
}
return
0
;
};
$parser
->
set_found_function_call_callback
(
$found_function_call
);
my
$line
=
$statements_line
;
my
$column
=
0
;
if
(
!
$parser
->
parse_c_statements
(
\
$statements
,
\
$line
,
\
$column
))
{
$output
->
write
(
"error: can't parse statements\n"
);
}
}
1
;
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment