Paul Davis
449aab3c46
git-svn-id: svn://localhost/ardour2/branches/3.0@3435 d708f5d6-7413-0410-9779-e7cbd77b26cf
234 lines
4.3 KiB
Raku
234 lines
4.3 KiB
Raku
#! /usr/bin/perl
|
|
|
|
# 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;
|
|
|
|
my %token;
|
|
$module="none";
|
|
|
|
while ($ARGV[0] =~ /^--(\S+)/)
|
|
{
|
|
shift @ARGV;
|
|
$module=shift @ARGV if ($1 eq "module");
|
|
if ($1 eq "help")
|
|
{
|
|
print "enum.pl [--module modname] header_files ....\n";
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
foreach $file (@ARGV)
|
|
{
|
|
&parse($file);
|
|
}
|
|
|
|
exit;
|
|
|
|
|
|
|
|
# parse enums from C
|
|
sub parse
|
|
{
|
|
my ($file)=@_;
|
|
|
|
$from=0;
|
|
open(FILE,$file);
|
|
|
|
$enum=0;
|
|
$deprecated=0;
|
|
$comment=0;
|
|
|
|
while(<FILE>)
|
|
{
|
|
if($comment)
|
|
{
|
|
# end of multiline comment
|
|
$comment = 0 if(/\*\//);
|
|
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
|
|
s/\/\*.*\*\///g;
|
|
|
|
# begin of multiline comment
|
|
if(/\/\*/)
|
|
{
|
|
$comment = 1;
|
|
next;
|
|
}
|
|
|
|
s/','/\%\%COMMA\%\%/;
|
|
s/'}'/\%\%RBRACE\%\%/;
|
|
if (/^\s*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;
|
|
|
|
$line=~s/\s+/ /g;
|
|
$line=~s/\/\*.*\*\///g;
|
|
$line=~s/\s*{\s*//;
|
|
|
|
my $entity = "enum";
|
|
$c_name =~ /^([A-Z][a-z]*)/;
|
|
$module = $1;
|
|
$def =~ s/$module//;
|
|
|
|
@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("%d",$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]+)$/
|
|
)
|
|
{
|
|
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;
|
|
}
|
|
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;
|
|
}
|
|
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);
|
|
|
|
my $format = "%d";
|
|
$format = "0x%X" if($entity eq "flags");
|
|
|
|
# evaluate any unevaluated values
|
|
my $j;
|
|
for ($j=0;$j<$#number+1;$j++)
|
|
{
|
|
if ($number[$j]=~/\$/)
|
|
{
|
|
$number[$j]=sprintf($format, eval($number[$j]));
|
|
}
|
|
}
|
|
|
|
#print ";; Enum $def\n\n";
|
|
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++)
|
|
{
|
|
print " \'(\"$name[$j]\" \"$c_name[$j]\"";
|
|
print " \"$number[$j]\"" if ($number[$j] ne "");
|
|
print ")\n";
|
|
}
|
|
print " )\n";
|
|
print ")\n\n";
|
|
}
|
|
|
|
|
|
sub form_names
|
|
{
|
|
my ($name,$c_name)=@_;
|
|
|
|
my $len=length($$c_name[0]) - 1;
|
|
my $j;
|
|
|
|
NAME: for ($j=0;$j<$#c_name;$j++)
|
|
{
|
|
while (substr($$c_name[$j],$len-1,1) ne "_" ||
|
|
substr($$c_name[$j],0,$len) ne substr($$c_name[$j+1],0,$len))
|
|
{
|
|
$len--;
|
|
last NAME if ($len <= 0);
|
|
}
|
|
#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,$_);
|
|
}
|
|
|
|
}
|