1#!/usr/bin/perl -w
2
3# Information about the current enumeration
4
5my $flags;			# Is enumeration a bitmask
6my $seenbitshift;			# Have we seen bitshift operators?
7my $prefix;			# Prefix for this enumeration
8my $enumname;			# Name for this enumeration
9my $firstenum = 1;		# Is this the first enumeration in file?
10my @entries;			# [ $name, $val ] for each entry
11
12sub parse_options {
13    my $opts = shift;
14    my @opts;
15
16    for $opt (split /\s*,\s*/, $opts) {
17	my ($key,$val) = $opt =~ /\s*(\w+)(?:=(\S+))?/;
18	defined $val or $val = 1;
19	push @opts, $key, $val;
20    }
21    @opts;
22}
23sub parse_entries {
24    my $file = shift;
25
26    while (<$file>) {
27	# Read lines until we have no open comments
28	while (m@/\*
29	       ([^*]|\*(?!/))*$
30	       @x) {
31	    my $new;
32	    defined ($new = <$file>) || die "Unmatched comment";
33	    $_ .= $new;
34	}
35	# Now strip comments
36	s@/\*(?!<)
37	    ([^*]+|\*(?!/))*
38	   \*/@@gx;
39
40	s@\n@ @;
41
42	next if m@^\s*$@;
43
44	# Handle include files
45	if (/^\#include\s*<([^>]*)>/ ) {
46            my $file= "../$1";
47	    open NEWFILE, $file or die "Cannot open include file $file: $!\n";
48
49	    if (parse_entries (\*NEWFILE)) {
50		return 1;
51	    } else {
52		next;
53	    }
54	}
55
56	if (/^\s*\}\s*(\w+)/) {
57	    $enumname = $1;
58	    return 1;
59	}
60
61	if (m@^\s*
62              (\w+)\s*		         # name
63              (?:=(                      # value
64                   (?:[^,/]|/(?!\*))*
65                  ))?,?\s*
66              (?:/\*<		         # options
67                (([^*]|\*(?!/))*)
68               >\*/)?
69              \s*$
70             @x) {
71	    my ($name, $value, $options) = ($1,$2,$3);
72
73	    if (!defined $flags && defined $value && $value =~ /<</) {
74		$seenbitshift = 1;
75	    }
76	    if (defined $options) {
77		my %options = parse_options($options);
78		if (!defined $options{skip}) {
79		    push @entries, [ $name, $options{nick} ];
80		}
81	    } else {
82		push @entries, [ $name ];
83	    }
84	} else {
85	    print STDERR "Can't understand: $_\n";
86	}
87    }
88    return 0;
89}
90
91
92my $gen_arrays = 0;
93my $gen_defs = 0;
94my $gen_includes = 0;
95my $gen_cfile = 0;
96
97# Parse arguments
98
99if (@ARGV) {
100    if ($ARGV[0] eq "arrays") {
101	shift @ARGV;
102	$gen_arrays = 1;
103    } elsif ($ARGV[0] eq "defs") {
104	shift @ARGV;
105	$gen_defs = 1;
106    } elsif ($ARGV[0] eq "include") {
107	shift @ARGV;
108	$gen_includes = 1;
109    } elsif ($ARGV[0] eq "cfile") {
110	shift @ARGV;
111	$gen_cfile = 1;
112    }
113}
114
115if ($gen_defs) {
116    print ";; generated by makeenums.pl  ; -*- scheme -*-\n\n";
117} else {
118    print "/* Generated by makeenums.pl */\n\n";
119}
120
121if ($gen_includes) {
122  print "#ifndef __GDK_ENUM_TYPES_H__\n";
123  print "#define __GDK_ENUM_TYPES_H__\n";
124}
125
126if ($gen_cfile) {
127  print "#include \"gdk.h\"\n";
128}
129
130ENUMERATION:
131while (<>) {
132    if (eof) {
133	close (ARGV);		# reset line numbering
134	$firstenum = 1;		# Flag to print filename at next enum
135    }
136
137    if (m@^\s*typedef\s+enum\s*
138           ({)?\s*
139           (?:/\*<
140             (([^*]|\*(?!/))*)
141            >\*/)?
142         @x) {
143      print "\n";
144	if (defined $2) {
145	    my %options = parse_options($2);
146	    $prefix = $options{prefix};
147	    $flags = $options{flags};
148	} else {
149	    $prefix = undef;
150	    $flags = undef;
151	}
152	# Didn't have trailing '{' look on next lines
153	if (!defined $1) {
154	    while (<>) {
155		if (s/^\s*\{//) {
156		    last;
157		}
158	    }
159	}
160
161	$seenbitshift = 0;
162	@entries = ();
163
164	# Now parse the entries
165	parse_entries (\*ARGV);
166
167	# figure out if this was a flags or enums enumeration
168
169	if (!defined $flags) {
170	    $flags = $seenbitshift;
171	}
172
173	# Autogenerate a prefix
174
175	if (!defined $prefix) {
176	    for (@entries) {
177		my $name = $_->[0];
178		if (defined $prefix) {
179		    my $tmp = ~ ($name ^ $prefix);
180		    ($tmp) = $tmp =~ /(^\xff*)/;
181		    $prefix = $prefix & $tmp;
182		} else {
183		    $prefix = $name;
184		}
185	    }
186	    # Trim so that it ends in an underscore
187	    $prefix =~ s/_[^_]*$/_/;
188	}
189
190	for $entry (@entries) {
191	    my ($name,$nick) = @{$entry};
192            if (!defined $nick) {
193 	        ($nick = $name) =~ s/^$prefix//;
194	        $nick =~ tr/_/-/;
195	        $nick = lc($nick);
196	        @{$entry} = ($name, $nick);
197            }
198	}
199
200	# Spit out the output
201
202        my $valuename = $enumname;
203        $valuename =~ s/([^A-Z])([A-Z])/$1_$2/g;
204        $valuename =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
205        $valuename = lc($valuename);
206
207        my $typemacro = $enumname;
208        $typemacro =~ s/([^A-Z])([A-Z])/$1_$2/g;
209        $typemacro =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
210        $typemacro = uc($valuename);
211        $typemacro =~ s/GDK_/GDK_TYPE_/g;
212
213	if ($gen_defs) {
214	    if ($firstenum) {
215		print qq(\n; enumerations from "$ARGV"\n);
216		$firstenum = 0;
217	    }
218
219	    print "\n(define-".($flags ? "flags" : "enum")." $enumname";
220
221	    for (@entries) {
222		my ($name,$nick) = @{$_};
223		print "\n   ($nick $name)";
224	    }
225	    print ")\n";
226
227	} elsif ($gen_arrays) {
228
229	    print "static const GtkEnumValue _${valuename}_values[] = {\n";
230	    for (@entries) {
231		my ($name,$nick) = @{$_};
232		print qq(  { $name, "$name", "$nick" },\n);
233	    }
234	    print "  { 0, NULL, NULL }\n";
235	    print "};\n";
236	} elsif ($gen_includes) {
237            print "GType ${valuename}_get_type (void);\n";
238            print "#define ${typemacro} ${valuename}_get_type ()\n";
239          } elsif ($gen_cfile) {
240            print (<<EOF);
241GType
242${valuename}_get_type (void)
243{
244  static GType etype = 0;
245  if (etype == 0)
246    {
247EOF
248            if ($flags) {
249              print "      static const GFlagsValue values[] = {\n";
250            } else {
251              print "      static const GEnumValue values[] = {\n";
252            }
253            for (@entries) {
254              my ($name,$nick) = @{$_};
255              print qq(        { $name, "$name", "$nick" },\n);
256            }
257	    print "        { 0, NULL, NULL }\n";
258	    print "      };\n";
259
260            if ($flags) {
261              print "      etype = g_flags_register_static (\"$enumname\", values);\n";
262            } else {
263              print "      etype = g_enum_register_static (\"$enumname\", values);\n";
264            }
265
266            print (<<EOF);
267    }
268  return etype;
269}
270EOF
271          }
272        print "\n";
273      }
274  }
275
276
277if ($gen_includes) {
278  print "#endif /* __GDK_ENUMS_H__ */\n";
279}
280