winemaker: Update man page.
[wine.git] / tools / winedump / function_grep.pl
blob60e5677e2cc0e2abc52a2b71893be2bc1c83acd0
1 #! /usr/bin/perl -w
3 # Copyright 2000 Patrik Stridvall
5 # This library is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU Lesser General Public
7 # License as published by the Free Software Foundation; either
8 # version 2.1 of the License, or (at your option) any later version.
10 # This library is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # Lesser General Public License for more details.
15 # You should have received a copy of the GNU Lesser General Public
16 # License along with this library; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
20 use strict;
22 my $name0=$0;
23 $name0 =~ s%^.*/%%;
25 my $invert = 0;
26 my $pattern;
27 my @files = ();
28 my $usage;
30 while(defined($_ = shift)) {
31 if (/^-v$/) {
32 $invert = 1;
33 } elsif (/^--?(\?|h|help)$/) {
34 $usage=0;
35 } elsif (/^-/) {
36 print STDERR "$name0:error: unknown option '$_'\n";
37 $usage=2;
38 last;
39 } elsif(!defined($pattern)) {
40 $pattern = $_;
41 } else {
42 push @files, $_;
45 if (defined $usage)
47 print "Usage: $name0 [--help] [-v] pattern files...\n";
48 print "where:\n";
49 print "--help Prints this help message\n";
50 print "-v Return functions that do not match pattern\n";
51 print "pattern A regular expression for the function name\n";
52 print "files... A list of files to search the function in\n";
53 exit $usage;
56 foreach my $file (@files) {
57 open(IN, "< $file") || die "Error: Can't open $file: $!\n";
59 my $level = 0;
60 my $extern_c = 0;
62 my $again = 0;
63 my $lookahead = 0;
64 while($again || defined(my $line = <IN>)) {
65 if(!$again) {
66 chomp $line;
67 if($lookahead) {
68 $lookahead = 0;
69 $_ .= "\n" . $line;
70 } else {
71 $_ = $line;
73 } else {
74 $again = 0;
77 # remove C comments
78 if(s/^(|.*?[^\/])(\/\*.*?\*\/)(.*)$/$1 $3/s) {
79 $again = 1;
80 next;
81 } elsif(/^(.*?)\/\*/s) {
82 $lookahead = 1;
83 next;
86 # remove C++ comments
87 while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1; }
88 if($again) { next; }
90 # remove empty rows
91 if(/^\s*$/) { next; }
93 # remove preprocessor directives
94 if(s/^\s*\#/\#/m) {
95 if(/^\#[.\n\r]*?\\$/m) {
96 $lookahead = 1;
97 next;
98 } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
99 next;
103 # Remove extern "C"
104 if(s/^\s*extern[\s\n]+"C"[\s\n]+\{//m) {
105 $extern_c = 1;
106 $again = 1;
107 next;
108 } elsif(m/^\s*extern[\s\n]+"C"/m) {
109 $lookahead = 1;
110 next;
113 if($level > 0)
115 my $line = "";
116 while(/^[^\{\}]/) {
117 s/^([^\{\}\'\"]*)//s;
118 $line .= $1;
119 if(s/^\'//) {
120 $line .= "\'";
121 while(/^./ && !s/^\'//) {
122 s/^([^\'\\]*)//s;
123 $line .= $1;
124 if(s/^\\//) {
125 $line .= "\\";
126 if(s/^(.)//s) {
127 $line .= $1;
128 if($1 eq "0") {
129 s/^(\d{0,3})//s;
130 $line .= $1;
135 $line .= "\'";
136 } elsif(s/^\"//) {
137 $line .= "\"";
138 while(/^./ && !s/^\"//) {
139 s/^([^\"\\]*)//s;
140 $line .= $1;
141 if(s/^\\//) {
142 $line .= "\\";
143 if(s/^(.)//s) {
144 $line .= $1;
145 if($1 eq "0") {
146 s/^(\d{0,3})//s;
147 $line .= $1;
152 $line .= "\"";
156 if(s/^\{//) {
157 $_ = $'; $again = 1;
158 $line .= "{";
159 $level++;
160 } elsif(s/^\}//) {
161 $_ = $'; $again = 1;
162 $line .= "}" if $level > 1;
163 $level--;
164 if($level == -1 && $extern_c) {
165 $extern_c = 0;
166 $level = 0;
170 next;
171 } elsif(/^class[^\}]*{/) {
172 $_ = $'; $again = 1;
173 $level++;
174 next;
175 } elsif(/^class[^\}]*$/) {
176 $lookahead = 1;
177 next;
178 } elsif(/^typedef[^\}]*;/) {
179 next;
180 } elsif(/(extern\s+|static\s+)?
181 (?:__inline__\s+|__inline\s+|inline\s+)?
182 ((struct\s+|union\s+|enum\s+)?(?:\w+(?:\:\:(?:\s*operator\s*[^\)\s]+)?)?)+((\s*(?:\*|\&))+\s*|\s+))
183 ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
184 ((?:\w+(?:\:\:)?)+(\(\w+\))?)\s*\(([^\)]*)\)\s*
185 (?:\w+(?:\s*\([^\)]*\))?\s*)*\s*
186 (\{|\;)/sx)
188 $_ = $'; $again = 1;
189 if($11 eq "{") {
190 $level++;
193 my $linkage = $1;
194 my $return_type = $2;
195 my $calling_convention = $7;
196 my $name = $8;
197 my $arguments = $10;
199 if(!defined($linkage)) {
200 $linkage = "";
203 if(!defined($calling_convention)) {
204 $calling_convention = "";
207 $linkage =~ s/\s*$//;
209 $return_type =~ s/\s*$//;
210 $return_type =~ s/\s*\*\s*/*/g;
211 $return_type =~ s/(\*+)/ $1/g;
213 $arguments =~ y/\t\n/ /;
214 $arguments =~ s/^\s*(.*?)\s*$/$1/;
215 if($arguments eq "") { $arguments = "void" }
217 my @argument_types;
218 my @argument_names;
219 my @arguments = split(/,/, $arguments);
220 foreach my $n (0..$#arguments) {
221 my $argument_type = "";
222 my $argument_name = "";
223 my $argument = $arguments[$n];
224 $argument =~ s/^\s*(.*?)\s*$/$1/;
225 # print " " . ($n + 1) . ": '$argument'\n";
226 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
227 $argument =~ s/^(const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s)|\s*)\s*//;
228 if($argument =~ /^\.\.\.$/) {
229 $argument_type = "...";
230 $argument_name = "...";
231 } elsif($argument =~ /^
232 ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
233 (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+(?:\:\:)?)+)\s*
234 ((?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*(?:\*\s*?)*)\s*
235 (?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*
236 (\w*)\s*
237 (?:\[\]|\s+OPTIONAL)?/x)
239 $argument_type = "$1";
240 if($2 ne "") {
241 $argument_type .= " $2";
243 $argument_name = $3;
245 $argument_type =~ s/\s*const\s*/ /;
246 $argument_type =~ s/^\s*(.*?)\s*$/$1/;
248 $argument_name =~ s/^\s*(.*?)\s*$/$1/;
249 } else {
250 die "$file: $.: syntax error: '$argument'\n";
252 $argument_types[$n] = $argument_type;
253 $argument_names[$n] = $argument_name;
254 # print " " . ($n + 1) . ": '$argument_type': '$argument_name'\n";
256 if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
257 $#argument_types = -1;
258 $#argument_names = -1;
261 @arguments = ();
262 foreach my $n (0..$#argument_types) {
263 if($argument_names[$n] && $argument_names[$n] ne "...") {
264 if($argument_types[$n] !~ /\*$/) {
265 $arguments[$n] = $argument_types[$n] . " " . $argument_names[$n];
266 } else {
267 $arguments[$n] = $argument_types[$n] . $argument_names[$n];
269 } else {
270 $arguments[$n] = $argument_types[$n];
274 $arguments = join(", ", @arguments);
275 if(!$arguments) { $arguments = "void"; }
277 if((!$invert && $name =~ /$pattern/) || ($invert && $name !~ /$pattern/)) {
278 if($calling_convention) {
279 print "$return_type $calling_convention $name($arguments)\n";
280 } else {
281 if($return_type =~ /\*$/) {
282 print "$return_type$name($arguments)\n";
283 } else {
284 print "$return_type $name($arguments)\n";
288 } elsif(/\'(?:[^\\\']*|\\.)*\'/s) {
289 $_ = $'; $again = 1;
290 } elsif(/\"(?:[^\\\"]*|\\.)*\"/s) {
291 $_ = $'; $again = 1;
292 } elsif(/;/s) {
293 $_ = $'; $again = 1;
294 } elsif(/extern\s+"C"\s+{/s) {
295 $_ = $'; $again = 1;
296 } elsif(/\{/s) {
297 $_ = $'; $again = 1;
298 $level++;
299 } else {
300 $lookahead = 1;
303 close(IN);