Ticket #241: glib-mkenums

File glib-mkenums, 15.0 KB (added by Zeqadious, 4 years ago)

Glib 2.18.0 of glib-mkenums

Line 
1#!/usr/bin/perl -w
2
3# glib-mkenums.pl
4# Information about the current enumeration
5my $flags;          # Is enumeration a bitmask?
6my $option_underscore_name; # Overriden underscore variant of the enum name
7                # for example to fix the cases we don't get the
8                # mixed-case -> underscorized transform right.
9my $option_lowercase_name;  # DEPRECATED.  A lower case name to use as part
10                # of the *_get_type() function, instead of the
11                # one that we guess. For instance, when an enum
12                # uses abnormal capitalization and we can not
13                # guess where to put the underscores.
14my $seenbitshift;       # Have we seen bitshift operators?
15my $enum_prefix;        # Prefix for this enumeration
16my $enumname;           # Name for this enumeration
17my $enumshort;          # $enumname without prefix
18my $enumname_prefix;        # prefix of $enumname
19my $enumindex = 0;      # Global enum counter
20my $firstenum = 1;      # Is this the first enumeration per file?
21my @entries;            # [ $name, $val ] for each entry
22
23sub parse_trigraph {
24    my $opts = shift;
25    my @opts;
26
27    for $opt (split /\s*,\s*/, $opts) {
28    $opt =~ s/^\s*//;
29    $opt =~ s/\s*$//;
30        my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
31    defined $val or $val = 1;
32    push @opts, $key, $val;
33    }
34    @opts;
35}
36sub parse_entries {
37    my $file = shift;
38    my $file_name = shift;
39    my $looking_for_name = 0;
40   
41    while (<$file>) {
42    # read lines until we have no open comments
43    while (m@/\*([^*]|\*(?!/))*$@) {
44        my $new;
45        defined ($new = <$file>) || die "Unmatched comment in $ARGV";
46        $_ .= $new;
47    }
48    # strip comments w/o options
49    s@/\*(?!<)
50        ([^*]+|\*(?!/))*
51       \*/@@gx;
52   
53    # strip newlines
54    s@\n@ @;
55   
56    # skip empty lines
57    next if m@^\s*$@;
58   
59    if ($looking_for_name) {
60        if (/^\s*(\w+)/) {
61        $enumname = $1;
62        return 1;
63        }
64    }
65   
66    # Handle include files
67    if (/^\#include\s*<([^>]*)>/ ) {
68            my $file= "../$1";
69        open NEWFILE, $file or die "Cannot open include file $file: $!\n";
70       
71        if (parse_entries (\*NEWFILE, $NEWFILE)) {
72        return 1;
73        } else {
74        next;
75        }
76    }
77   
78    if (/^\s*\}\s*(\w+)/) {
79        $enumname = $1;
80        $enumindex++;
81        return 1;
82    }
83   
84    if (/^\s*\}/) {
85        $enumindex++;
86        $looking_for_name = 1;
87        next;
88    }
89
90        if (m@^\s*
91              (\w+)\s*                   # name
92              (?:=(                      # value
93           \s*\w+\s*\(.*\)\s*       # macro with multiple args
94           |                        # OR
95                   (?:[^,/]|/(?!\*))*       # anything but a comma or comment
96                  ))?,?\s*
97              (?:/\*<                    # options
98                (([^*]|\*(?!/))*)
99               >\s*\*/)?,?
100              \s*$
101             @x) {
102            my ($name, $value, $options) = ($1,$2,$3);
103
104        if (!defined $flags && defined $value && $value =~ /<</) {
105        $seenbitshift = 1;
106        }
107
108        if (defined $options) {
109        my %options = parse_trigraph($options);
110        if (!defined $options{skip}) {
111            push @entries, [ $name, $options{nick} ];
112        }
113        } else {
114        push @entries, [ $name ];
115        }
116    } elsif (m@^\s*\#@) {
117        # ignore preprocessor directives
118    } else {
119        print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
120    }
121    }
122
123    return 0;
124}
125
126sub version {
127    print "glib-mkenums version glib-2.18.0\n";
128    print "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
129    print "You may redistribute copies of glib-mkenums under the terms of\n";
130    print "the GNU General Public License which can be found in the\n";
131    print "GLib source package. Sources, examples and contact\n";
132    print "information are available at http://www.gtk.org\n";
133    exit 0;
134}
135sub usage {
136    print "Usage: glib-mkenums [options] [files...]\n";
137    print "  --fhead <text>             output file header\n";
138    print "  --fprod <text>             per input file production\n";
139    print "  --ftail <text>             output file trailer\n";
140    print "  --eprod <text>             per enum text (produced prior to value itarations)\n";
141    print "  --vhead <text>             value header, produced before iterating over enum values\n";
142    print "  --vprod <text>             value text, produced for each enum value\n";
143    print "  --vtail <text>             value tail, produced after iterating over enum values\n";
144    print "  --comments <text>          comment structure\n";
145    print "  --template file            template file\n";
146    print "  -h, --help                 show this help message\n";
147    print "  -v, --version              print version informations\n";
148    print "Production text substitutions:\n";
149    print "  \@EnumName\@                 PrefixTheXEnum\n";
150    print "  \@enum_name\@                prefix_the_xenum\n";
151    print "  \@ENUMNAME\@                 PREFIX_THE_XENUM\n";
152    print "  \@ENUMSHORT\@                THE_XENUM\n";
153    print "  \@ENUMPREFIX\@               PREFIX\n";
154    print "  \@VALUENAME\@                PREFIX_THE_XVALUE\n";
155    print "  \@valuenick\@                the-xvalue\n";
156    print "  \@type\@                     either enum or flags\n";
157    print "  \@Type\@                     either Enum or Flags\n";
158    print "  \@TYPE\@                     either ENUM or FLAGS\n";
159    print "  \@filename\@                 name of current input file\n";
160    exit 0;
161}
162
163# production variables:
164my $fhead = "";   # output file header
165my $fprod = "";   # per input file production
166my $ftail = "";   # output file trailer
167my $eprod = "";   # per enum text (produced prior to value itarations)
168my $vhead = "";   # value header, produced before iterating over enum values
169my $vprod = "";   # value text, produced for each enum value
170my $vtail = "";   # value tail, produced after iterating over enum values
171# other options
172my $comment_tmpl = "/* \@comment\@ */";
173
174sub read_template_file {
175  my ($file) = @_;
176  my %tmpl = ('file-header', $fhead,
177          'file-production', $fprod,
178          'file-tail', $ftail,
179          'enumeration-production', $eprod,
180          'value-header', $vhead,
181          'value-production', $vprod,
182          'value-tail', $vtail,
183          'comment', $comment_tmpl);
184  my $in = 'junk';
185  open (FILE, $file) || die "Can't open $file: $!\n";
186  while (<FILE>) {
187    if (/^\/\*\*\*\s+(BEGIN|END)\s+([\w-]+)\s+\*\*\*\//) {
188      if (($in eq 'junk') && ($1 eq 'BEGIN') && (exists($tmpl{$2}))) {
189    $in = $2;
190    next;
191      }
192      elsif (($in eq $2) && ($1 eq 'END') && (exists($tmpl{$2}))) {
193    $in = 'junk';
194    next;
195      } else {
196      die "Malformed template file $file\n";
197      }
198    }
199    if (!($in eq 'junk')) {
200    $tmpl{$in} .= $_;
201    }
202  }
203  close (FILE);
204  if (!($in eq 'junk')) {
205      die "Malformed template file $file\n";
206  }
207  $fhead = $tmpl{'file-header'};
208  $fprod = $tmpl{'file-production'};
209  $ftail = $tmpl{'file-tail'};
210  $eprod = $tmpl{'enumeration-production'};
211  $vhead = $tmpl{'value-header'};
212  $vprod = $tmpl{'value-production'};
213  $vtail = $tmpl{'value-tail'};
214  $comment_tmpl = $tmpl{'comment'};
215}
216
217if (!defined $ARGV[0]) {
218    usage;
219}
220while ($_=$ARGV[0],/^-/) {
221    shift;
222    last if /^--$/;
223    if (/^--template$/)              { read_template_file (shift); }
224    elsif (/^--fhead$/)              { $fhead = $fhead . shift }
225    elsif (/^--fprod$/)              { $fprod = $fprod . shift }
226    elsif (/^--ftail$/)              { $ftail = $ftail . shift }
227    elsif (/^--eprod$/)              { $eprod = $eprod . shift }
228    elsif (/^--vhead$/)              { $vhead = $vhead . shift }
229    elsif (/^--vprod$/)              { $vprod = $vprod . shift }
230    elsif (/^--vtail$/)              { $vtail = $vtail . shift }
231    elsif (/^--comments$/)           { $comment_tmpl = shift }
232    elsif (/^--help$/ || /^-h$/)     { usage; }
233    elsif (/^--version$/ || /^-v$/)  { version; }
234    else { usage; }
235    last if not defined($ARGV[0]);
236}
237
238# put auto-generation comment
239{
240    my $comment = $comment_tmpl;
241    $comment =~ s/\@comment\@/Generated data (by glib-mkenums)/;
242    print "\n" . $comment . "\n\n";
243}
244
245if (length($fhead)) {
246    my $prod = $fhead;
247
248    $prod =~ s/\@filename\@/$ARGV[0]/g;
249    $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
250    $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
251    chomp ($prod);
252       
253    print "$prod\n";
254}
255
256while (<>) {
257    if (eof) {
258    close (ARGV);       # reset line numbering
259    $firstenum = 1;     # Flag to print filename at next enum
260    }
261
262    # read lines until we have no open comments
263    while (m@/\*([^*]|\*(?!/))*$@) {
264    my $new;
265    defined ($new = <>) || die "Unmatched comment in $ARGV";
266    $_ .= $new;
267    }
268    # strip comments w/o options
269    s@/\*(?!<)
270       ([^*]+|\*(?!/))*
271       \*/@@gx;
272   
273    if (m@^\s*typedef\s+enum\s*
274           ({)?\s*
275           (?:/\*<
276             (([^*]|\*(?!/))*)
277            >\s*\*/)?
278           \s*({)?
279         @x) {
280    if (defined $2) {
281        my %options = parse_trigraph ($2);
282        next if defined $options{skip};
283        $enum_prefix = $options{prefix};
284        $flags = $options{flags};
285        $option_lowercase_name = $options{lowercase_name};
286        $option_underscore_name = $options{underscore_name};
287    } else {
288        $enum_prefix = undef;
289        $flags = undef;
290        $option_lowercase_name = undef;
291        $option_underscore_name = undef;
292    }
293    if (defined $option_lowercase_name) {
294        if (defined $option_underscore_name) {
295        print STDERR "$0: $ARGV:$.: lowercase_name overriden with underscore_name\n";
296        $option_lowercase_name = undef;
297        } else {
298        print STDERR "$0: $ARGV:$.: lowercase_name is deprecated, use underscore_name\n";
299        }
300    }
301    # Didn't have trailing '{' look on next lines
302    if (!defined $1 && !defined $4) {
303        while (<>) {
304        if (s/^\s*\{//) {
305            last;
306        }
307        }
308    }
309
310    $seenbitshift = 0;
311    @entries = ();
312
313    # Now parse the entries
314    parse_entries (\*ARGV, $ARGV);
315
316    # figure out if this was a flags or enums enumeration
317    if (!defined $flags) {
318        $flags = $seenbitshift;
319    }
320
321    # Autogenerate a prefix
322    if (!defined $enum_prefix) {
323        for (@entries) {
324        my $nick = $_->[1];
325        if (!defined $nick) {
326            my $name = $_->[0];
327            if (defined $enum_prefix) {
328            my $tmp = ~ ($name ^ $enum_prefix);
329            ($tmp) = $tmp =~ /(^\xff*)/;
330            $enum_prefix = $enum_prefix & $tmp;
331            } else {
332            $enum_prefix = $name;
333            }
334        }
335        }
336        if (!defined $enum_prefix) {
337        $enum_prefix = "";
338        } else {
339        # Trim so that it ends in an underscore
340        $enum_prefix =~ s/_[^_]*$/_/;
341        }
342    } else {
343        # canonicalize user defined prefixes
344        $enum_prefix = uc($enum_prefix);
345        $enum_prefix =~ s/-/_/g;
346        $enum_prefix =~ s/(.*)([^_])$/$1$2_/;
347    }
348   
349    for $entry (@entries) {
350        my ($name,$nick) = @{$entry};
351            if (!defined $nick) {
352            ($nick = $name) =~ s/^$enum_prefix//;
353            $nick =~ tr/_/-/;
354            $nick = lc($nick);
355            @{$entry} = ($name, $nick);
356            }
357    }
358   
359
360    # Spit out the output
361    if (defined $option_underscore_name) {
362        $enumlong = uc $option_underscore_name;
363        $enumsym = lc $option_underscore_name;
364        $enumshort = $enumlong;
365        $enumshort =~ s/^[A-Z][A-Z0-9]*_//;
366
367        $enumname_prefix = $enumlong;
368        $enumname_prefix =~ s/$enumshort$//;
369    } else {
370        # enumname is e.g. GMatchType
371        $enspace = $enumname;
372        $enspace =~ s/^([A-Z][a-z]*).*$/$1/;
373
374        $enumshort = $enumname;
375        $enumshort =~ s/^[A-Z][a-z]*//;
376        $enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
377        $enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
378        $enumshort = uc($enumshort);
379
380        $enumname_prefix = $enumname;
381        $enumname_prefix =~ s/^([A-Z][a-z]*).*$/$1/;
382        $enumname_prefix = uc($enumname_prefix);
383
384        $enumlong = uc($enspace) . "_" . $enumshort;
385        $enumsym = lc($enspace) . "_" . lc($enumshort);
386
387        if (defined($option_lowercase_name)) {
388        $enumsym = $option_lowercase_name;
389        }
390    }
391
392    if ($firstenum) {
393        $firstenum = 0;
394       
395        if (length($fprod)) {
396        my $prod = $fprod;
397
398        $prod =~ s/\@filename\@/$ARGV/g;
399        $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
400        $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
401            chomp ($prod);
402       
403        print "$prod\n";
404        }
405    }
406   
407    if (length($eprod)) {
408        my $prod = $eprod;
409
410        $prod =~ s/\@enum_name\@/$enumsym/g;
411        $prod =~ s/\@EnumName\@/$enumname/g;
412        $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
413        $prod =~ s/\@ENUMNAME\@/$enumlong/g;
414        $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
415        if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
416        if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
417        if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
418        $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
419        $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
420            chomp ($prod);
421
422        print "$prod\n";
423    }
424
425    if (length($vhead)) {
426        my $prod = $vhead;
427
428        $prod =~ s/\@enum_name\@/$enumsym/g;
429            $prod =~ s/\@EnumName\@/$enumname/g;
430            $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
431            $prod =~ s/\@ENUMNAME\@/$enumlong/g;
432        $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
433        if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
434        if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
435        if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
436            $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
437            $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
438            chomp ($prod);
439       
440            print "$prod\n";
441    }
442
443    if (length($vprod)) {
444        my $prod = $vprod;
445       
446        $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
447        $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
448        for (@entries) {
449        my ($name,$nick) = @{$_};
450        my $tmp_prod = $prod;
451
452        $tmp_prod =~ s/\@VALUENAME\@/$name/g;
453        $tmp_prod =~ s/\@valuenick\@/$nick/g;
454        if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp_prod =~ s/\@type\@/enum/g; }
455        if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp_prod =~ s/\@Type\@/Enum/g; }
456        if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp_prod =~ s/\@TYPE\@/ENUM/g; }
457        chomp ($tmp_prod);
458
459        print "$tmp_prod\n";
460        }
461    }
462
463    if (length($vtail)) {
464        my $prod = $vtail;
465
466        $prod =~ s/\@enum_name\@/$enumsym/g;
467            $prod =~ s/\@EnumName\@/$enumname/g;
468            $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
469            $prod =~ s/\@ENUMNAME\@/$enumlong/g;
470        $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
471        if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
472        if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
473        if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
474            $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
475            $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
476            chomp ($prod);
477       
478            print "$prod\n";
479    }
480    }
481}
482
483if (length($ftail)) {
484    my $prod = $ftail;
485
486    $prod =~ s/\@filename\@/$ARGV/g;
487    $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
488    $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
489    chomp ($prod);
490       
491    print "$prod\n";
492}
493
494# put auto-generation comment
495{
496    my $comment = $comment_tmpl;
497    $comment =~ s/\@comment\@/Generated data ends here/;
498    print "\n" . $comment . "\n\n";
499}