1#!/usr/bin/perl -w
2
3# GIMP - The GNU Image Manipulation Program
4# Copyright (C) 1999-2003 Manish Singh <yosh@gimp.org>
5
6# This program is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 3 of the License, or
9# (at your option) any later version.
10
11# This program is distributed in the hope that it will be useful,
12# but WITHOUTFILE ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15
16# You should have received a copy of the GNU General Public License
17# along with this program.  If not, see <https://www.gnu.org/licenses/>.
18
19BEGIN {
20    $srcdir   = $ENV{srcdir}   || '.';
21    $destdir  = $ENV{destdir}   || '.';
22    $builddir = $ENV{builddir} || '.';
23}
24
25use lib $srcdir;
26
27use Text::Wrap qw(wrap $columns);
28$columns = 77;
29
30#BEGIN { require 'util.pl' }
31require 'util.pl';
32
33*write_file = \&Gimp::CodeGen::util::write_file;
34*FILE_EXT   = \$Gimp::CodeGen::util::FILE_EXT;
35
36my $header = <<'HEADER';
37:# GIMP - The GNU Image Manipulation Program
38:# Copyright (C) 1999-2003 Manish Singh <yosh@gimp.org>
39:
40:# This program is free software: you can redistribute it and/or modify
41:# it under the terms of the GNU General Public License as published by
42:# the Free Software Foundation; either version 3 of the License, or
43:# (at your option) any later version.
44:
45:# This program is distributed in the hope that it will be useful,
46:# but WITHOUTFILE ANY WARRANTY; without even the implied warranty of
47:# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
48:# GNU General Public License for more details.
49:
50:# You should have received a copy of the GNU General Public License
51:# along with this program.  If not, see <https://www.gnu.org/licenses/>.
52:
53:# autogenerated by enumgen.pl
54:
55:package Gimp::CodeGen::enums;
56:
57:%enums = (
58HEADER
59
60my $external;
61open my $EXTERNAL, "enums-external.pl";
62{
63    local $/;
64    $external = <$EXTERNAL>;
65}
66close $EXTERNAL;
67
68my $footer = <<'FOOTER';
69:);
70:
71:foreach $e (values %enums) {
72:    $e->{info} = "";
73:    foreach (@{$e->{symbols}}) {
74:	$e->{info} .= "$_ ($e->{mapping}->{$_}), "
75:    }
76:    $e->{info} =~ s/, $//;
77:}
78:
79:1;
80FOOTER
81
82my ($enumname, $contig, $symbols, @mapping, $before);
83
84# Most of this enum parsing stuff was swiped from makeenums.pl in GTK+
85sub parse_options {
86    my $opts = shift;
87    my @opts;
88
89    for $opt (split /\s*,\s*/, $opts) {
90	$opt =~ s/^\s*//;
91	$opt =~ s/\s*$//;
92	my ($key,$val) = $opt =~ /([-\w]+)(?:=(.+))?/;
93	defined $val or $val = 1;
94	push @opts, $key, $val;
95    }
96    @opts;
97}
98
99sub parse_entries {
100    my $file = shift;
101    my $file_name = shift;
102    my $looking_for_name = 0;
103
104    while (<$file>) {
105	# Read lines until we have no open comments
106	while (m@/\*([^*]|\*(?!/))*$@) {
107	    my $new;
108	    defined ($new = <$file>) || die "Unmatched comment in $ARGV";
109	    $_ .= $new;
110	}
111	# strip comments w/o options
112	s@/\*(?!<)
113	    ([^*]+|\*(?!/))*
114	   \*/@@gx;
115
116	s@\n@ @;
117
118	next if m@^\s*$@;
119
120	if ($looking_for_name) {
121	    if (/^\s*(\w+)/) {
122		$enumname = $1;
123		return 1;
124	    }
125	}
126
127	# Handle include files
128	if (/^\#include\s*<([^>]*)>/ ) {
129	    my $file= "../$1";
130	    open NEWFILE, $file or die "Cannot open include file $file: $!\n";
131
132	    if (&parse_entries (\*NEWFILE, $NEWFILE)) {
133		return 1;
134	    } else {
135		next;
136	    }
137	}
138
139	if (/^\s*\}\s*(\w+)/) {
140	    $enumname = $1;
141	    return 1;
142	}
143
144	if (/^\s*\}/) {
145	    $looking_for_name = 1;
146	    next;
147	}
148
149	if (m@^\s*
150	      (\w+)\s*                   # name
151	      (?:=(                      # value
152		   (?:[^,/]|/(?!\*))*
153		  ))?,?\s*
154	      (?:/\*<                    # options
155		(([^*]|\*(?!/))*)
156	       >\s*\*/)?,?
157	      \s*$
158             @x) {
159            my ($name, $value, $options) = ($1, $2, $3);
160
161	    if (defined $options) {
162		my %options = parse_options($options);
163		next if defined $options{"pdb-skip"};
164	    }
165
166	    $symbols .= $name . ' ';
167
168	    # Figure out a default value (not really foolproof)
169	    $value = $before + 1 if !defined $value;
170	    $value =~ s/\s*$//s;
171	    $value =~ s/^\s*//s;
172
173	    push @mapping, $name, $value;
174
175	    my $test = $before + 1;
176
177	    # Warnings in our eval should be fatal so they set $@
178	    local $SIG{__WARN__} = sub { die $_[0] };
179
180	    # Try to get a numeric value
181	    eval "\$test = $value * 1;";
182
183	    # Assume noncontiguous if it's not a number
184	    $contig = 0 if $contig && ($@ || $test - 1 != $before);
185
186	    $before = $test;
187	} elsif (m@^\s*\#@) {
188	    # ignore preprocessor directives
189        } else {
190            print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
191        }
192    }
193    return 0;
194}
195
196my $code = "";
197while (<>) {
198    if (eof) {
199        close (ARGV);           # reset line numbering
200    }
201
202    # read lines until we have no open comments
203    while (m@/\*([^*]|\*(?!/))*$@) {
204	my $new;
205	defined ($new = <>) || die "Unmatched comment in $ARGV";
206	$_ .= $new;
207    }
208    # strip comments w/o options
209    s@/\*(?!<)
210       ([^*]+|\*(?!/))*
211       \*/@@gx;
212
213    if (m@^\s*typedef\s+enum\s*
214	   (\{)?\s*
215	   (?:/\*<
216	     (([^*]|\*(?!/))*)
217	    >\s*\*/)?
218         @x) {
219        if (defined $2) {
220            my %options = parse_options($2);
221	    next if defined $options{"pdb-skip"};
222	}
223	# Didn't have trailing '{' look on next lines
224	if (!defined $1) {
225	    while (<>) {
226		if (s/^\s*\{//) {
227		    last;
228		}
229	    }
230	}
231
232	$symbols = ""; $contig = 1; $before = -1; @mapping = ();
233
234	# Now parse the entries
235	&parse_entries (\*ARGV, $ARGV);
236
237	$symbols =~ s/\s*$//s;
238	$symbols = wrap("\t\t\t  ", "\t\t\t  " , $symbols);
239	$symbols =~ s/^\s*//s;
240
241	my $mapping = ""; $pos = 1;
242	foreach (@mapping) {
243	    $mapping .= $pos++ % 2 ? "$_ => " : "'$_',\n\t\t       ";
244	}
245	$mapping =~ s/,\n\s*$//s;
246
247	$ARGV =~ s@(?:(?:..|app)/)*@@;
248
249	$code .= <<ENTRY;
250:    $enumname =>
251:	{ contig => $contig,
252:	  header => '$ARGV',
253:	  symbols => [ qw($symbols) ],
254:	  mapping => { $mapping }
255:	},
256ENTRY
257    }
258}
259
260$code =~ s/,\n$/\n/s;
261
262foreach ($header, $code, $footer) { s/^://mg }
263
264$outfile = "$builddir/pdb/enums.pl$FILE_EXT";
265open OUTFILE, "> $outfile";
266print OUTFILE $header, $external, $code, $footer;
267close OUTFILE;
268&write_file($outfile, "$destdir/pdb");
269