[PATCH] Updated enum.pl script.

[Krzesimir Nowak <qdlacz gmail com>]

* tools/enum.pl: Updated to work with `use strict' and
`use warnings', added --with-typedefs (prints original enums in
comments above every enum defs) and --omit-deprecated (just omits
everything deprecated) options, handles most of enums and flags
(especially flags!) properly, generates proper nicks for enums with
one value, prints warnings to stderr about several stuff. It is
a better hack, but still a hack.
---
 tools/enum.pl |  455 ++++++++++++++++++++++++++++++++++++++------------------
 1 files changed, 309 insertions(+), 146 deletions(-)

diff --git a/tools/enum.pl b/tools/enum.pl
index 357931d..34f8d74 100755
--- a/tools/enum.pl
+++ b/tools/enum.pl
@@ -3,230 +3,393 @@
 # The lisp definitions for flags does not include order.
 # thus we must extract it ourselves.
 # Usage: ./enum.pl /gnome/head/cvs/gconf/gconf/*.h > gconf_enums.defs
-
 use warnings;
+use strict;
 use File::Spec;
-
-my %token;
-$module="none";
-
-while ($ARGV[0] =~ /^--(\S+)/)
+use Getopt::Long;
+use IO::File;
+#
+# globals.
+#
+# keeps enum values.
+my %tokens = ();
+# module name.
+my $module = "none";
+# if user used --help option.
+my $help = 0;
+# if user wants to have also original typedefs printed as a comments.
+my $typedefs = 0;
+# if user wants to omit deprecated stuff.
+my $omit = 0;
+#
+# prototypes.
+#
+sub parse($);
+sub process($$);
+sub form_names($$);
+#
+# main.
+#
+GetOptions('module=s' => \$module, 'help' => \$help, 'with-typedefs' => \$typedefs, 'omit-deprecated'=> \$omit);
+if ($help or not @ARGV)
 {
-  shift @ARGV;
-  $module=shift @ARGV if ($1 eq "module");
-  if ($1 eq "help")
-  {
-     print "enum.pl [--module modname] header_files ....\n";
-     exit 0;
-  }
+  print "enum.pl [--module modname][--with-typedefs][--omit-deprecated] header_files ...\n";
+  exit 0;
 }
-  
-foreach $file (@ARGV)
+foreach my $file (@ARGV)
 {
-  &parse($file);
+  parse($file);
 }
-
 exit;
