winhlp32: Add support for accelerators in general and F1 in particular.
[wine] / tools / winapi / c_parser.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 c_parser;
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();
29
30 use options qw($options);
31 use output qw($output);
32
33 use c_function;
34 use c_type;
35
36 # Defined a couple common regexp tidbits
37 my $CALL_CONVENTION="__cdecl|__stdcall|" .
38                     "__RPC_API|__RPC_STUB|__RPC_USER|" .
39                     "CALLBACK|CDECL|NTAPI|PASCAL|RPC_ENTRY|RPC_VAR_ENTRY|" .
40                     "VFWAPI|VFWAPIV|WINAPI|WINAPIV|APIENTRY|";
41
42
43 sub parse_c_function($$$$$);
44 sub parse_c_function_call($$$$$$$$);
45 sub parse_c_preprocessor($$$$);
46 sub parse_c_statements($$$$);
47 sub parse_c_tuple($$$$$$$);
48 sub parse_c_type($$$$$);
49 sub parse_c_typedef($$$$);
50 sub parse_c_variable($$$$$$$);
51
52
53 sub new($$)
54 {
55     my ($proto, $filename) = @_;
56     my $class = ref($proto) || $proto;
57     my $self  = {FILE => $filename,
58                  CREATE_FUNCTION => sub { return new c_function; },
59                  CREATE_TYPE => sub { return new c_type; },
60                  FOUND_COMMENT => sub { return 1; },
61                  FOUND_DECLARATION => sub { return 1; },
62                  FOUND_FUNCTION => sub { return 1; },
63                  FOUND_FUNCTION_CALL => sub { return 1; },
64                  FOUND_LINE => sub { return 1; },
65                  FOUND_PREPROCESSOR => sub { return 1; },
66                  FOUND_STATEMENT => sub { return 1; },
67                  FOUND_TYPE => sub { return 1; },
68                  FOUND_VARIABLE => sub { return 1; }
69     };
70     bless ($self, $class);
71     return $self;
72 }
73
74
75 #
76 # Callback setters
77 #
78
79 sub set_found_comment_callback($$)
80 {
81     my ($self, $found_comment) = @_;
82     $self->{FOUND_COMMENT} = $found_comment;
83 }
84
85 sub set_found_declaration_callback($$)
86 {
87     my ($self, $found_declaration) = @_;
88     $self->{FOUND_DEClARATION} = $found_declaration;
89 }
90
91     sub set_found_function_callback($$)
92 {
93     my ($self, $found_function) = @_;
94     $self->{FOUND_FUNCTION} = $found_function;
95 }
96
97 sub set_found_function_call_callback($$)
98 {
99     my ($self, $found_function_call) = @_;
100     $self->{FOUND_FUNCTION_CALL} = $found_function_call;
101 }
102
103 sub set_found_line_callback($$)
104 {
105     my ($self, $found_line) = @_;
106     $self->{FOUND_LINE} = $found_line;
107 }
108
109 sub set_found_preprocessor_callback($$)
110 {
111     my ($self, $found_preprocessor) = @_;
112     $self->{FOUND_PREPROCESSOR} = $found_preprocessor;
113 }
114
115 sub set_found_statement_callback($$)
116 {
117     my ($self, $found_statement) = @_;
118     $self->{FOUND_STATEMENT} = $found_statement;
119 }
120
121 sub set_found_type_callback($$)
122 {
123     my ($self, $found_type) = @_;
124     $self->{FOUND_TYPE} = $found_type;
125 }
126
127 sub set_found_variable_callback($$)
128 {
129     my ($self, $found_variable) = @_;
130     $self->{FOUND_VARIABLE} = $found_variable;
131 }
132
133
134 ########################################################################
135 # _format_c_type
136 sub _format_c_type($$)
137 {
138     my ($self, $type) = @_;
139
140     $type =~ s/^\s*(.*?)\s*$/$1/;
141
142     if ($type =~ /^(\w+(?:\s*\*)*)\s*\(\s*\*\s*\)\s*\(\s*(.*?)\s*\)$/s) {
143         my $return_type = $1;
144         my @arguments = split(/\s*,\s*/, $2);
145         foreach my $argument (@arguments) {
146             if ($argument =~ s/^(\w+(?:\s*\*)*)\s*\w+$/$1/) { 
147                 $argument =~ s/\s+/ /g;
148                 $argument =~ s/\s*\*\s*/*/g;
149                 $argument =~ s/(\*+)$/ $1/;
150             }
151         }
152
153         $type = "$return_type (*)(" . join(", ", @arguments) . ")";
154     }
155
156     return $type;
157 }
158
159
160 ########################################################################
161 # _parse_c_warning
162 #
163 # FIXME: Use caller (See man perlfunc)
164 sub _parse_c_warning($$$$$$)
165 {
166     my ($self, $curlines, $line, $column, $context, $message) = @_;
167
168     $message = "warning" if !$message;
169
170     my $current = "";
171     if ($curlines) {
172         my @lines = split(/\n/, $curlines);
173
174         $current .= $lines[0] . "\n" if $lines[0];
175         $current .= $lines[1] . "\n" if $lines[1];
176     }
177
178     if($current) {
179         $output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message: \\\n$current");
180     } else {
181         $output->write("$self->{FILE}:$line." . ($column + 1) . ": $context: $message\n");
182     }
183 }
184
185 ########################################################################
186 # _parse_c_error
187
188 sub _parse_c_error($$$$$$)
189 {
190     my ($self, $curlines, $line, $column, $context, $message) = @_;
191
192     $message = "parse error" if !$message;
193
194     # Why did I do this?
195     if($output->prefix) {
196         # $output->write("\n");
197         $output->prefix("");
198     }
199
200     $self->_parse_c_warning($curlines, $line, $column, $context, $message);
201
202     exit 1;
203 }
204
205 ########################################################################
206 # _update_c_position
207
208 sub _update_c_position($$$$)
209 {
210     my ($self, $source, $refline, $refcolumn) = @_;
211     my $line = $$refline;
212     my $column = $$refcolumn;
213
214     while ($source)
215     {
216         if ($source =~ s/^[^\n\t\'\"]*//s)
217         {
218             $column += length($&);
219         }
220
221         if ($source =~ s/^\'//)
222         {
223             $column++;
224             while ($source =~ /^./ && $source !~ s/^\'//)
225             {
226                 $source =~ s/^([^\'\\]*)//s;
227                 $column += length($1);
228                 if ($source =~ s/^\\//)
229                 {
230                     $column++;
231                     if ($source =~ s/^(.)//s)
232                     {
233                         $column += length($1);
234                         if ($1 eq "0")
235                         {
236                             $source =~ s/^(\d{0,3})//s;
237                             $column += length($1);
238                         }
239                     }
240                 }
241             }
242             $column++;
243         }
244         elsif ($source =~ s/^\"//)
245         {
246             $column++;
247             while ($source =~ /^./ && $source !~ s/^\"//)
248             {
249                 $source =~ s/^([^\"\\]*)//s;
250                 $column += length($1);
251                 if ($source =~ s/^\\//)
252                 {
253                     $column++;
254                     if ($source =~ s/^(.)//s)
255                     {
256                         $column += length($1);
257                         if ($1 eq "0")
258                         {
259                             $source =~ s/^(\d{0,3})//s;
260                             $column += length($1);
261                         }
262                     }
263                 }
264             }
265             $column++;
266         }
267         elsif ($source =~ s/^\n//)
268         {
269             $line++;
270             $column = 0;
271         }
272         elsif ($source =~ s/^\t//)
273         {
274             $column = $column + 8 - $column % 8;
275         }
276     }
277
278     $$refline = $line;
279     $$refcolumn = $column;
280 }
281
282 ########################################################################
283 # __parse_c_until_one_of
284
285 sub __parse_c_until_one_of($$$$$$$) {
286     my $self = shift;
287
288     my $characters = shift;
289     my $on_same_level = shift;
290     my $refcurrent = shift;
291     my $refline = shift;
292     my $refcolumn = shift;
293     my $match = shift;
294
295     local $_ = $$refcurrent;
296     my $line = $$refline;
297     my $column = $$refcolumn;
298
299
300     if(!defined($match)) {
301         my $blackhole;
302         $match = \$blackhole;
303     }
304
305     my $level = 0;
306     $$match = "";
307     while(/^[^$characters]/s || $level > 0) {
308         my $submatch = "";
309
310         if ($level > 0) {
311             if(s/^[^\(\)\[\]\{\}\n\t\'\"]*//s) {
312                 $submatch .= $&;
313             }
314         } elsif ($on_same_level) {
315             if(s/^[^$characters\(\)\[\]\{\}\n\t\'\"]*//s) {
316                 $submatch .= $&;
317             }
318         } else {
319             if(s/^[^$characters\n\t\'\"]*//s) {
320                 $submatch .= $&;
321             }
322         }
323
324         if(s/^\'//) {
325             $submatch .= "\'";
326             while(/^./ && !s/^\'//) {
327                 s/^([^\'\\]*)//s;
328                 $submatch .= $1;
329                 if(s/^\\//) {
330                     $submatch .= "\\";
331                     if(s/^(.)//s) {
332                         $submatch .= $1;
333                         if($1 eq "0") {
334                             s/^(\d{0,3})//s;
335                             $submatch .= $1;
336                         }
337                     }
338                 }
339             }
340             $submatch .= "\'";
341
342             $$match .= $submatch;
343             $column += length($submatch);
344         } elsif(s/^\"//) {
345             $submatch .= "\"";
346             while(/^./ && !s/^\"//) {
347                 s/^([^\"\\]*)//s;
348                 $submatch .= $1;
349                 if(s/^\\//) {
350                     $submatch .= "\\";
351                     if(s/^(.)//s) {
352                         $submatch .= $1;
353                         if($1 eq "0") {
354                             s/^(\d{0,3})//s;
355                             $submatch .= $1;
356                         }
357                     }
358                 }
359             }
360             $submatch .= "\"";
361
362             $$match .= $submatch;
363             $column += length($submatch);
364         } elsif($on_same_level && s/^[\(\[\{]//) {
365             $level++;
366
367             $submatch .= $&;
368             $$match .= $submatch;
369             $column++;
370         } elsif($on_same_level && s/^[\)\]\}]//) {
371             if ($level > 0) {
372                 $level--;
373                 
374                 $submatch .= $&;
375                 $$match .= $submatch;
376                 $column++;
377             } else {
378                 $_ = "$&$_";
379                 $$match .= $submatch;
380                 last;
381             }
382         } elsif(s/^\n//) {
383             $submatch .= "\n";
384
385             $$match .= $submatch;
386             $line++;
387             $column = 0;
388         } elsif(s/^\t//) {
389             $submatch .= "\t";
390
391             $$match .= $submatch;
392             $column = $column + 8 - $column % 8;
393         } else {
394             $$match .= $submatch;
395             $column += length($submatch);
396         }
397     }
398
399     $$refcurrent = $_;
400     $$refline = $line;
401     $$refcolumn = $column;
402     return 1;
403 }
404
405 sub _parse_c_until_one_of($$$$$$)
406 {
407     my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
408     return $self->__parse_c_until_one_of($characters, 0, $refcurrent, $refline, $refcolumn, $match);
409 }
410
411 sub _parse_c_on_same_level_until_one_of($$$$$$)
412 {
413     my ($self, $characters, $refcurrent, $refline, $refcolumn, $match) = @_;
414     return $self->__parse_c_until_one_of($characters, 1, $refcurrent, $refline, $refcolumn, $match);
415 }
416
417 ########################################################################
418 # parse_c_block
419
420 sub parse_c_block($$$$$$$) {
421     my $self = shift;
422
423     my $refcurrent = shift;
424     my $refline = shift;
425     my $refcolumn = shift;
426
427     my $refstatements = shift;
428     my $refstatements_line = shift;
429     my $refstatements_column = shift;
430
431     local $_ = $$refcurrent;
432     my $line = $$refline;
433     my $column = $$refcolumn;
434
435     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
436
437     my $statements;
438     if(s/^\{//) {
439         $column++;
440         $statements = "";
441     } else {
442         return 0;
443     }
444
445     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
446
447     my $statements_line = $line;
448     my $statements_column = $column;
449
450     my $plevel = 1;
451     while($plevel > 0) {
452         my $match;
453         $self->_parse_c_until_one_of("\\{\\}", \$_, \$line, \$column, \$match);
454
455         $column++;
456
457         $statements .= $match;
458         if(s/^\}//) {
459             $plevel--;
460             if($plevel > 0) {
461                 $statements .= "}";
462             }
463         } elsif(s/^\{//) {
464             $plevel++;
465             $statements .= "{";
466         } else {
467             return 0;
468         }
469     }
470
471     $$refcurrent = $_;
472     $$refline = $line;
473     $$refcolumn = $column;
474     $$refstatements = $statements;
475     $$refstatements_line = $statements_line;
476     $$refstatements_column = $statements_column;
477
478     return 1;
479 }
480
481 sub parse_c_declaration($$$$)
482 {
483     my ($self, $refcurrent, $refline, $refcolumn) = @_;
484
485     local $_ = $$refcurrent;
486     my $line = $$refline;
487     my $column = $$refcolumn;
488
489     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
490
491     my $begin_line = $line;
492     my $begin_column = $column + 1;
493
494     my $end_line = $begin_line;
495     my $end_column = $begin_column;
496     $self->_update_c_position($_, \$end_line, \$end_column);
497
498     if(!$self->{FOUND_DECLARATION}($begin_line, $begin_column, $end_line, $end_column, $_)) {
499         return 1;
500     }
501
502     # Function
503     my $function;
504
505     # Variable
506     my ($linkage, $type, $name);
507
508     if(s/^WINE_(?:DEFAULT|DECLARE)_DEBUG_CHANNEL\s*\(\s*(\w+)\s*\)\s*//s) { # FIXME: Wine specific kludge
509         $self->_update_c_position($&, \$line, \$column);
510     } elsif(s/^__ASM_GLOBAL_FUNC\(\s*(\w+)\s*,\s*//s) { # FIXME: Wine specific kludge
511         $self->_update_c_position($&, \$line, \$column);
512         $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
513         if(s/\)//) {
514             $column++;
515         }
516     } elsif(s/^__ASM_STDCALL_FUNC\(\s*(\w+)\s*,\s*\d+\s*,\s*//s) { # FIXME: Wine specific kludge
517         $self->_update_c_position($&, \$line, \$column);
518         $self->_parse_c_until_one_of("\)", \$_, \$line, \$column);
519         if(s/\)//) {
520             $column++;
521         }
522     } elsif(s/^(?:DEFINE_AVIGUID|DEFINE_OLEGUID)\s*(?=\()//s) { # FIXME: Wine specific kludge
523         $self->_update_c_position($&, \$line, \$column);
524
525         my @arguments;
526         my @argument_lines;
527         my @argument_columns;
528
529         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
530             return 0;
531         }
532     } elsif(s/^DEFINE_COMMON_NOTIFICATIONS\(\s*(\w+)\s*,\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
533         $self->_update_c_position($&, \$line, \$column);
534     } elsif(s/^MAKE_FUNCPTR\(\s*(\w+)\s*\)//s) { # FIXME: Wine specific kludge
535         $self->_update_c_position($&, \$line, \$column);
536     } elsif(s/^START_TEST\(\s*(\w+)\s*\)\s*{//s) { # FIXME: Wine specific kludge
537         $self->_update_c_position($&, \$line, \$column);
538     } elsif(s/^int\s*_FUNCTION_\s*{//s) { # FIXME: Wine specific kludge
539         $self->_update_c_position($&, \$line, \$column);
540     } elsif(s/^(?:jump|strong)_alias//s) { # FIXME: GNU C library specific kludge
541         $self->_update_c_position($&, \$line, \$column);
542     } elsif(s/^(?:__asm__|asm)\s*\(//) {
543         $self->_update_c_position($&, \$line, \$column);
544     } elsif($self->parse_c_typedef(\$_, \$line, \$column)) {
545         # Nothing
546     } elsif($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type, \$name)) {
547         # Nothing
548     } elsif($self->parse_c_function(\$_, \$line, \$column, \$function)) {
549         if($self->{FOUND_FUNCTION}($function))
550         {
551             my $statements = $function->statements;
552             my $statements_line = $function->statements_line;
553             my $statements_column = $function->statements_column;
554
555             if(defined($statements)) {
556                 if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
557                     return 0;
558                 }
559             }
560         }
561     } else {
562         $self->_parse_c_error($_, $line, $column, "declaration");
563     }
564
565     $$refcurrent = $_;
566     $$refline = $line;
567     $$refcolumn = $column;
568
569     return 1;
570 }
571
572 sub _parse_c($$$$$$)
573 {
574     my ($self, $pattern, $refcurrent, $refline, $refcolumn, $refmatch) = @_;
575
576     local $_ = $$refcurrent;
577     my $line = $$refline;
578     my $column = $$refcolumn;
579
580     my $match;
581     if(s/^(?:$pattern)//s) {
582         $self->_update_c_position($&, \$line, \$column);
583         $match = $&;
584     } else {
585         return 0;
586     }
587
588     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
589
590     $$refcurrent = $_;
591     $$refline = $line;
592     $$refcolumn = $column;
593
594     $$refmatch = $match;
595
596     return 1;
597 }
598
599 sub parse_c_enum($$$$)
600 {
601     my ($self, $refcurrent, $refline, $refcolumn) = @_;
602
603     local $_ = $$refcurrent;
604     my $line = $$refline;
605     my $column = $$refcolumn;
606
607     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
608
609     if (!s/^enum\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
610         return 0;
611     }
612     my $_name = $1 || "";
613
614     $self->_update_c_position($&, \$line, \$column);
615
616     my $name = "";
617     
618     my $match;
619     while ($self->_parse_c_on_same_level_until_one_of(',', \$_, \$line, \$column, \$match)) {
620         if ($match) {
621             if ($match !~ /^(\w+)\s*(?:=\s*(.*?)\s*)?$/) {
622                 $self->_parse_c_error($_, $line, $column, "enum");
623             }
624             my $enum_name = $1;
625             my $enum_value = $2 || "";
626
627             # $output->write("enum:$_name:$enum_name:$enum_value\n");
628         }
629
630         if ($self->_parse_c(',', \$_, \$line, \$column)) {
631             next;
632         } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
633             # FIXME: Kludge
634             my $tuple = "($_)";
635             my $tuple_line = $line;
636             my $tuple_column = $column - 1;
637             
638             my @arguments;
639             my @argument_lines;
640                     my @argument_columns;
641             
642             if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
643                                      \@arguments, \@argument_lines, \@argument_columns)) 
644             {
645                 $self->_parse_c_error($_, $line, $column, "enum");
646             }
647             
648             # FIXME: Kludge
649             if ($#arguments >= 0) {
650                 $name = $arguments[0];
651             }
652             
653             last;
654         } else {
655             $self->_parse_c_error($_, $line, $column, "enum");
656         }
657     }
658
659     $self->_update_c_position($_, \$line, \$column);
660
661     $$refcurrent = $_;
662     $$refline = $line;
663     $$refcolumn = $column;
664 }
665
666 sub parse_c_expression($$$$)
667 {
668     my ($self, $refcurrent, $refline, $refcolumn) = @_;
669
670     local $_ = $$refcurrent;
671     my $line = $$refline;
672     my $column = $$refcolumn;
673
674     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
675
676     while($_) {
677         if(s/^(.*?)(\w+\s*\()/$2/s) {
678             $self->_update_c_position($1, \$line, \$column);
679
680             my $begin_line = $line;
681             my $begin_column = $column + 1;
682
683             my $name;
684             my @arguments;
685             my @argument_lines;
686             my @argument_columns;
687             if(!$self->parse_c_function_call(\$_, \$line, \$column, \$name, \@arguments, \@argument_lines, \@argument_columns)) {
688                 return 0;
689             }
690
691             if($self->{FOUND_FUNCTION_CALL}($begin_line, $begin_column, $line, $column, $name, \@arguments))
692             {
693                 while(defined(my $argument = shift @arguments) &&
694                       defined(my $argument_line = shift @argument_lines) &&
695                       defined(my $argument_column = shift @argument_columns))
696                 {
697                     $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
698                 }
699             }
700         } else {
701             $_ = "";
702         }
703     }
704
705     $self->_update_c_position($_, \$line, \$column);
706
707     $$refcurrent = $_;
708     $$refline = $line;
709     $$refcolumn = $column;
710
711     return 1;
712 }
713
714 sub parse_c_file($$$$)
715 {
716     my ($self, $refcurrent, $refline, $refcolumn) = @_;
717
718     local $_ = $$refcurrent;
719     my $line = $$refline;
720     my $column = $$refcolumn;
721
722     my $declaration = "";
723     my $declaration_line = $line;
724     my $declaration_column = $column;
725
726     my $previous_line = 0;
727     my $previous_column = -1;
728
729     my $preprocessor_condition = "";
730     my $if = 0;
731     my $if0 = 0;
732     my $extern_c = 0;
733
734     my $blevel = 1;
735     my $plevel = 1;
736     while($plevel > 0 || $blevel > 0) {
737         my $match;
738         $self->_parse_c_until_one_of("#/\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
739
740         if($line != $previous_line) {
741             $self->{FOUND_LINE}($line);
742         } else {
743             # $self->{FOUND_LINE}("$line.$column");
744         }
745         $previous_line = $line;
746         $previous_column = $column;
747
748         if($match !~ /^\s+$/s && $options->debug) {
749             $self->_parse_c_warning($_, $line, $column, "file", "$plevel $blevel: '$declaration' '$match'");
750         }
751
752         if(!$declaration && $match =~ s/^\s+//s) {
753             $self->_update_c_position($&, \$declaration_line, \$declaration_column);
754         }
755
756         if(!$if0) {
757             $declaration .= $match;
758
759             # FIXME: Kludge
760             if ($declaration =~ s/^extern\s*\"C\"//s) {
761                 if (s/^\{//) {
762                     $self->_update_c_position($&, \$line, \$column);
763                     $declaration = "";
764                     $declaration_line = $line;
765                     $declaration_column = $column;
766
767                     $extern_c = 1;
768                     next;
769                 }
770             } elsif ($extern_c && $blevel == 1 && $plevel == 1 && !$declaration) {
771                 if (s/^\}//) {
772                     $self->_update_c_position($&, \$line, \$column);
773                     $declaration = "";
774                     $declaration_line = $line;
775                     $declaration_column = $column;
776                     
777                     $extern_c = 0;
778                     next;
779                 }
780             } elsif($declaration =~ s/^(?:__DEFINE_(?:GET|SET)_SEG|OUR_GUID_ENTRY)\s*(?=\()//sx) { # FIXME: Wine specific kludge
781                 my $prefix = $&;
782                 if ($plevel > 2 || !s/^\)//) {
783                     $declaration = "$prefix$declaration";
784                 } else {
785                     $plevel--;
786                     $self->_update_c_position($&, \$line, \$column);
787                     $declaration .= $&;
788
789                     my @arguments;
790                     my @argument_lines;
791                     my @argument_columns;
792
793                     if(!$self->parse_c_tuple(\$declaration, \$declaration_line, \$declaration_column,
794                                              \@arguments, \@argument_lines, \@argument_columns)) 
795                     {
796                         $self->_parse_c_error($declaration, $declaration_line, $declaration_column, "file", "tuple expected");
797                     }
798
799                     $declaration = "";
800                     $declaration_line = $line;
801                     $declaration_column = $column;
802                     
803                     next;
804                 }
805             } elsif ($declaration =~ s/^(?:DECL_WINELIB_TYPE_AW|DECLARE_HANDLE(?:16)?|TYPE_MARSHAL)\(\s*(\w+)\s*\)\s*//s) {
806                 $self->_update_c_position($&, \$declaration_line, \$declaration_column);
807             }
808         } else {
809             my $blank_lines = 0;
810
811             local $_ = $match;
812             while(s/^.*?\n//) { $blank_lines++; }
813
814             if(!$declaration) {
815                 $declaration_line = $line;
816                 $declaration_column = $column;
817             } else {
818                 $declaration .= "\n" x $blank_lines;
819             }
820
821         }
822
823         if(/^[\#\/]/) {
824             my $blank_lines = 0;
825             if(s/^\#\s*//) {
826                 my $preprocessor_line = $line;
827                 my $preprocessor_column = $column;
828
829                 my $preprocessor = $&;
830                 while(s/^(.*?)\\\s*\n//) {
831                     $blank_lines++;
832                     $preprocessor .= "$1\n";
833                 }
834                 if(s/^(.*?)(\/\*.*?\*\/)(.*?)\n//) {
835                     $_ = "$2\n$_";
836                     if(defined($3)) {
837                         $preprocessor .= "$1$3";
838                     } else {
839                         $preprocessor .= $1;
840                     }
841                 } elsif(s/^(.*?)(\/[\*\/].*?)?\n//) {
842                     if(defined($2)) {
843                         $_ = "$2\n$_";
844                     } else {
845                         $blank_lines++;
846                     }
847                     $preprocessor .= $1;
848                 }
849
850
851                 if($preprocessor =~ /^\#\s*if/) {
852                     if($preprocessor =~ /^\#\s*if\s*0/) {
853                         $if0++;
854                     } elsif($if0 > 0) {
855                         $if++;
856                     } else {
857                         if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
858                             $preprocessor_condition = "defined(WORD_BIGENDIAN)";
859                             # $output->write("'$preprocessor_condition':'$declaration'\n")
860                         } else {
861                             $preprocessor_condition = "";
862                         }
863                     }
864                 } elsif($preprocessor =~ /^\#\s*else/) {
865                     if ($preprocessor_condition ne "") {
866                         $preprocessor_condition =~ "!$preprocessor_condition";
867                         $preprocessor_condition =~ s/^!!/!/;
868                         # $output->write("'$preprocessor_condition':'$declaration'\n")
869                     }
870                 } elsif($preprocessor =~ /^\#\s*endif/) {
871                     if($if0 > 0) {
872                         if($if > 0) {
873                             $if--;
874                         } else {
875                             $if0--;
876                         }
877                     } else {
878                         if ($preprocessor_condition ne "") {
879                             # $output->write("'$preprocessor_condition':'$declaration'\n");
880                             $preprocessor_condition = "";
881                         }
882                     }
883                 }
884
885                 if(!$self->parse_c_preprocessor(\$preprocessor, \$preprocessor_line, \$preprocessor_column)) {
886                      return 0;
887                 }
888             }
889
890             if(s/^\/\*.*?\*\///s) {
891                 $self->{FOUND_COMMENT}($line, $column + 1, $&);
892                 local $_ = $&;
893                 while(s/^.*?\n//) {
894                     $blank_lines++;
895                 }
896                 if($_) {
897                     $column += length($_);
898                 }
899             } elsif(s/^\/\/(.*?)\n//) {
900                 $self->{FOUND_COMMENT}($line, $column + 1, $&);
901                 $blank_lines++;
902             } elsif(s/^\///) {
903                 if(!$if0) {
904                     $declaration .= $&;
905                     $column++;
906                 }
907             }
908
909             $line += $blank_lines;
910             if($blank_lines > 0) {
911                 $column = 0;
912             }
913
914             if(!$declaration) {
915                 $declaration_line = $line;
916                 $declaration_column = $column;
917             } elsif($blank_lines > 0) {
918                 $declaration .= "\n" x $blank_lines;
919             }
920
921             next;
922         }
923
924         $column++;
925
926         if($if0) {
927             s/^.//;
928             next;
929         }
930
931         if(s/^[\(\[]//) {
932             $plevel++;
933             $declaration .= $&;
934         } elsif(s/^\]//) {
935             $plevel--;
936             $declaration .= $&;
937         } elsif(s/^\)//) {
938             $plevel--;
939             if($plevel <= 0) {
940                 $self->_parse_c_error($_, $line, $column, "file", ") without (");
941             }
942             $declaration .= $&;
943             if($plevel == 1 && $declaration =~ /^(__ASM_GLOBAL_FUNC|__ASM_STDCALL_FUNC)/) {
944                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
945                     return 0;
946                 }
947                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
948                 $declaration = "";
949                 $declaration_line = $line;
950                 $declaration_column = $column;
951             }
952         } elsif(s/^\{//) {
953             $blevel++;
954             $declaration .= $&;
955         } elsif(s/^\}//) {
956             $blevel--;
957             if($blevel <= 0) {
958                 $self->_parse_c_error($_, $line, $column, "file", "} without {");
959             }
960
961             $declaration .= $&;
962
963             if($declaration =~ /^typedef/s ||
964                $declaration =~ /^(?:const\s+|extern\s+|static\s+|volatile\s+)*(?:interface|struct|union)(?:\s+\w+)?\s*\{/s)
965             {
966                 # Nothing
967             } elsif($plevel == 1 && $blevel == 1) {
968                 if(!$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
969                     return 0;
970                 }
971                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
972                 $declaration = "";
973                 $declaration_line = $line;
974                 $declaration_column = $column;
975             } elsif($column == 1 && !$extern_c) {
976                 $self->_parse_c_warning("", $line, $column, "file", "inner } ends on column 1");
977             }
978         } elsif(s/^;//) {
979             $declaration .= $&;
980             if($plevel == 1 && $blevel == 1) {
981                 $declaration =~ s/\s*;$//;
982                 if($declaration && !$self->parse_c_declaration(\$declaration, \$declaration_line, \$declaration_column)) {
983                     return 0;
984                 }
985                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
986                 $declaration = "";
987                 $declaration_line = $line;
988                 $declaration_column = $column;
989             }
990         } elsif(/^\s*$/ && $declaration =~ /^\s*$/ && $match =~ /^\s*$/) {
991             $plevel = 0;
992             $blevel = 0;
993         } else {
994             $self->_parse_c_error($_, $line, $column, "file", "parse error: '$declaration' '$match'");
995         }
996     }
997
998     $$refcurrent = $_;
999     $$refline = $line;
1000     $$refcolumn = $column;
1001
1002     return 1;
1003 }
1004
1005 sub parse_c_function($$$$$)
1006 {
1007     my ($self, $refcurrent, $refline, $refcolumn, $reffunction) = @_;
1008
1009     local $_ = $$refcurrent;
1010     my $line = $$refline;
1011     my $column = $$refcolumn;
1012
1013     my $linkage = "";
1014     my $calling_convention = "";
1015     my $return_type;
1016     my $name;
1017     my @arguments;
1018     my @argument_lines;
1019     my @argument_columns;
1020     my $statements;
1021     my $statements_line;
1022     my $statements_column;
1023
1024     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1025
1026     my $begin_line = $line;
1027     my $begin_column = $column + 1;
1028
1029     if($self->_parse_c('__declspec\((?:dllexport|dllimport|naked)\)|INTERNETAPI|RPCRTAPI', \$_, \$line, \$column)) {
1030         # Nothing
1031     }
1032
1033     # $self->_parse_c_warning($_, $line, $column, "function", "");
1034
1035     my $match;
1036     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1037                           'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1038                           'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1039                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1040                           \$_, \$line, \$column, \$match))
1041     {
1042         if($match =~ /^(?:extern|static)$/) {
1043             if(!$linkage) {
1044                 $linkage = $match;
1045             }
1046         }
1047     }
1048
1049     if($self->_parse_c('DECL_GLOBAL_CONSTRUCTOR', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1050         # Nothing
1051     } elsif($self->_parse_c('WINE_EXCEPTION_FILTER\(\w+\)', \$_, \$line, \$column, \$name)) { # FIXME: Wine specific kludge
1052         # Nothing
1053     } else {
1054         if(!$self->parse_c_type(\$_, \$line, \$column, \$return_type)) {
1055             return 0;
1056         }
1057
1058         $self->_parse_c('inline|FAR', \$_, \$line, \$column);
1059
1060         $self->_parse_c($CALL_CONVENTION,
1061                         \$_, \$line, \$column, \$calling_convention);
1062
1063
1064         # FIXME: ???: Old variant of __attribute((const))
1065         $self->_parse_c('(?:const|volatile)', \$_, \$line, \$column);
1066
1067         if(!$self->_parse_c('(?:operator\s*!=|(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)', \$_, \$line, \$column, \$name)) {
1068             return 0;
1069         }
1070
1071         my $p = 0;
1072         if(s/^__P\s*\(//) {
1073             $self->_update_c_position($&, \$line, \$column);
1074             $p = 1;
1075         }
1076
1077         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1078             return 0;
1079         }
1080
1081         if($p) {
1082             if (s/^\)//) {
1083                 $self->_update_c_position($&, \$line, \$column);
1084             } else {
1085                 $self->_parse_c_error($_, $line, $column, "function");
1086             }
1087         }
1088     }
1089
1090
1091     if($self->_parse_c('__attribute__\s*\(\s*\(\s*(?:constructor|destructor)\s*\)\s*\)', \$_, \$line, \$column)) {
1092         # Nothing
1093     }
1094
1095     my $kar;
1096     # FIXME: Implement proper handling of K&R C functions
1097     $self->_parse_c_until_one_of("{", \$_, \$line, \$column, $kar);
1098
1099     if($kar) {
1100         $output->write("K&R: $kar\n");
1101     }
1102
1103     if($_ && !$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1104         return 0;
1105     }
1106
1107     my $end_line = $line;
1108     my $end_column = $column;
1109
1110     $$refcurrent = $_;
1111     $$refline = $line;
1112     $$refcolumn = $column;
1113
1114     my $function = $self->{CREATE_FUNCTION}();
1115
1116     $function->file($self->{FILE});
1117     $function->begin_line($begin_line);
1118     $function->begin_column($begin_column);
1119     $function->end_line($end_line);
1120     $function->end_column($end_column);
1121     $function->linkage($linkage);
1122     $function->return_type($return_type);
1123     $function->calling_convention($calling_convention);
1124     $function->name($name);
1125     # if(defined($argument_types)) {
1126     #     $function->argument_types([@$argument_types]);
1127     # }
1128     # if(defined($argument_names)) {
1129     #     $function->argument_names([@$argument_names]);
1130     # }
1131     $function->statements_line($statements_line);
1132     $function->statements_column($statements_column);
1133     $function->statements($statements);
1134
1135     $$reffunction = $function;
1136
1137     return 1;
1138 }
1139
1140 sub parse_c_function_call($$$$$$$$)
1141 {
1142     my ($self, $refcurrent, $refline, $refcolumn, $refname, $refarguments, $refargument_lines, $refargument_columns) = @_;
1143
1144     local $_ = $$refcurrent;
1145     my $line = $$refline;
1146     my $column = $$refcolumn;
1147
1148     my $name;
1149     my @arguments;
1150     my @argument_lines;
1151     my @argument_columns;
1152
1153     if(s/^(\w+)(\s*)(?=\()//s) {
1154         $self->_update_c_position($&, \$line, \$column);
1155
1156         $name = $1;
1157
1158         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1159             return 0;
1160         }
1161     } else {
1162         return 0;
1163     }
1164
1165     $$refcurrent = $_;
1166     $$refline = $line;
1167     $$refcolumn = $column;
1168
1169     $$refname = $name;
1170     @$refarguments = @arguments;
1171     @$refargument_lines = @argument_lines;
1172     @$refargument_columns = @argument_columns;
1173
1174     return 1;
1175 }
1176
1177
1178 sub parse_c_preprocessor($$$$)
1179 {
1180     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1181
1182     local $_ = $$refcurrent;
1183     my $line = $$refline;
1184     my $column = $$refcolumn;
1185
1186     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1187
1188     my $begin_line = $line;
1189     my $begin_column = $column + 1;
1190
1191     if(!$self->{FOUND_PREPROCESSOR}($begin_line, $begin_column, "$_")) {
1192         return 1;
1193     }
1194
1195     if(/^\#\s*define\s*(.*?)$/s) {
1196         $self->_update_c_position($_, \$line, \$column);
1197     } elsif(/^\#\s*else/s) {
1198         $self->_update_c_position($_, \$line, \$column);
1199     } elsif(/^\#\s*endif/s) {
1200         $self->_update_c_position($_, \$line, \$column);
1201     } elsif(/^\#\s*(?:if|ifdef|ifndef)?\s*(.*?)$/s) {
1202         $self->_update_c_position($_, \$line, \$column);
1203     } elsif(/^\#\s*include\s+(.*?)$/s) {
1204         $self->_update_c_position($_, \$line, \$column);
1205     } elsif(/^\#\s*undef\s+(.*?)$/s) {
1206         $self->_update_c_position($_, \$line, \$column);
1207     } else {
1208         $self->_parse_c_error($_, $line, $column, "preprocessor");
1209     }
1210
1211     $$refcurrent = $_;
1212     $$refline = $line;
1213     $$refcolumn = $column;
1214
1215     return 1;
1216 }
1217
1218 sub parse_c_statement($$$$)
1219 {
1220     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1221
1222     local $_ = $$refcurrent;
1223     my $line = $$refline;
1224     my $column = $$refcolumn;
1225
1226     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1227
1228     $self->_parse_c('(?:case\s+)?(\w+)\s*:\s*', \$_, \$line, \$column);
1229
1230     # $output->write("$line.$column: statement: '$_'\n");
1231
1232     if(/^$/) {
1233         # Nothing
1234     } elsif(/^\{/) {
1235         my $statements;
1236         my $statements_line;
1237         my $statements_column;
1238         if(!$self->parse_c_block(\$_, \$line, \$column, \$statements, \$statements_line, \$statements_column)) {
1239             return 0;
1240         }
1241         if(!$self->parse_c_statements(\$statements, \$statements_line, \$statements_column)) {
1242             return 0;
1243         }
1244     } elsif(s/^(for|if|switch|while)\s*(?=\()//) {
1245         $self->_update_c_position($&, \$line, \$column);
1246
1247         my $name = $1;
1248
1249         my @arguments;
1250         my @argument_lines;
1251         my @argument_columns;
1252         if(!$self->parse_c_tuple(\$_, \$line, \$column, \@arguments, \@argument_lines, \@argument_columns)) {
1253             return 0;
1254         }
1255
1256         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1257         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1258             return 0;
1259         }
1260         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1261
1262         while(defined(my $argument = shift @arguments) &&
1263               defined(my $argument_line = shift @argument_lines) &&
1264               defined(my $argument_column = shift @argument_columns))
1265         {
1266             $self->parse_c_expression(\$argument, \$argument_line, \$argument_column);
1267         }
1268     } elsif(s/^else//) {
1269         $self->_update_c_position($&, \$line, \$column);
1270         if(!$self->parse_c_statement(\$_, \$line, \$column)) {
1271             return 0;
1272         }
1273     } elsif(s/^return//) {
1274         $self->_update_c_position($&, \$line, \$column);
1275         $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1276         if(!$self->parse_c_expression(\$_, \$line, \$column)) {
1277             return 0;
1278         }
1279     } elsif($self->parse_c_expression(\$_, \$line, \$column)) {
1280         # Nothing
1281     } else {
1282         # $self->_parse_c_error($_, $line, $column, "statement");
1283     }
1284
1285     $self->_update_c_position($_, \$line, \$column);
1286
1287     $$refcurrent = $_;
1288     $$refline = $line;
1289     $$refcolumn = $column;
1290
1291     return 1;
1292 }
1293
1294 sub parse_c_statements($$$$)
1295 {
1296     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1297
1298     local $_ = $$refcurrent;
1299     my $line = $$refline;
1300     my $column = $$refcolumn;
1301
1302     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1303
1304     # $output->write("$line.$column: statements: '$_'\n");
1305
1306     my $statement = "";
1307     my $statement_line = $line;
1308     my $statement_column = $column;
1309
1310     my $previous_line = -1;
1311     my $previous_column = -1;
1312
1313     my $blevel = 1;
1314     my $plevel = 1;
1315     while($plevel > 0 || $blevel > 0) {
1316         my $match;
1317         $self->_parse_c_until_one_of("\\(\\)\\[\\]\\{\\};", \$_, \$line, \$column, \$match);
1318
1319         if($previous_line == $line && $previous_column == $column) {
1320             $self->_parse_c_error($_, $line, $column, "statements", "no progress");
1321         }
1322         $previous_line = $line;
1323         $previous_column = $column;
1324
1325         # $output->write("'$match' '$_'\n");
1326
1327         $statement .= $match;
1328         $column++;
1329         if(s/^[\(\[]//) {
1330             $plevel++;
1331             $statement .= $&;
1332         } elsif(s/^[\)\]]//) {
1333             $plevel--;
1334             if($plevel <= 0) {
1335                 $self->_parse_c_error($_, $line, $column, "statements");
1336             }
1337             $statement .= $&;
1338         } elsif(s/^\{//) {
1339             $blevel++;
1340             $statement .= $&;
1341         } elsif(s/^\}//) {
1342             $blevel--;
1343             $statement .= $&;
1344             if($blevel == 1) {
1345                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1346                     return 0;
1347                 }
1348                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1349                 $statement = "";
1350                 $statement_line = $line;
1351                 $statement_column = $column;
1352             }
1353         } elsif(s/^;//) {
1354             if($plevel == 1 && $blevel == 1) {
1355                 if(!$self->parse_c_statement(\$statement, \$statement_line, \$statement_column)) {
1356                     return 0;
1357                 }
1358
1359                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1360                 $statement = "";
1361                 $statement_line = $line;
1362                 $statement_column = $column;
1363             } else {
1364                 $statement .= $&;
1365             }
1366         } elsif(/^\s*$/ && $statement =~ /^\s*$/ && $match =~ /^\s*$/) {
1367             $plevel = 0;
1368             $blevel = 0;
1369         } else {
1370             $self->_parse_c_error($_, $line, $column, "statements");
1371         }
1372     }
1373
1374     $self->_update_c_position($_, \$line, \$column);
1375
1376     $$refcurrent = $_;
1377     $$refline = $line;
1378     $$refcolumn = $column;
1379
1380     return 1;
1381 }
1382
1383 sub parse_c_struct_union($$$$$$$$$)
1384 {
1385     my ($self, $refcurrent, $refline, $refcolumn, $refkind, $ref_name, $reffield_type_names, $reffield_names, $refnames) = @_;
1386
1387     local $_ = $$refcurrent;
1388     my $line = $$refline;
1389     my $column = $$refcolumn;
1390
1391     my $kind;
1392     my $_name;
1393     my @field_type_names = ();
1394     my @field_names = ();
1395     my @names = ();
1396
1397     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1398
1399     if (!s/^(interface|struct|union)(\s+((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+))?\s*\{\s*//s) {
1400         return 0;
1401     }
1402     $kind = $1;
1403     $_name = $3 || "";
1404
1405     $self->_update_c_position($&, \$line, \$column);
1406
1407     my $match;
1408     while ($_ && $self->_parse_c_on_same_level_until_one_of(';', \$_, \$line, \$column, \$match))
1409     {
1410         my $field_linkage;
1411         my $field_type_name;
1412         my $field_name;
1413         
1414         if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type_name, \$field_name)) {
1415             $field_type_name =~ s/\s+/ /g;
1416             
1417             push @field_type_names, $field_type_name;
1418             push @field_names, $field_name;
1419             # $output->write("$kind:$_name:$field_type_name:$field_name\n");
1420         } elsif ($match) {
1421             $self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
1422         }
1423         
1424         if ($self->_parse_c(';', \$_, \$line, \$column)) {
1425             next;
1426         } elsif ($self->_parse_c('}', \$_, \$line, \$column)) {
1427             # FIXME: Kludge
1428             my $tuple = "($_)";
1429             my $tuple_line = $line;
1430             my $tuple_column = $column - 1;
1431             
1432             my @arguments;
1433             my @argument_lines;
1434             my @argument_columns;
1435             
1436             if(!$self->parse_c_tuple(\$tuple, \$tuple_line, \$tuple_column,
1437                                      \@arguments, \@argument_lines, \@argument_columns)) 
1438             {
1439                 $self->_parse_c_error($_, $line, $column, "$kind");
1440             }
1441
1442             foreach my $argument (@arguments) {
1443                 my $name = $argument;
1444
1445                 push @names, $name;
1446             }
1447
1448             last;
1449         } else {
1450             $self->_parse_c_error($_, $line, $column, "$kind");
1451         }
1452     }
1453
1454     $$refcurrent = $_;
1455     $$refline = $line;
1456     $$refcolumn = $column;
1457
1458     $$refkind = $kind;
1459     $$ref_name = $_name;
1460     @$reffield_type_names = @field_type_names;
1461     @$reffield_names = @field_names;
1462     @$refnames = @names;
1463
1464     return 1;
1465 }
1466
1467 sub parse_c_tuple($$$$$$$)
1468 {
1469     my ($self, $refcurrent, $refline, $refcolumn,
1470         # FIXME: Should not write directly
1471         $items, $item_lines, $item_columns) = @_;
1472
1473     local $_ = $$refcurrent;
1474
1475     my $line = $$refline;
1476     my $column = $$refcolumn;
1477
1478     my $item;
1479     if(s/^\(//) {
1480         $column++;
1481         $item = "";
1482     } else {
1483         return 0;
1484     }
1485
1486     my $item_line = $line;
1487     my $item_column = $column + 1;
1488
1489     my $plevel = 1;
1490     while($plevel > 0) {
1491         my $match;
1492         $self->_parse_c_until_one_of("\\(,\\)", \$_, \$line, \$column, \$match);
1493
1494         $column++;
1495
1496         $item .= $match;
1497         if(s/^\)//) {
1498             $plevel--;
1499             if($plevel == 0) {
1500                 push @$item_lines, $item_line;
1501                 push @$item_columns, $item_column;
1502                 push @$items, $item;
1503                 $item = "";
1504             } else {
1505                 $item .= ")";
1506             }
1507         } elsif(s/^\(//) {
1508             $plevel++;
1509             $item .= "(";
1510         } elsif(s/^,//) {
1511             if($plevel == 1) {
1512                 push @$item_lines, $item_line;
1513                 push @$item_columns, $item_column;
1514                 push @$items, $item;
1515                 $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1516                 $item_line = $line;
1517                 $item_column = $column + 1;
1518                 $item = "";
1519             } else {
1520                 $item .= ",";
1521             }
1522         } else {
1523             return 0;
1524         }
1525     }
1526
1527     $$refcurrent = $_;
1528     $$refline = $line;
1529     $$refcolumn = $column;
1530
1531     return 1;
1532 }
1533
1534 sub parse_c_type($$$$$)
1535 {
1536     my ($self, $refcurrent, $refline, $refcolumn, $reftype) = @_;
1537
1538     local $_ = $$refcurrent;
1539     my $line = $$refline;
1540     my $column = $$refcolumn;
1541
1542     my $type;
1543
1544     $self->_parse_c("(?:const|volatile)", \$_, \$line, \$column);
1545
1546     if($self->_parse_c('ICOM_VTABLE\(.*?\)', \$_, \$line, \$column, \$type)) {
1547         # Nothing
1548     } elsif($self->_parse_c('(?:enum\s+|interface\s+|struct\s+|union\s+)?(?:(?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)\s*(\*\s*)*',
1549                             \$_, \$line, \$column, \$type))
1550     {
1551         # Nothing
1552     } else {
1553         return 0;
1554     }
1555     $type =~ s/\s//g;
1556
1557     $$refcurrent = $_;
1558     $$refline = $line;
1559     $$refcolumn = $column;
1560
1561     $$reftype = $type;
1562
1563     return 1;
1564 }
1565
1566 sub parse_c_typedef($$$$)
1567 {
1568     my ($self, $refcurrent, $refline, $refcolumn) = @_;
1569
1570     local $_ = $$refcurrent;
1571     my $line = $$refline;
1572     my $column = $$refcolumn;
1573
1574     if (!$self->_parse_c("typedef", \$_, \$line, \$column)) {
1575         return 0;
1576     }
1577
1578     my ($kind, $name, @field_type_names, @field_names, @names);
1579     my ($linkage, $type_name);
1580     if ($self->parse_c_enum(\$_, \$line, \$column))
1581 {
1582         # Nothing to do
1583     }
1584     elsif ($self->parse_c_struct_union(\$_, \$line, \$column,
1585                                          \$kind, \$name, \@field_type_names, \@field_names, \@names))
1586     {
1587         my $base_name;
1588         foreach my $_name (@names)
1589         {
1590             if ($_name =~ /^\w+$/)
1591             {
1592                 $base_name = $_name;
1593                 last;
1594             }
1595         }
1596         $base_name="$kind $name" if (!defined $base_name and defined $name);
1597         $base_name=$kind if (!defined $base_name);
1598         foreach my $_name (@names) {
1599             if ($_name =~ /^\w+$/) {
1600                 my $type = $self->{CREATE_TYPE}();
1601                 
1602                 $type->kind($kind);
1603                 $type->_name($name);
1604                 $type->name($_name);
1605                 $type->field_type_names([@field_type_names]);
1606                 $type->field_names([@field_names]);
1607
1608                 $self->{FOUND_TYPE}($type);
1609             } elsif ($_name =~ /^(\*+)\s*(?:RESTRICTED_POINTER\s+)?(\w+)$/) {
1610                 my $type_name = "$base_name $1";
1611                 $_name = $2;
1612
1613                 my $type = $self->{CREATE_TYPE}();
1614
1615                 $type->kind("");
1616                 $type->name($_name);
1617                 $type->field_type_names([$type_name]);
1618                 $type->field_names([""]);
1619
1620                 $self->{FOUND_TYPE}($type);
1621             } else {
1622                 $self->_parse_c_error($_, $line, $column, "typedef 2");
1623             }
1624         }
1625     }
1626     elsif ($self->parse_c_variable(\$_, \$line, \$column, \$linkage, \$type_name, \$name))
1627     {
1628         $type_name =~ s/\s+/ /g;
1629         
1630         if(defined($type_name) && defined($name)) {
1631             my $type = $self->{CREATE_TYPE}();
1632             
1633             if (length($name) == 0) {
1634                 $self->_parse_c_error($_, $line, $column, "typedef");
1635             }
1636
1637             $type->kind("");
1638             $type->name($name);
1639             $type->field_type_names([$type_name]);
1640             $type->field_names([""]);
1641             
1642             $self->{FOUND_TYPE}($type);
1643         }
1644     } else {
1645         $self->_parse_c_error($_, $line, $column, "typedef");
1646     }
1647
1648     $$refcurrent = $_;
1649     $$refline = $line;
1650     $$refcolumn = $column;
1651
1652     return 1;
1653 }
1654
1655 sub parse_c_variable($$$$$$$)
1656 {
1657     my ($self, $refcurrent, $refline, $refcolumn, $reflinkage, $reftype, $refname) = @_;
1658
1659     local $_ = $$refcurrent;
1660     my $line = $$refline;
1661     my $column = $$refcolumn;
1662
1663     $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1664
1665     my $begin_line = $line;
1666     my $begin_column = $column + 1;
1667
1668     my $linkage = "";
1669     my $sign = "";
1670     my $type = "";
1671     my $name = "";
1672
1673     # $self->_parse_c_warning($_, $line, $column, "variable");
1674
1675     my $match;
1676     while($self->_parse_c('(?:const|inline|extern(?:\s+\"C\")?|EXTERN_C|static|volatile|' .
1677                           'signed(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1678                           'unsigned(?=\s+__int(?:8|16|32|64)\b|\s+char\b|\s+int\b|\s+long(?:\s+long)?\b|\s+short\b)|' .
1679                           'long(?=\s+double\b|\s+int\b|\s+long\b))(?=\b)',
1680                           \$_, \$line, \$column, \$match))
1681     {
1682         if ($match =~ /^(?:extern|static)$/) {
1683             if (!$linkage) {
1684                 $linkage = $match;
1685             } else {
1686                 $self->_parse_c_warning($_, $line, $column, "repeated linkage (ignored): $match");
1687             }
1688         } elsif ($match =~ /^(?:signed|unsigned)$/) {
1689             if (!$sign) {
1690                 $sign = "$match ";
1691             } else {
1692                 $self->_parse_c_warning($_, $line, $column, "repeated sign (ignored): $match");
1693             }
1694         }
1695     }
1696
1697     return 0 if(/^$/);
1698
1699   finished: while (1)
1700     {
1701         if (s/^(enum\s+|interface\s+|struct\s+|union\s+)((?:MSVCRT|WS)\(\s*\w+\s*\)|\w+)?\s*\{\s*//s) {
1702             my $kind = $1;
1703             my $_name = $2;
1704             $self->_update_c_position($&, \$line, \$column);
1705
1706             if(defined($_name)) {
1707                 $type = "$kind $_name { }";
1708             } else {
1709                 $type = "$kind { }";
1710             }
1711
1712             last finished;
1713         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s+DECLSPEC_ALIGN\(.*?\)|\s*(?:const\s*|volatile\s*)?\*)*)\s*(\w+)\s*(\[.*?\]$|:\s*(\d+)$|\{)?//s) {
1714             $type = "$sign$1";
1715             $name = $2;
1716
1717             if (defined($3)) {
1718                 my $bits = $4;
1719                 local $_ = $3;
1720                 if (/^\[/) {
1721                     $type .= $_;
1722                 } elsif (/^:/) {
1723                     $type .= ":$bits";
1724                 } elsif (/^\{/) {
1725                     # Nothing
1726                 }
1727             }
1728
1729             $type = $self->_format_c_type($type);
1730
1731             last finished;
1732         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*)\s*:\s*(\d+)$//s) {
1733             $type = "$sign$1:$2";
1734             $name = "";
1735             $type = $self->_format_c_type($type);
1736
1737             last finished;
1738         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+\b(?:\s*\*)*\s*\(\s*(?:$CALL_CONVENTION)?(?:\s*\*)*)\s*(\w+)\s*(\)\s*\(.*?\))$//s) {
1739             $type = $self->_format_c_type("$sign$1$3");
1740             $name = $2;
1741
1742             last finished;
1743         } elsif($self->_parse_c('DEFINE_GUID', \$_, \$line, \$column, \$match)) { # Windows specific
1744             $type = $match;
1745             last finished;
1746         } else {
1747             $self->_parse_c_warning($_, $line, $column, "variable", "'$_'");
1748             last finished;
1749         }
1750
1751         if($self->_parse_c('SEQ_DEFINEBUF', \$_, \$line, \$column, \$match)) { # Linux specific
1752             $type = $match;
1753             last finished;
1754         } elsif($self->_parse_c('DEFINE_REGS_ENTRYPOINT_\w+|DPQ_DECL_\w+|HANDLER_DEF|IX86_ONLY', # Wine specific
1755                                 \$_, \$line, \$column, \$match))
1756         {
1757             $type = $match;
1758             last finished;
1759         } elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
1760             $type = $match;
1761             last finished;
1762         } elsif(s/^(enum|interface|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
1763             my $kind = $1;
1764             my $_name = $2;
1765             $self->_update_c_position($&, \$line, \$column);
1766
1767             if(defined($_name)) {
1768                 $type = "struct $_name { }";
1769             } else {
1770                 $type = "struct { }";
1771             }
1772         } elsif(s/^((?:enum\s+|interface\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
1773             $type = $&;
1774             $type =~ s/\s//g;
1775         } else {
1776             return 0;
1777         }
1778
1779         # $output->write("*** $type: '$_'\n");
1780
1781         # $self->_parse_c_warning($_, $line, $column, "variable2", "");
1782
1783         if(s/^WINAPI\s*//) {
1784             $self->_update_c_position($&, \$line, \$column);
1785         }
1786
1787         if(s/^(\((?:$CALL_CONVENTION)?\s*\*?\s*(?:$CALL_CONVENTION)?\w+\s*(?:\[[^\]]*\]\s*)*\))\s*\(//) {
1788             $self->_update_c_position($&, \$line, \$column);
1789
1790             $name = $1;
1791             $name =~ s/\s//g;
1792
1793             $self->_parse_c_until_one_of("\\)", \$_, \$line, \$column);
1794             if(s/^\)//) { $column++; }
1795             $self->_parse_c_until_one_of("\\S", \$_, \$line, \$column);
1796
1797             if(!s/^(?:=\s*|,\s*|$)//) {
1798                 return 0;
1799             }
1800         } elsif(s/^(?:\*\s*)*(?:const\s+|volatile\s+)?(\w+)\s*(?:\[[^\]]*\]\s*)*\s*(?:=\s*|,\s*|$)//) {
1801             $self->_update_c_position($&, \$line, \$column);
1802
1803             $name = $1;
1804             $name =~ s/\s//g;
1805         } elsif(/^$/) {
1806             $name = "";
1807         } else {
1808             return 0;
1809         }
1810         last finished;
1811     }
1812
1813     # $output->write("$type: $name: '$_'\n");
1814
1815     $$refcurrent = $_;
1816     $$refline = $line;
1817     $$refcolumn = $column;
1818
1819     $$reflinkage = $linkage;
1820     $$reftype = $type;
1821     $$refname = $name;
1822
1823     $self->{FOUND_VARIABLE}($begin_line, $begin_column, $linkage, $type, $name);
1824
1825     return 1;
1826 }
1827
1828 1;