GtkSharp/codegen/get-props-from-source.pl
Mike Kestner d7df5fa0ca 2001-10-25 Mike Kestner <mkestner@speakeasy.net>
* codegen/get-props-from-source.pl : Temporary (possibly) defs
	generator for props. Will probably kill this when the official
	defs support props.
	* codegen/defs-parse.pl : Added object-based aggregation of
	defs. Generate the class shells, methods, and props.
	* codegen/gdk-types.defs : ripped from pygtk.
	* codegen/gtk.defs : ripped from pygtk.
	* codegen/gtk-props.defs : some props defs.
	* codegen/makefile : add the new defs files.

svn path=/trunk/gtk-sharp/; revision=1203
2001-10-25 22:16:10 +00:00

145 lines
3 KiB
Perl
Executable file

#!/usr/bin/perl
open (SRCFILE, $ARGV[0]) || die "Could open $ARGV[0]";
@lines = <SRCFILE>;
$linenum = 0;
while ($linenum < @lines) {
$line = $lines[$linenum];
if ($line =~ /^(\w+)_class_init/) {
$typename = StudCaps($1);
$fstr = "";
do {
$fstr .= $lines[$linenum++];
} until ($lines[$linenum] =~ /^}/);
parse_init_func ($typename, $fstr);
}
$linenum++;
}
sub parse_init_func
{
my ($class, $func) = @_;
my @init_lines = split (/\n/, $func);
my $linenum = 0;
while ($linenum < @init_lines) {
my $line = $init_lines[$linenum];
while ($linenum < @init_lines) {
$line = $init_lines[$linenum];
if ($line =~ /g_object_class_install_prop/) {
my $prop = $line;
do {
$prop .= $init_lines[++$linenum];
} until ($init_lines[$linenum] =~ /;/);
print_prop ($prop, $class);
} elsif ($line =~ /g_signal_new/) {
my $sig = $line;
do {
$sig .= $init_lines[++$linenum];
} until ($init_lines[$linenum] =~ /;/);
print_signal ($sig, $class);
}
$linenum++;
}
$linenum++;
}
}
sub print_signal
{
my ($spec, $class) = @_;
$spec =~ s/\n\s*//g;
$spec =~ /\((.*)\);/;
my @args = split (/,\s*/, $1);
$args[0] =~ /\w+/;
my $name = $&;
my $ret = $args[8];
if ($ret =~ /G_TYPE_(\w+)/) {
$ret = lc ($1);
}
my $param_cnt = $args[9];
my $pstr = "\t<signal name=\"$name\">\n";
$pstr .= "\t\t<return> $ret </return>\n";
if ($param_cnt) {
$pstr .= "\t\t<parameters>\n";
for ($i=0; $i < $param_cnt; $i++) {
if ($args[$i+10] =~ /G_TYPE_(\w+)/) {
$args[$i+10] = lc ($1);
}
$pstr .= "\t\t\t<param> $args[$i+10] </param>\n";
}
$pstr .= "\t\t</parameters>\n";
}
$pstr .= "\t</signal>\n\n";
$signals{$name} = $pstr;
}
sub print_prop
{
my ($spec, $class) = @_;
$spec =~ /g_param_spec_(\w+)\s*\((.*)/;
$type = $1;
$params = $2;
if ($type =~ /boolean|^u*int|pointer/) {
$params =~ /\"(.+)\",.+\".+\".+\"(.+)\".*(,\s*G_PARAM_\w+.*)\)\s*\)/;
$name = $1; $docs = $2; $mode = $3;
$type = "g$type";
} elsif ($type =~ /string/) {
$params =~ /\"(.+)\",.+\".+\".+\"(.+)\".*(,\s*G_PARAM_\w+.*)\)\s*\)/;
$name = $1; $docs = $2; $mode = $3;
$type = "gchar*";
} elsif ($type =~ /enum|flags/) {
$params =~ /\"(.+)\",.+,.+\"(.+)\".*,\s+(\w+),.*,(\s*G_PARAM_\w+.*)\)\s*\)/;
$name = $1; $docs = $2; $type = $3; $mode = $4;
$type =~ s/TYPE_//;
$type = StudCaps(lc($type));
} elsif ($type =~ /object/) {
$params =~ /\"(.+)\",.+,.+\"(.+)\".*,\s+(\w+),(\s*G_PARAM_\w+.*)\)\s*\)/;
$name = $1; $docs = $2; $type = $3; $mode = $4;
$type =~ s/TYPE_//;
$type = StudCaps(lc($type));
}
print "(define-property $name\n";
print " (of-object \"$class\")\n";
print " (prop-type \"$type\")\n";
print " (doc-string \"$docs\")\n";
if ($mode =~ /READ/) { print " (readable #t)\n"; }
if ($mode =~ /WRIT/) { print " (writeable #t)\n"; }
if ($mode =~ /CONS/) { print " (construct-only #t)\n"; }
print ")\n\n";
$props{$name} = $pstr;
}
sub StudCaps
{
my ($str) = @_;
$str =~ s/^(\w)/\u\1/;
$str =~ s/[_-]([a-z])/\u\1/g;
$str =~ s/[_-](\d)/\1/g;
return $str;
}