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