Re: glib.defs and gdk.defs

[Karl Nelson <kenelson ece ucdavis edu>]

I should mention that gtkmm needs enum defs as well as the current 
defs file I have.  Our extractor code is below for those interested.
Sorry for the missing code docs; I know uncommented perl is about
as useful as a black box.  

I don't have any comments on the new defs fromat otherwise, because
thus far I managed to pull everything out (but the enums) that I 
need.  However, it would be nice it the functions were object
layed out rather than functionally, but I managed to deal with it
using the ;; comments to pull sections and get speed up. 
 
It is written in perl because I like listening to line noise 
over being strangled by a python. :-)

Also if any other binding project is interested, the new gtkmmproc
program is pretty powerful and reads defs plus hand written files
to create mixed generated and hand writen files (even splitting the
sources).  But then you have to like perl/m4 to touch that.

--Karl

-----------------------------------------------------------------
#!/bin/perl

# The lisp definitions for flags does not include order.
# thus we must extract it ourselves.

my %token;

$glib_prefix=`glib-config --prefix`;
$gtk_prefix=`gtk-config --prefix`;
chop $glib_prefix;
chop $gtk_prefix;
$files=`ls $gtk_prefix/include/gtk/*.h`;

$module="Glib";
&parse("$glib_prefix/include/glib.h");

$module="Gtk";
foreach $file (split(/\n/,$files))
{
  &parse($file);
}
exit;



# parse enums from C
sub parse
{
  my ($file)= _;

  $from=0;
  open(FILE,$file);

  $enum=0;
  while(<FILE>)
  {
    s/\/\*.*\*\///g;
    s/','/\%\%COMMA\%\%/;
    s/'}'/\%\%RBRACE\%\%/;
    if (/^typedef enum/ )
    {
      print ";; From $file\n\n" if (!$from);
      $from=1;
      $enum=1;
      next;
    }

    if ($enum&&/\}/)
    {
       $enum=0;
       &process($line,$_);
       $line="";
    }
    $line.=$_ if ($enum);
  }
}

# convert enums to lisp
sub process
{
  my ($line,$def)= _;

  $def=~s/\s*\}\s*//g;
  $def=~s/\s*;\s*$//;
  my $c_name=$def;
  $def=~s/Gtk//;

  $line=~s/\s+/ /g;
  $line=~s/\/\*.*\*\///g;
  $line=~s/\s*{\s*//;

  #print ";; Enum $def\n\n";
  print "(enum $def\n";
  print "  (in-module Gtk)\n";
  print "  (c-name $c_name)\n";
  @c_name=();
  @name=();
  @number=();

  $val=0;
  foreach $i (split(/,/,$line))
    {
      $i=~s/^\s+//;
      $i=~s/\s+$//;
      if ($i =~ /^\S+$/)
      {
        push(@c_name,$i);
        push(@number,sprintf("0x%x",$val));
        $token{$i}=$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]+)$/
            )
      {
        push(@c_name,$1);
        eval("\$val=$2;");
        push(@number,sprintf("0x%x",$val));
        $token{$1}=$val;
      }
      elsif ($i =~ /^(\S+)\s*=\s*([ _A-Z|()~]+)$/)
      {
        my $tmp2=$1;
        push(@c_name,$tmp2);
        $tmp=$2;
        $tmp=~s/([A-Z_]+)/\$token{$1}/g;
        push(@number,$tmp);
        $token{$tmp2}=$tmp;
      }
      elsif ($i =~ /^(\S+)\s*=\s*'(.)'$/)
      {
        push(@c_name,$1);
        push(@number,"\'$2\'");
        $val=ord($2);
        $token{$1}=$val;
      }
      elsif ($i =~ /^(\S+)\s*=\s*(\%\%[A-Z]+\%\%)$/)
      {
        $tmp=$1;
        $_=$2;
        s/\%\%COMMA\%\%/,/;
        s/\%\%RBRACE\%\%/]/;
        push(@c_name,$tmp);
        push(@number,"\'$_\'");
        $val=ord($_);
        $token{$tmp}=$val;
      }
      else
      {
        #print STDERR "$i\n";
      }
      $val++;
    }

  # remove the prefix to form names
  &form_names(\ name,\ c_name);

  # evaluate any unevaluated values
  my $j;
  for ($j=0;$j<$#number+1;$j++)
  {
    if ($number[$j]=~/\$/)
    {
      $number[$j]=sprintf("0x%x",eval($number[$j]));
    }
  }

  for ($j=0;$j<$#c_name+1;$j++)
  {
    print "  (value (name $name[$j]) (c-name $c_name[$j])";
    print " (c-value $number[$j])" if ($number[$j] ne "");
    print ")\n";
  }
  print ")\n\n";
}

sub form_names
{
  my ($name,$c_name)= _;

  my $len=length($$c_name[0]);
  my $j;
  for ($j=0;$j<$#c_name;$j++)
  {
    while (substr($$c_name[$j],0,$len) ne substr($$c_name[$j+1],0,$len))
    {
      $len--;
    }
    #print substr($$c_name[$j],0,$len),"\n";
  }

  my $prefix=substr($$c_name[0],0,$len);

  for ($j=0;$j<$#c_name+1;$j++)
  {
    $_=$$c_name[$j];
    s/^$prefix//;
    tr/A-Z_/a-z-/;
    push(@$name,$_);
  }

}