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