-
-# parse enums from C
-sub parse ($)
+#
+# parse enums from C.
+#
+sub parse($)
 {
-  my ($file)= _;
-
-  $from=0;
-  open(FILE,$file);
-
-  $enum=0;
-  $deprecated=0;
-  $comment=0;
-
-  while(<FILE>)
+  my ($file) = @_;
+  my $fd = IO::File->new($file, "r");
+  unless (defined $fd)
   {
+    print STDERR "WARNING: Unable to open file: '" . $file . "'.\n";
+    return;
+  }
+  # 1, if we are inside enum.
+  my $enum = 0;
+  # 1 or more, if we are inside deprecated lines.
+  my $deprecated = 0;
+  # 1, if we are inside multiline comment.
+  my $comment = 0;
+  # line containing whole enum preprocessed definition to be processed.
+  my $line = "";
+  # line containing whole enum raw definition.
+  my $raw_line = "";
+  # 1, if we already printed comment about basename of header file containing
+  # enums.
+  my $from = 0;
+  while(<$fd>)
+  {
+    my $tmp_rawline = $_ if ($typedefs);
+    if ($enum and $typedefs)
+    {
+      $raw_line .= ";; " . $tmp_rawline;
+    }
     if($comment)
     {
-      # end of multiline comment
-      $comment = 0 if(m!\*/!);
+      # end of multiline comment.
+      if (m!\*/(.*)!) # / just to fix frigging highlighting in gedit
+      {
+        $comment = 0;
+        if ($enum)
+        {
+          $line .= $1;
+        }
+      }
       next;
     }
-
-    $deprecated = 1 if(s/^#ifndef [A-Z_]+_DISABLE_DEPRECATED//);
-
-    ++$deprecated if($deprecated > 0 && /^#\s*if/);
-    --$deprecated if($deprecated > 0 && /^#\s*endif/);
-
-    next if($deprecated > 0);
-
-    # filter single-line comments
+    # omit deprecated stuff.
+    if ($omit and /^\s*#.*(if\s*!\s*defined)|(ifndef)\s*\(?\s*[A-Z_]+_DISABLE_DEPRECATED\s*\)?/)
+    {
+      ++$deprecated;
+      next;
+    }
+    ++$deprecated if ($deprecated > 0 and /^#\s*if/);
+    if ($deprecated > 0 and /^#\s*endif/)
+    {
+      --$deprecated;
+      next;
+    }
+    next if ($deprecated > 0);
+    # discard any preprocessor directives inside enums.
+    next if ($enum and /^\s*#/);
+    # filter single-line comments.
     s!/\*.*?\*/!!g;
-
-    # begin of multiline comment
-    if(m!/\*!)
+    s!//.*$!!;
+    # beginning of multiline comment.
+    if (m!^(.*)/\*!)
     {
       $comment = 1;
+      if ($enum)
+      {
+        $line .= $1 . "\n";
+      }
       next;
     }
-
+    # XXX: what does it do?
     s/','/\%\%COMMA\%\%/;
     s/'}'/\%\%RBRACE\%\%/;
+    # we have found an enum.
     if (/^\s*typedef enum/ )
     {
       my $basename = File::Spec->splitpath($file);
-      print(';; From ', $basename, "\n\n") if (!$from);
-      $from=1;
-      $enum=1;
+      print(';; From ', $basename, "\n\n") unless ($from);
+      $from = 1;
+      $enum = 1;
+      if ($typedefs)
+      {
+        $raw_line .= ";; " . $tmp_rawline;
+      }
       next;
     }
-
+    # we have found end of an enum.
     if ($enum && /\}/)
     {
-       $enum=0;
-       &process($line,$_);
-       $line="";
+       $enum = 0;
+       if ($typedefs)
+       {
+         print ";; Original typedef:\n";
+         print $raw_line . "\n";
+       }
+       process($line, $_);
+       $line = "";
+       $raw_line = "" if ($typedefs);
     }
-    $line.=$_ if ($enum);
+    $line .= $_ if ($enum);
   }
+  $fd->close();
 }
 
-# convert enums to lisp
-sub process ($$)
+#
+# convert enums to lisp.
+#
+sub process($$)
 {
-  my ($line,$def)= _;
+  my ($line,$def) = @_;
 
-  $def=~s/\s*\}\s*//g;
-  $def=~s/\s*;\s*$//;
-  my $c_name=$def;
+  $def =~ s/\s*\}\s*//g;
+  $def =~ s/\s*;\s*$//;
+  my $c_name = $def;
 
-  $line=~s/\s+/ /g;
-  $line=~s!/\*.*\*/!!g;
-  $line=~s/\s*{\s*//;
+  $line =~ s/\s+/ /g;
+  $line =~ s!/\*.*\*/!!g;
+  $line =~ s/\s*{\s*//;
 
   my $entity = "enum";
   $c_name =~ /^([A-Z][a-z]*)/;
   $module = $1 if ($module eq "none");
   $def =~ s/\Q$module\E//;
 
-  @c_name=();
-  @name=();
-  @number=();
+  my @c_names = ();
+  my @numbers = ();
 
-  $val=0;
-  foreach $i (split(/,/,$line))
-    {
-      $i=~s/^\s+//;
-      $i=~s/\s+$//;
-      if ($i =~ /^\S+$/)
-      { 
-        push(@c_name,$i);
-        push(@number,sprintf("%d",$val));
-        $token{$i}=$val;
+  my $val = 0;
+  my $unknown_flag = 0;
+  my $unknown_val = 0;
+  foreach my $i (split(/,/, $line))
+  {
+    # remove leading and trailing spaces.
+    $i =~ s/^\s+//;
+    $i =~ s/\s+$//;
+    # also remove backslashes as some people like to add them before newlines...
+    $i =~ s/\\//g;
+    # if only name exists [like MY_ENUM_VALUE].
+    if ($i =~ /^\S+$/)
+    {
+      push(@c_names, $i);
+      if ($unknown_flag)
+      {
+        push(@numbers, $unknown_val);
+        $tokens{$i} = $unknown_val;
       }
-      elsif ($i =~ /^(\S+)\s*=\s*(0x[0-9a-fA-F]+)$/ || 
-             $i =~ /^(\S+)\s*=\s*(-?[0-9]+)$/ ||
-             $i =~ /^(\S+)\s*=\s*\(?(1\s*<<\s*[0-9]+)\)?$/
-            )
-      { 
-        my ($tmp1, $tmp2) = ($1, $2);
-        push(@c_name, $tmp1);
-        eval("\$val = $tmp2;");
-        $entity = "flags" if($tmp2 =~ /^1\s*<</ || $tmp2 =~ /^0x/);
-        push(@number, $tmp2);
-        $token{$tmp1} = $tmp2;
+      else
+      {
+        push(@numbers, sprintf("%d", $val));
+        $tokens{$i} = $val;
       }
-      elsif ($i =~ /^(\S+)\s*=\s*([ _x0-9a-fA-Z|()~]+)$/)
-      { 
-        my ($tmp1, $tmp2) = ($1, $2);
-        push(@c_name, $tmp1);
-        $tmp2 =~ s/([A-Z_]+)/($token{$1})/;
-        eval("\$val = $tmp2;");
-	$val = "#error" if(!$val);
-        $val = sprintf("0x%X", $val) if($entity eq "flags");
-        push(@number, $val);
-        $token{$tmp1} = $val;
+    }
+    # if name with value exists [like MY_FLAG_VALUE = 0x2 or 0x5 << 22
+    # or 42 or -13 (in this case entity is still enum, not flags)
+    # or 1 << 2 or (1 << 4) or (1 << 5) - 1].
+    elsif ($i =~ /^(\S+)\s*=\s*(0x[0-9a-fA-F]+[\s0-9a-fx<-]*)$/ ||
+           $i =~ /^(\S+)\s*=\s*(-?\s*[0-9]+)$/ ||
+           $i =~ /^(\S+)\s*=\s*(\(?1\s*<<\s*[0-9]+\s*\)?[\s0-9a-fx<-]*)$/
+          )
+    {
+      my ($tmp1, $tmp2) = ($1, $2);
+      push(@c_names, $tmp1);
+      eval("\$val = $tmp2;");
+      $entity = "flags" if ($tmp2 =~ /^1\s*<</ || $tmp2 =~ /^0x/);
+      push(@numbers, $tmp2);
+      $tokens{$tmp1} = $val;
+      $unknown_flag = 0;
+    }
+    # if name with other name exists [like MY_FLAG_VALUE = MY_PREV_FLAG_VALUE
+    # or ~(MY_PREV_FLAG_VALUE | MY_EARLIER_VALUE | (1 << 5) - 1 | 0x200)].
+    # [MY_FLAG MY_OTHER_FLAG is also supported - note lack of equal char.]
+    elsif ($i =~ /^(\S+)\s*=?\s*([ _x0-9a-fA-Z|()<~]+)$/)
+    {
+      my ($tmp1, $tmp2) = ($1, $2);
+      push(@c_names, $tmp1);
+      # split r-values on "logical or" and for each splitted r-value check its
+      # numeric value and replace a name with it if possible.
+      my @tmps = split(/\|/, $tmp2);
+      # dont_eval is 1 if unknown token is found, so whole value is copied
+      # verbatim, without evaling.
+      my $dont_eval = 0;
+      foreach my $tmpval (@tmps)
+      {
+        # if r-value is something like MY_FLAG or MY_DEFINE_VALUE3.
+        if ($tmpval =~ /([_A-Z0-9]+)/)
+        {
+          my $tmp3 = $1;
+          unless (defined($tokens{$tmp3}))
+          {
+            $dont_eval = 1;
+            print STDERR "WARNING: " . $tmp3 . " in " . $tmp1 . " in '" . $c_name . "' is an unknown token. It probably is:\n         - a typo - send a patch to maintainer of this module,\n         - preprocessor value - make sure you include a header defining this value,\n         - enum value from other header or other module - see above.\n";
+          }
+          else
+          {
+            $tmp2 =~ s/$tmp3/$tokens{$tmp3}/;
+          }
+        }
+        # else is a numeric value, so we do not do anything.
       }
-      elsif ($i =~ /^(\S+)\s*=\s*'(.)'$/)
+      # check if there are still same non-numerical values.
+      if ($tmp2 =~ /[_A-Z]+/)
       {
-        push(@c_name,$1);
-        push(@number,"\'$2\'");
-        $val=ord($2);
-        $token{$1}=$val;
+        $dont_eval = 1;
       }
-      elsif ($i =~ /^(\S+)\s*=\s*(\%\%[A-Z]+\%\%)$/)
+      unless ($dont_eval)
       {
-        $tmp=$1;
-        $_=$2;
-        s/\%\%COMMA\%\%/,/; 
-        s/\%\%RBRACE\%\%/]/; 
-        push(@c_name,$tmp);
-        push(@number,"\'$_\'");
-        $val=ord($_);
-        $token{$tmp}=$val;
+        eval("\$val = $tmp2;");
+        $val = sprintf("0x%X", $val) if ($entity eq "flags");
+        push(@numbers, $val);
+        $tokens{$tmp1} = $val;
+        $unknown_flag = 0;
       }
       else
       {
-        #print STDERR "$i\n";
+        push(@numbers, $tmp2);
+        $unknown_flag = 1;
+        $unknown_val = "(" . $tmp2 . ")";
+        # wrapping in safety parens.
+        $tokens{$tmp1} = $unknown_val;
       }
+    }
+    # if name with char exists (like MY_ENUM_VALUE = 'a').
+    elsif ($i =~ /^(\S+)\s*=\s*'(.)'$/)
+    {
+      push(@c_names, $1);
+      push(@numbers, "\'$2\'");
+      $val = ord($2);
+      $tokens{$1} = $val;
+      $unknown_flag = 0;
+    }
+    # if... XXX: I do not know what is matched here.
+    elsif ($i =~ /^(\S+)\s*=\s*(\%\%[A-Z]+\%\%)$/)
+    {
+      my $tmp = $1;
+      $_ = $2;
+      s/\%\%COMMA\%\%/,/;
+      s/\%\%RBRACE\%\%/]/;
+      push(@c_names, $tmp);
+      push(@numbers, "\'$_\'");
+      $val = ord($_);
+      $tokens{$tmp} = $val;
+      $unknown_flag = 0;
+    }
+    # it should not get here.
+    else
+    {
+      print STDERR "WARNING: I do not know how to parse it: '" . $i . "' in '" . $c_name . "'.\n";
+    }
+    if ($unknown_flag)
+    {
+      # wrap in safety parens.
+      $unknown_val = "(" . $unknown_val . " + 1)";
+    }
+    else
+    {
       $val++;
     }
-
-  # remove the prefix to form names
-  &form_names(\ name,\ c_name);
-
+  }
+  # get nicks.
+  my $ref_names = form_names($c_name, \ c_names);
+  # set format - decimal for enums, hexadecimal for flags.
   my $format = "%d";
-  $format = "0x%X" if($entity eq "flags");
-
-  # evaluate any unevaluated values
-  my $j;
-  for ($j=0;$j<$#number+1;$j++)
+  $format = "0x%X" if ($entity eq "flags");
+  # evaluate any unevaluated values.
+  for (my $j = 0; $j < @numbers; $j++)
   {
-    if ($number[$j]=~/\$/)
+    if ($numbers[$j] =~ /\$/)
     {
-      $number[$j]=sprintf($format, eval($number[$j]));
+      $numbers[$j] = sprintf($format, eval($numbers[$j]));
     }
   }
-
-  #print ";; Enum $def\n\n";
+  # print the defs.
   print "(define-$entity-extended $def\n";
   print "  (in-module \"$module\")\n";
   print "  (c-name \"$c_name\")\n";
 
   print "  (values\n";
-  for ($j=0;$j<$#c_name+1;$j++)
+  for (my $j = 0; $j < @c_names; $j++)
   {
-    print "    \'(\"$name[$j]\" \"$c_name[$j]\"";
-    print " \"$number[$j]\"" if ($number[$j] ne "");
+    print "    \'(\"$ref_names->[$j]\" \"$c_names[$j]\"";
+    print " \"$numbers[$j]\"" if ($numbers[$j] ne "");
     print ")\n";
   }
   print "  )\n";
   print ")\n\n";
 }
 
-
-sub form_names
+#
+# form nicks from C names.
+#
+sub form_names($$)
 {
-  my ($name,$c_name)= _;
- 
-  my $len=length($$c_name[0]) - 1;
-  my $j;
-
-  NAME: for ($j=0;$j<$#c_name;$j++)
+  my ($c_name, $c_names) = @_;
+  my @names = ();
+  # search for length of a prefix.
+  my $len = length($c_names->[0]) - 1;
+  # if there is more than one value in enum, just search for a common part.
+  if (@{$c_names} > 1)
   {
-    while (substr($$c_name[$j],$len-1,1) ne "_" ||
-           substr($$c_name[$j],0,$len) ne substr($$c_name[$j+1],0,$len))
+    NAME: for (my $j = 0; $j < @{$c_names} - 1; $j++)
+    {
+      while (substr($c_names->[$j], $len - 1, 1) ne "_" ||
+             substr($c_names->[$j], 0, $len) ne substr($c_names->[$j + 1], 0, $len))
+      {
+        $len--;
+        last NAME if ($len <= 0);
+      }
+    }
+  }
+  # if there is only one value in enum, we have to use name of the enum.
+  elsif (@{$c_names} == 1)
+  {
+    my @subvals = split(/_/, lc($c_names->[0]));
+    foreach my $subval (@subvals)
+    {
+      $subval = ucfirst($subval);
+    }
+    my $false_c_name = join("", @subvals);
+    while (substr($c_name, 0, $len) ne substr($false_c_name, 0, $len))
     {
       $len--;
-      last NAME if ($len <= 0);
+      last if ($len <= 0);
+    }
+    my $tmplen = $len;
+    foreach my $subval (@subvals)
+    {
+      $len++;
+      my $l = length($subval);
+      last if ($tmplen <= $l);
+      $tmplen -= $l;
     }
-    #print substr($$c_name[$j],0,$len),"\n";
   }
-  
-  my $prefix=substr($$c_name[0],0,$len);
-
-  for ($j=0;$j<$#c_name+1;$j++)
+  # no values in enum means no names.
+  else
+  {
+    return \ names;
+  }
+  # get prefix with given length.
+  my $prefix = substr($c_names->[0], 0, $len);
+  # generate names.
+  for (my $j = 0; $j < @{$c_names}; $j++)
   {
-    $_=$$c_name[$j];
+    $_ = $c_names->[$j];
     s/^$prefix//;
     tr/A-Z_/a-z-/;
-    push(@$name,$_);
+    push(@names, $_);
   }
-
+  return \ names;
 }  
-- 
1.6.5.2


--=-v4xwzqslPbKiYItCxjZk--