Dutch translation of clock and cmdlgtst.
[wine] / tools / winedump / function_grep.pl
1 #! /usr/bin/perl
2 #
3 # Copyright 2000 Patrik Stridvall
4 #
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.
9 #
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.
14 #
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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
18 #
19
20 use strict;
21
22 my $invert = 0;
23 my $pattern;
24 my @files = ();
25
26 while(defined($_ = shift)) {
27     if(/^-/) {
28         if(/^-v$/) {
29             $invert = 1;
30         }
31     } else {
32         if(!defined($pattern)) {
33             $pattern = $_;
34         } else {
35             push @files, $_;
36         }
37     }
38 }
39
40 foreach my $file (@files) {
41     open(IN, "< $file");
42
43     my $level = 0;
44     my $extern_c = 0;
45
46     my $again = 0;
47     my $lookahead = 0;
48     while($again || defined(my $line = <IN>)) {
49         if(!$again) {
50             chomp $line;
51             if($lookahead) {
52                 $lookahead = 0;
53                 $_ .= "\n" . $line;
54             } else {
55                 $_ = $line;
56             }
57         } else {
58             $again = 0;
59         }
60
61         # remove C comments
62         if(s/^(.*?)(\/\*.*?\*\/)(.*)$/$1 $3/s) {
63             $again = 1;
64             next;
65         } elsif(/^(.*?)\/\*/s) {
66             $lookahead = 1;
67             next;
68         }
69
70         # remove C++ comments
71         while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1; }
72         if($again) { next; }
73
74         # remove empty rows
75         if(/^\s*$/) { next; }
76
77         # remove preprocessor directives
78         if(s/^\s*\#/\#/m) {
79             if(/^\#.*?\\$/m) {
80                 $lookahead = 1;
81                 next;
82             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
83                 next;
84             }
85         }
86
87         # Remove extern "C"
88         if(s/^\s*extern\s+"C"\s+\{//m) {
89             $extern_c = 1;
90             $again = 1;
91             next;
92         }
93
94         if($level > 0)
95         {
96             my $line = "";
97             while(/^[^\{\}]/) {
98                 s/^([^\{\}\'\"]*)//s;
99                 $line .= $1;
100                 if(s/^\'//) {
101                     $line .= "\'";
102                     while(/^./ && !s/^\'//) {
103                         s/^([^\'\\]*)//s;
104                         $line .= $1;
105                         if(s/^\\//) {
106                             $line .= "\\";
107                             if(s/^(.)//s) {
108                                 $line .= $1;
109                                 if($1 eq "0") {
110                                     s/^(\d{0,3})//s;
111                                     $line .= $1;
112                                 }
113                             }
114                         }
115                     }
116                     $line .= "\'";
117                 } elsif(s/^\"//) {
118                     $line .= "\"";
119                     while(/^./ && !s/^\"//) {
120                         s/^([^\"\\]*)//s;
121                         $line .= $1;
122                         if(s/^\\//) {
123                             $line .= "\\";
124                             if(s/^(.)//s) {
125                                 $line .= $1;
126                                 if($1 eq "0") {
127                                     s/^(\d{0,3})//s;
128                                     $line .= $1;
129                                 }
130                             }
131                         }
132                     }
133                     $line .= "\"";
134                 }
135             }
136
137             if(s/^\{//) {
138                 $_ = $'; $again = 1;
139                 $line .= "{";
140                 $level++;
141             } elsif(s/^\}//) {
142                 $_ = $'; $again = 1;
143                 $line .= "}" if $level > 1;
144                 $level--;
145                 if($level == -1 && $extern_c) {
146                     $extern_c = 0;
147                     $level = 0;
148                 }
149             }
150
151             next;
152         } elsif(/^class[^\}]*{/) {
153             $_ = $'; $again = 1;
154             $level++;
155             next;
156         } elsif(/^class[^\}]*$/) {
157             $lookahead = 1;
158             next;
159         } elsif(/^typedef[^\}]*;/) {
160             next;
161         } elsif(/(extern\s+|static\s+)?
162                 (?:__inline__\s+|__inline\s+|inline\s+)?
163                 ((struct\s+|union\s+|enum\s+)?(?:\w+(?:\:\:(?:\s*operator\s*[^\)\s]+)?)?)+((\s*(?:\*|\&))+\s*|\s+))
164                 ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
165                 ((?:\w+(?:\:\:)?)+(\(\w+\))?)\s*\(([^\)]*)\)\s*
166                 (?:\w+(?:\s*\([^\)]*\))?\s*)*\s*
167                 (\{|\;)/sx)
168         {
169             $_ = $'; $again = 1;
170             if($11 eq "{")  {
171                 $level++;
172             }
173
174             my $linkage = $1;
175             my $return_type = $2;
176             my $calling_convention = $7;
177             my $name = $8;
178             my $arguments = $10;
179
180             if(!defined($linkage)) {
181                 $linkage = "";
182             }
183
184             if(!defined($calling_convention)) {
185                 $calling_convention = "";
186             }
187
188             $linkage =~ s/\s*$//;
189
190             $return_type =~ s/\s*$//;
191             $return_type =~ s/\s*\*\s*/*/g;
192             $return_type =~ s/(\*+)/ $1/g;
193
194             $arguments =~ y/\t\n/  /;
195             $arguments =~ s/^\s*(.*?)\s*$/$1/;
196             if($arguments eq "") { $arguments = "void" }
197
198             my @argument_types;
199             my @argument_names;
200             my @arguments = split(/,/, $arguments);
201             foreach my $n (0..$#arguments) {
202                 my $argument_type = "";
203                 my $argument_name = "";
204                 my $argument = $arguments[$n];
205                 $argument =~ s/^\s*(.*?)\s*$/$1/;
206                 # print "  " . ($n + 1) . ": '$argument'\n";
207                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
208                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s)|\s*)\s*//;
209                 if($argument =~ /^\.\.\.$/) {
210                     $argument_type = "...";
211                     $argument_name = "...";
212                 } elsif($argument =~ /^
213                         ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
214                           (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+(?:\:\:)?)+)\s*
215                         ((?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*(?:\*\s*?)*)\s*
216                         (?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*
217                         (\w*)\s*
218                         (?:\[\]|\s+OPTIONAL)?/x)
219                 {
220                     $argument_type = "$1";
221                     if($2 ne "") {
222                         $argument_type .= " $2";
223                     }
224                     $argument_name = $3;
225
226                     $argument_type =~ s/\s*const\s*/ /;
227                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
228
229                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
230                 } else {
231                     die "$file: $.: syntax error: '$argument'\n";
232                 }
233                 $argument_types[$n] = $argument_type;
234                 $argument_names[$n] = $argument_name;
235                 # print "  " . ($n + 1) . ": '$argument_type': '$argument_name'\n";
236             }
237             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
238                 $#argument_types = -1;
239                 $#argument_names = -1;
240             }
241
242             @arguments = ();
243             foreach my $n (0..$#argument_types) {
244                 if($argument_names[$n] && $argument_names[$n] ne "...") {
245                     if($argument_types[$n] !~ /\*$/) {
246                         $arguments[$n] = $argument_types[$n] . " " . $argument_names[$n];
247                     } else {
248                         $arguments[$n] = $argument_types[$n] . $argument_names[$n];
249                     }
250                 } else {
251                     $arguments[$n] = $argument_types[$n];
252                 }
253             }
254
255             $arguments = join(", ", @arguments);
256             if(!$arguments) { $arguments = "void"; }
257
258             if((!$invert && $name =~ /$pattern/) || ($invert && $name !~ /$pattern/)) {
259                 if($calling_convention) {
260                     print "$return_type $calling_convention $name($arguments)\n";
261                 } else {
262                     if($return_type =~ /\*$/) {
263                         print "$return_type$name($arguments)\n";
264                     } else {
265                         print "$return_type $name($arguments)\n";
266                     }
267                 }
268             }
269         } elsif(/\'[^\']*\'/s) {
270             $_ = $'; $again = 1;
271         } elsif(/\"[^\"]*\"/s) {
272             $_ = $'; $again = 1;
273         } elsif(/;/s) {
274             $_ = $'; $again = 1;
275         } elsif(/extern\s+"C"\s+{/s) {
276             $_ = $'; $again = 1;
277         } elsif(/\{/s) {
278             $_ = $'; $again = 1;
279             $level++;
280         } else {
281             $lookahead = 1;
282         }
283     }
284     close(IN);
285 }