+++ /dev/null
-#!/usr/bin/perl
-#
-# gapi2xml.pl : Generates an XML representation of GObject based APIs.
-#
-# Author: Mike Kestner <mkestner@speakeasy.net>
-#
-# Copyright (c) 2001-2003 Mike Kestner
-# Copyright (c) 2003-2004 Novell, Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of version 2 of the GNU General Public
-# License as published by the Free Software Foundation.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public
-# License along with this program; if not, write to the
-# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-##############################################################
-
-$debug=0;
-
-use XML::LibXML;
-
-if (!$ARGV[1]) {
- die "Usage: gapi_pp.pl <srcdir> | gapi2xml.pl <namespace> <outfile>\n";
-}
-
-$ns = $ARGV[0];
-
-##############################################################
-# Check if the filename provided exists. We parse existing files into
-# a tree and append the namespace to the root node. If the file doesn't
-# exist, we create a doc tree and root node to work with.
-##############################################################
-
-if (-e $ARGV[1]) {
- #parse existing file and get root node.
- $doc = XML::LibXML->new->parse_file($ARGV[1]);
- $root = $doc->getDocumentElement();
-} else {
- $doc = XML::LibXML::Document->new();
- $root = $doc->createElement('api');
- $root->setAttribute("version", "1.0");
- $doc->setDocumentElement($root);
- $warning_node = XML::LibXML::Comment->new ("\n\n This file was automatically generated.\n Please DO NOT MODIFY THIS FILE, modify .metadata files instead.\n\n");
- $root->appendChild($warning_node);
-}
-
-$ns_elem = $doc->createElement('namespace');
-$ns_elem->setAttribute('name', $ns);
-$root->appendChild($ns_elem);
-
-##############################################################
-# First we parse the input for typedefs, structs, enums, and class_init funcs
-# and put them into temporary hashes.
-##############################################################
-
-while ($line = <STDIN>) {
- if ($line =~ /typedef\s+(struct\s+\w+\s+)\*+(\w+);/) {
- $ptrs{$2} = $1;
- } elsif ($line =~ /typedef\s+(struct\s+\w+)\s+(\w+);/) {
- next if ($2 =~ /Private$/);
- # fixme: siiigh
- $2 = "GdkDrawable" if ($1 eq "_GdkDrawable");
- $types{$2} = $1;
- } elsif ($line =~ /typedef\s+struct/) {
- $sdef = $line;
- while ($line = <STDIN>) {
- $sdef .= $line;
- last if ($line =~ /^(deprecated)?}/);
- }
- $sdef =~ s!/\*.*?(\*/|\n)!!g;
- $sdef =~ s/\n\s*//g;
- $types{$1} = $sdef if ($sdef =~ /.*\}\s*(\w+);/);
- } elsif ($line =~ /typedef\s+(unsigned\s+\w+)\s+(\**)(\w+);/) {
- $types{$3} = $1 . $2;
- } elsif ($line =~ /typedef\s+(\w+)\s+(\**)(\w+);/) {
- $types{$3} = $1 . $2;
- } elsif ($line =~ /typedef\s+enum\s+(\w+)\s+(\w+);/) {
- $etypes{$1} = $2;
- } elsif ($line =~ /^((deprecated)?typedef\s+)?\benum\b/) {
- $edef = $line;
- while ($line = <STDIN>) {
- $edef .= $line;
- last if ($line =~ /^(deprecated)?}\s*(\w+)?;/);
- }
- $edef =~ s/\n\s*//g;
- $edef =~ s|/\*.*?\*/||g;
- if ($edef =~ /typedef.*}\s*(\w+);/) {
- $ename = $1;
- } elsif ($edef =~ /^(deprecated)?enum\s+(\w+)\s*{/) {
- $ename = $2;
- } else {
- print "Unexpected enum format\n$edef";
- next;
- }
- $edefs{$ename} = $edef;
- } elsif ($line =~ /typedef\s+\w+\s*\**\s*\(\*\s*(\w+)\)\s*\(/) {
- $fname = $1;
- $fdef = "";
- while ($line !~ /;/) {
- $fdef .= $line;
- $line = <STDIN>;
- }
- $fdef .= $line;
- $fdef =~ s/\n\s+//g;
- $fpdefs{$fname} = $fdef;
- } elsif ($line =~ /^(private|deprecated)?struct\s+(\w+)/) {
- next if ($line =~ /;/);
- $sname = $2;
- $sdef = $line;
- while ($line = <STDIN>) {
- $sdef .= $line;
- last if ($line =~ /^(deprecated)?}/);
- }
- $sdef =~ s!/\*[^<].*?(\*/|\n)!!g;
- $sdef =~ s/\n\s*//g;
- $sdefs{$sname} = $sdef if (!exists ($sdefs{$sname}));
- } elsif ($line =~ /^(\w+)_(class|base)_init\b/) {
- $class = StudlyCaps($1);
- $pedef = $line;
- while ($line = <STDIN>) {
- $pedef .= $line;
- last if ($line =~ /^(deprecated)?}/);
- }
- $pedefs{lc($class)} = $pedef;
- } elsif ($line =~ /^(\w+)_get_type\b/) {
- $class = StudlyCaps($1);
- $pedef = $line;
- while ($line = <STDIN>) {
- $pedef .= $line;
- if ($line =~ /g_boxed_type_register_static/) {
- $boxdef = $line;
- while ($line !~ /;/) {
- $boxdef .= ($line = <STDIN>);
- }
- $boxdef =~ s/\n\s*//g;
- $boxdef =~ /\(\"(\w+)\"/;
- my $boxtype = $1;
- $boxtype =~ s/($ns)Type(\w+)/$ns$2/;
- $boxdefs{$boxtype} = $boxdef;
- } elsif ($line =~ /g_(enum|flags)_register_static/) {
- $pedef =~ /^(\w+_get_type)/;
- $enum_gtype{$class} = $1;
- }
- last if ($line =~ /^(deprecated)?}/);
- }
- $typefuncs{lc($class)} = $pedef;
- } elsif ($line =~ /^G_DEFINE_TYPE_WITH_CODE\s*\(\s*(\w+)/) {
- $typefuncs{lc($1)} = $line;
- } elsif ($line =~ /^(deprecated)?(const|G_CONST_RETURN)?\s*(struct\s+)?\w+\s*\**(\s*(const|G_CONST_RETURN)\s*\**)?\s*(\w+)\s*\(/) {
- $fname = $6;
- $fdef = "";
- while ($line !~ /;/) {
- $fdef .= $line;
- $line = <STDIN>;
- }
- $fdef .= $line;
- $fdef =~ s/\n\s*//g;
- if ($fdef !~ /^_/) {
- $fdefs{$fname} = $fdef;
- }
- } elsif ($line =~ /CHECK_(\w*)CAST/) {
- $cast_macro = $line;
- while ($line =~ /\\$/) {
- $line = <STDIN>;
- $cast_macro .= $line;
- }
- $cast_macro =~ s/\\\n\s*//g;
- $cast_macro =~ s/\s+/ /g;
- if ($cast_macro =~ /G_TYPE_CHECK_(\w+)_CAST.*,\s*(\w+),\s*(\w+)\)/) {
- if ($1 eq "INSTANCE") {
- $objects{$2} = $3 . $objects{$2};
- } else {
- $objects{$2} .= ":$3";
- }
- } elsif ($cast_macro =~ /G_TYPE_CHECK_(\w+)_CAST.*,\s*([a-zA-Z0-9]+)_(\w+)_get_type\s*\(\),\s*(\w+)\)/) {
- $typename = uc ("$2_type_$3");
- if ($1 eq "INSTANCE") {
- $objects{$typename} = $4 . $objects{$typename};
- } else {
- $objects{$typename} .= ":$4";
- }
- } elsif ($cast_macro =~ /GTK_CHECK_CAST.*,\s*(\w+),\s*(\w+)/) {
- $objects{$1} = $2 . $objects{$1};
- } elsif ($cast_macro =~ /GTK_CHECK_CLASS_CAST.*,\s*(\w+),\s*(\w+)/) {
- $objects{$1} .= ":$2";
- } elsif ($cast_macro =~ /GST_IMPLEMENTS_INTERFACE_CHECK_INSTANCE_CAST.*,\s*(\w+),\s*(\w+)/) {
- $objects{$1} = $2 . $objects{$1};
- }
- } elsif ($line =~ /INSTANCE_GET_INTERFACE.*,\s*(\w+),\s*(\w+)/) {
- $ifaces{$1} = $2;
- } elsif ($line =~ /^BUILTIN\s*\{\s*\"(\w+)\".*GTK_TYPE_BOXED/) {
- $boxdefs{$1} = $line;
- } elsif ($line =~ /^BUILTIN\s*\{\s*\"(\w+)\".*GTK_TYPE_(ENUM|FLAGS)/) {
- # ignoring these for now.
- } elsif ($line =~ /^(deprecated)?\#define/) {
- my $test_ns = uc ($ns);
- if ($line =~ /^deprecated\#define\s+(\w+)\s+\"(.*)\"/) {
- $defines{"deprecated$1"} = $2;
- } elsif ($line =~ /\#define\s+(\w+)\s+\"(.*)\"/) {
- $defines{$1} = $2;
- }
- } elsif ($line !~ /\/\*/) {
- print $line;
- }
-}
-
-##############################################################
-# Produce the enum definitions.
-##############################################################
-%enums = ();
-
-foreach $cname (sort(keys(%edefs))) {
- $ecnt++;
- $def = $edefs{$cname};
- $cname = $etypes{$cname} if (exists($etypes{$cname}));
- $enums{lc($cname)} = $cname;
- $enum_elem = addNameElem($ns_elem, 'enum', $cname, $ns);
- if ($def =~ /^deprecated/) {
- $enum_elem->setAttribute("deprecated", "1");
- $def =~ s/deprecated//g;
- }
- if ($enum_gtype{$cname}) {
- $enum_elem->setAttribute("get-type", $enum_gtype{$cname});
- }
- if ($def =~ /<</) {
- $enum_elem->setAttribute('type', "flags");
- } else {
- $enum_elem->setAttribute('type', "enum");
- }
- $def =~ /\{(.*\S)\s*\}/;
- @vals = split(/,\s*/, $1);
- $vals[0] =~ s/^\s+//;
- @v0 = split(/_/, $vals[0]);
- if (@vals > 1) {
- $done = 0;
- for ($idx = 0, $regex = ""; $idx < @v0; $idx++) {
- $regex .= ($v0[$idx] . "_");
- foreach $val (@vals) {
- # ignore enum values to avoid some pattern matching issues
- $val =~ s/=.*//;
- $done = 1 if ($val !~ /$regex/);
- }
- last if $done;
- }
- $common = join("_", @v0[0..$idx-1]);
- } else {
- $common = join("_", @v0[0..$#v0-1]);
- }
-
- foreach $val (@vals) {
- if ($val =~ /$common\_?(\w+)\s*=\s*(.*)$/) {
- $name = $1;
- $enumval = $2;
- if ($enumval =~ /^(\d+|0x[0-9A-Fa-f]+)u?\s*<<\s*(\d+)$/) {
- $enumval = "";
- } elsif ($enumval =~ /^$common\_?(\w+)$/) {
- $enumval = ""
- }
- } elsif ($val =~ /$common\_?(\w+)/) {
- $name = $1; $enumval = "";
- } else {
- die "Unexpected enum value: $val for common value $common\n";
- }
-
- $val_elem = addNameElem($enum_elem, 'member');
- $val_elem->setAttribute('name', "$common\_$name");
- $val_elem->setAttribute('value', $enumval);
- }
-}
-
-##############################################################
-# Parse the callbacks.
-##############################################################
-
-foreach $cbname (sort(keys(%fpdefs))) {
- next if ($cbname =~ /^_/);
- $cbcnt++;
- $fdef = $cb = $fpdefs{$cbname};
- $cb_elem = addNameElem($ns_elem, 'callback', $cbname, $ns);
- $cb =~ /typedef\s+(.*)\(.*\).*\((.*)\);/;
- $ret = $1; $params = $2;
- addReturnElem($cb_elem, $ret);
- if ($params && ($params ne "void")) {
- addParamsElem($cb_elem, split(/,/, $params));
- }
-}
-
-
-##############################################################
-# Parse the interfaces list.
-##############################################################
-
-foreach $type (sort(keys(%ifaces))) {
-
- $iface = $ifaces{$type};
- ($inst, $dontcare) = split(/:/, delete $objects{$type});
- $initfunc = $pedefs{lc($inst)};
- $ifacetype = delete $types{$iface};
- delete $types{$inst};
-
- $ifacecnt++;
- $iface_el = addNameElem($ns_elem, 'interface', $inst, $ns);
- $iface_el->setAttribute("get-type", "");
-
- $elem_table{lc($inst)} = $iface_el;
-
- $classdef = $sdefs{$1} if ($ifacetype =~ /struct\s+(\w+)/);
- if ($initfunc) {
- parseInitFunc($iface_el, $initfunc);
- } else {
- warn "Don't have an init func for $inst.\n" if $debug;
- addVirtualMethods ($classdef, $iface_el);
- }
-}
-
-
-##############################################################
-# Parse the classes by walking the objects list.
-##############################################################
-
-foreach $type (sort(keys(%objects))) {
- ($inst, $class) = split(/:/, $objects{$type});
- $class = $inst . "Class" if (!$class);
-
- next if ($inst eq "");
-
- $initfunc = $pedefs{lc($inst)};
- $typefunc = $typefuncs{lc($inst)};
- $insttype = delete $types{$inst};
- $classtype = delete $types{$class};
-
- $instdef = $classdef = "";
- $instdef = $sdefs{$1} if ($insttype =~ /struct\s+(\w+)/);
- $classdef = $sdefs{$1} if ($classtype =~ /struct\s+(\w+)/);
- $classdef =~ s/deprecated//g;
- $instdef =~ s/\s+(\*+)([^\/])/\1 \2/g;
- warn "Strange Class $inst\n" if (!$instdef && $debug);
-
- $classcnt++;
- $obj_el = addNameElem($ns_elem, 'object', $inst, $ns);
- $obj_el->setAttribute("get-type", "");
-
-
- $elem_table{lc($inst)} = $obj_el;
-
- # Check if the object is deprecated
- if ($instdef =~ /^deprecatedstruct/) {
- $obj_el->setAttribute("deprecated", "1");
- $instdef =~ s/deprecated//g;
- }
-
- # Extract parent and fields from the struct
- if ($instdef =~ /^struct/) {
- $instdef =~ /\{(.*)\}/;
- $fieldstr = $1;
- $fieldstr =~ s|/\*[^<].*?\*/||g;
- @fields = split(/;/, $fieldstr);
- addFieldElems($obj_el, 'private', @fields);
- if ($inst =~ /GdkWindow/) {
- $obj_el->setAttribute('parent', "GdkDrawable");
- } else {
- $obj_el->setAttribute('parent', $obj_el->firstChild->getAttribute('type'));
- }
- $obj_el->removeChild($obj_el->firstChild);
- } elsif ($instdef =~ /privatestruct/) {
- # just get the parent for private structs
- $instdef =~ /\{\s*(\w+)/;
- $obj_el->setAttribute('parent', "$1");
- }
-
- # Get the props from the class_init func.
- if ($initfunc) {
- parseInitFunc($obj_el, $initfunc);
- } else {
- warn "Don't have an init func for $inst.\n" if $debug;
- }
-
- # Get the interfaces from the class_init func.
- if ($typefunc) {
- if ($typefunc =~ /G_DEFINE_TYPE_WITH_CODE/) {
- parseTypeFuncMacro($obj_el, $typefunc);
- } else {
- parseTypeFunc($obj_el, $typefunc);
- }
- } else {
- warn "Don't have a GetType func for $inst.\n" if $debug;
- }
-
-}
-
-##############################################################
-# Parse the remaining types.
-##############################################################
-
-foreach $key (sort (keys (%types))) {
-
- $lasttype = $type = $key;
- while ($type && ($types{$type} !~ /struct/)) {
- $lasttype = $type;
- $type = $types{$type};
- }
-
- if ($types{$type} =~ /struct\s+(\w+)/) {
- $type = $1;
- if (exists($sdefs{$type})) {
- $def = $sdefs{$type};
- } else {
- $def = "privatestruct";
- }
- } elsif ($types{$type} =~ /struct/ && $type =~ /^$ns/) {
- $def = $types{$type};
- } else {
- #how to represent aliases in gidl?
- #$elem = addNameElem($ns_elem, 'alias', $key, $ns);
- #$elem->setAttribute('type', $lasttype);
- #warn "alias $key to $lasttype\n" if $debug;
- next;
- }
-
- # fixme: hack
- if ($key eq "GdkBitmap") {
- $struct_el = addNameElem($ns_elem, 'object', $key, $ns);
- } elsif (exists($boxdefs{$key})) {
- $struct_el = addNameElem($ns_elem, 'boxed', $key, $ns);
- } else {
- $struct_el = addNameElem($ns_elem, 'struct', $key, $ns);
- }
-
- $struct_el->setAttribute("get-type", "");
-
- if ($def =~ /^deprecated/) {
- $struct_el->setAttribute("deprecated", "1");
- $def =~ s/deprecated//g;
- }
-
- $elem_table{lc($key)} = $struct_el;
-
- $def =~ s/\s+/ /g;
- if ($def =~ /privatestruct/) {
- $struct_el->setAttribute('opaque', 'true');
- } else {
- $def =~ /\{(.+)\}/;
- addFieldElems($struct_el, 'public', split(/;/, $1));
- }
-}
-
-# really, _really_ opaque structs that aren't even defined in sources. Lovely.
-foreach $key (sort (keys (%ptrs))) {
- next if $ptrs{$key} !~ /struct\s+(\w+)/;
- $type = $1;
- $struct_el = addNameElem ($ns_elem, 'struct', $key, $ns);
- $struct_el->setAttribute('opaque', 'true');
- $elem_table{lc($key)} = $struct_el;
-}
-
-addFuncElems();
-addStaticFuncElems();
-
-# This should probably be done in a more generic way
-foreach $define (sort (keys (%defines))) {
- next if $define !~ /[A-Z]_STOCK_/;
- $string_el = addNameElem ($ns_elem, "constant", $define);
- $string_el->setAttribute('name', $define);
- $string_el->setAttribute('type', "utf8");
- $string_el->setAttribute('value', $defines{$define});
-}
-
-##############################################################
-# Output the tree
-##############################################################
-
-if ($ARGV[1]) {
- open(XMLFILE, ">$ARGV[1]") ||
- die "Couldn't open $ARGV[1] for writing.\n";
- print XMLFILE $doc->toString(1);
- close(XMLFILE);
-} else {
- print $doc->toString(1);
-}
-
-##############################################################
-# Generate a few stats from the parsed source.
-##############################################################
-
-$scnt = keys(%sdefs); $fcnt = keys(%fdefs); $tcnt = keys(%types);
-print "structs: $scnt enums: $ecnt callbacks: $cbcnt\n";
-print "funcs: $fcnt types: $tcnt classes: $classcnt\n";
-print "props: $propcnt childprops: $childpropcnt signals: $sigcnt\n\n";
-
-sub addFieldElems
-{
- my ($parent, $defaultaccess, @fields) = @_;
- my $access = $defaultaccess;
-
- foreach $field (@fields) {
- if ($field =~ m!/\*< (public|private) >.*\*/(.*)$!) {
- $access = $1;
- $field = $2;
- }
- next if ($field !~ /\S/);
- $field =~ s/\s+(\*+)/\1 /g;
- $field =~ s/(const\s+)?(\w+)\*\s+const\*/const \2\*/g;
- $field =~ s/(\w+)\s+const\s*\*/const \1\*/g;
- $field =~ s/const /const\-/g;
- $field =~ s/struct /struct\-/g;
- $field =~ s/.*\*\///g;
- next if ($field !~ /\S/);
-
- if ($field =~ /(\S+\s+\*?)\(\*\s*(.+)\)\s*\((.*)\)/) {
- # FIXME: how to handle function pointer fields with
- # anonymous type?
- #$elem = addNameElem($parent, 'callback', $2);
- #addReturnElem($elem, $1);
- #addParamsElem($elem, $3);
- } elsif ($field =~ /(unsigned )?(\S+)\s+(.+)/) {
- my $type = $1 . $2; $symb = $3;
- foreach $tok (split (/,\s*/, $symb)) {
- if ($tok =~ /(\w+)\s*\[(.*)\]/) {
- $elem = addFNameElem($parent, 'field', $1, "");
- #$elem->setAttribute('array_len', "$2");
- } elsif ($tok =~ /(\w+)\s*\:\s*(\d+)/) {
- $elem = addFNameElem($parent, 'field', $1, "");
- #$elem->setAttribute('bits', "$2");
- } else {
- $elem = addFNameElem($parent, 'field', $tok, "");
- }
- $elem->setAttribute('type', "$type");
-
- if ($access eq "public") {
- $elem->setAttribute("readable", "1");
- $elem->setAttribute("writable", "1");
- }
- }
- } else {
- die "$field\n";
- }
- }
-}
-
-sub addFuncElems
-{
- my ($obj_el, $inst, $prefix);
-
- $fcnt = keys(%fdefs);
-
- foreach $mname (sort (keys (%fdefs))) {
- next if ($mname =~ /^_/);
- $obj_el = "";
- $prefix = $mname;
- $prepend = undef;
- while ($prefix =~ /(\w+)_/) {
- $prefix = $key = $1;
- $key =~ s/_//g;
- # FIXME: lame Gdk API hack
- if ($key eq "gdkdraw") {
- $key = "gdkdrawable";
- $prepend = "draw_";
- }
- if (exists ($elem_table{$key})) {
- $prefix .= "_";
- $obj_el = $elem_table{$key};
- $inst = $key;
- last;
- } elsif (exists ($enums{$key}) && ($mname =~ /_get_type/)) {
- delete $fdefs{$mname};
- last;
- }
- }
- next if (!$obj_el);
-
- $mdef = delete $fdefs{$mname};
-
- # FIXME: gidl doesn't support constructors in structs, a bug?
- if ($mname =~ /$prefix(new)/ && $obj_el->nodeName eq "object") {
- $el = addMNameElem($obj_el, 'constructor', $mname, $prefix);
- if ($mdef =~ /^deprecated/) {
- $el->setAttribute("deprecated", "1");
- $mdef =~ s/deprecated//g;
- }
- $drop_1st = 0;
- } else {
- $el = addMNameElem($obj_el, 'method', $mname, $prefix, $prepend);
- if ($mdef =~ /^deprecated/) {
- $el->setAttribute("deprecated", "1");
- $mdef =~ s/deprecated//g;
- }
- $mdef =~ /(.*?)\w+\s*\(/;
- addReturnElem($el, $1);
- $mdef =~ /\(\s*(const)?\s*(\w+)/;
- # FIXME: gidl doesn't distinguish between static and instance methods
- # if (lc($2) ne $inst) {
- # $el->setAttribute("shared", "true");
- # $drop_1st = 0;
- # } else {
- # $drop_1st = 1;
- # }
- }
-
- parseParms ($el, $mdef, $drop_1st);
-
- # Don't add "free" to this regexp; that will wrongly catch all boxed types
- if ($mname =~ /$prefix(new|destroy|ref|unref)/ &&
- ($obj_el->nodeName eq "boxed" || $obj_el->nodeName eq "struct") &&
- $obj_el->getAttribute("opaque") ne "true") {
- $obj_el->setAttribute("opaque", "true");
- for my $field ($obj_el->getElementsByTagName("field")) {
- if (!$field->getAttribute("access")) {
- $field->setAttribute("access", "public");
- $field->setAttribute("writeable", "true");
- }
- }
- }
- }
-}
-
-sub parseParms
-{
- my ($el, $mdef, $drop_1st) = @_;
-
- $fmt_args = 0;
-
- if ($mdef =~ /G_GNUC_PRINTF.*\((\d+,\s*\d+)\s*\)/) {
- $fmt_args = $1;
- $mdef =~ s/\s*G_GNUC_PRINTF.*\)//;
- }
-
- if (($mdef =~ /\((.*)\)/) && ($1 ne "void")) {
- @parms = ();
- $parm = "";
- $pcnt = 0;
- foreach $char (split(//, $1)) {
- if ($char eq "(") {
- $pcnt++;
- } elsif ($char eq ")") {
- $pcnt--;
- } elsif (($pcnt == 0) && ($char eq ",")) {
- @parms = (@parms, $parm);
- $parm = "";
- next;
- }
- $parm .= $char;
- }
-
- if ($parm) {
- @parms = (@parms, $parm);
- }
- # @parms = split(/,/, $1);
- ($dump, @parms) = @parms if $drop_1st;
- if (@parms > 0) {
- addParamsElem($el, @parms);
- }
-
- if ($fmt_args != 0) {
- $fmt_args =~ /(\d+),\s*(\d+)/;
- $fmt = $1; $args = $2;
- ($params_el, @junk) = $el->getElementsByTagName ("parameters");
- (@params) = $params_el->getElementsByTagName ("parameter");
- $offset = 1 + $drop_1st;
- }
- }
-}
-
-sub addStaticFuncElems
-{
- my ($global_el, $ns_prefix);
-
- @mnames = sort (keys (%fdefs));
- $mcount = @mnames;
-
- return if ($mcount == 0);
-
- $ns_prefix = "";
- $global_el = "";
-
- for ($i = 0; $i < $mcount; $i++) {
- $mname = $mnames[$i];
- $prefix = $mname;
- next if ($prefix =~ /^_/);
-
- if ($ns_prefix eq "") {
- my (@toks) = split(/_/, $prefix);
- for ($j = 0; $j < @toks; $j++) {
- if (join ("", @toks[0 .. $j]) eq lc($ns)) {
- $ns_prefix = join ("_", @toks[0 .. $j]);
- last;
- }
- }
- next if ($ns_prefix eq "");
- }
- next if ($mname !~ /^$ns_prefix/);
-
- if ($mname =~ /($ns_prefix)_([a-zA-Z]+)_\w+/) {
- $classname = $2;
- $key = $prefix = $1 . "_" . $2 . "_";
- $key =~ s/_//g;
- $cnt = 1;
- if (exists ($enums{$key})) {
- $cnt = 1;
- } elsif ($classname ne "set" && $classname ne "get" &&
- $classname ne "scan" && $classname ne "find" &&
- $classname ne "add" && $classname ne "remove" &&
- $classname ne "free" && $classname ne "register" &&
- $classname ne "execute" && $classname ne "show" &&
- $classname ne "parse" && $classname ne "paint" &&
- $classname ne "string") {
- while ($mnames[$i+$cnt] =~ /$prefix/) { $cnt++; }
- }
- if ($cnt == 1) {
- $mdef = delete $fdefs{$mname};
-
- $el = addMNameElem($ns_elem, 'function', $mname, $ns_prefix);
- if ($mdef =~ /^deprecated/) {
- $el->setAttribute("deprecated", "1");
- $mdef =~ s/deprecated//g;
- }
- $mdef =~ /(.*?)\w+\s*\(/;
- addReturnElem($el, $1);
- #$el->setAttribute("shared", "true");
- parseParms ($el, $mdef, 0);
- next;
- } else {
- my $stname = $prefix;
- $stname =~ s/_$//;
-
- $class_el = $doc->createElement('struct');
- $class_el->setAttribute('name', StudlyCaps($stname));
- $ns_elem->appendChild($class_el);
-
- for ($j = 0; $j < $cnt; $j++) {
- $mdef = delete $fdefs{$mnames[$i+$j]};
-
- $el = addMNameElem($class_el, 'method', $mnames[$i+$j], $prefix);
- if ($mdef =~ /^deprecated/) {
- $el->setAttribute("deprecated", "1");
- $mdef =~ s/deprecated//g;
- }
- $mdef =~ /(.*?)\w+\s*\(/;
- addReturnElem($el, $1);
- #$el->setAttribute("shared", "true");
- parseParms ($el, $mdef, 0);
- }
- $i += ($cnt - 1);
- next;
- }
- }
- }
-}
-
-sub addNameElem
-{
- my ($node, $type, $cname, $prefix, $prepend) = @_;
-
- my $elem = $doc->createElement($type);
- $node->appendChild($elem);
- if ($cname) {
- $elem->setAttribute('name', $cname);
- $elem->setAttribute('type-name', $cname);
- }
- return $elem;
-}
-
-sub addFNameElem
-{
- my ($node, $type, $cname, $prefix, $prepend) = @_;
-
- my $elem = $doc->createElement($type);
- $node->appendChild($elem);
- if (defined $prefix) {
- my $match;
- if ($cname =~ /$prefix(\w+)/) {
- $match = $1;
- } else {
- $match = $cname;
- }
- if ($prepend) {
- $name = $prepend . $match;
- } else {
- $name = $match;
- }
- $elem->setAttribute('name', $name);
- }
- return $elem;
-}
-
-sub addMNameElem
-{
- my ($node, $type, $cname, $prefix, $prepend) = @_;
-
- my $elem = $doc->createElement($type);
- $node->appendChild($elem);
- if (defined $prefix) {
- my $match;
- if ($cname =~ /$prefix(\w+)/) {
- $match = $1;
- } else {
- $match = $cname;
- }
- if ($prepend) {
- $name = $prepend . $match;
- } else {
- $name = $match;
- }
- $name =~ s/^_//;
- $elem->setAttribute('name', $name);
- }
- if ($cname) {
- $elem->setAttribute('symbol', $cname);
- }
- return $elem;
-}
-
-sub addParamsElem
-{
- my ($parent, @params) = @_;
-
- my $parms_elem = $doc->createElement('parameters');
- $parent->appendChild($parms_elem);
- my $parm_num = 0;
- foreach $parm (@params) {
- $parm_num++;
- $parm =~ s/\s+(\*+)/\1 /g;
- my $out = $parm =~ s/G_CONST_RETURN/const/g;
- $parm =~ s/(const\s+)?(\w+)\*\s+const\*/const \2\*/g;
- $parm =~ s/(\*+)\s*const\s+/\1 /g;
- $parm =~ s/(\w+)\s+const\s*\*/const \1\*/g;
- $parm =~ s/const\s+/const-/g;
- $parm =~ s/unsigned\s+/unsigned-/g;
- if ($parm =~ /(.*)\(\s*\**\s*(\w+)\)\s+\((.*)\)/) {
- my $ret = $1; my $cbn = $2; my $params = $3;
- my $type = $parent->getAttribute('name') . StudlyCaps($cbn);
- $cb_elem = addNameElem($ns_elem, 'callback', $type, $ns);
- addReturnElem($cb_elem, $ret);
- if ($params && ($params ne "void")) {
- addParamsElem($cb_elem, split(/,/, $params));
- my $data_parm = $cb_elem->lastChild()->lastChild();
- if ($data_parm && $data_parm->getAttribute('type') eq "gpointer") {
- $data_parm->setAttribute('name', 'data');
- }
- }
- $parm_elem = $doc->createElement('parameter');
- $parm_elem->setAttribute('type', $type);
- $parm_elem->setAttribute('name', $cbn);
- $parms_elem->appendChild($parm_elem);
- next;
- } elsif ($parm =~ /\.\.\./) {
- # FIXME: GIDL doesn't seem to support ellipsis parameters yet
- # $parm_elem = $doc->createElement('parameter');
- # $parms_elem->appendChild($parm_elem);
- # $parm_elem->setAttribute('ellipsis', 'true');
- next;
- }
- $parm_elem = $doc->createElement('parameter');
- $parms_elem->appendChild($parm_elem);
- my $name = "";
- if ($parm =~ /struct\s+(\S+)\s+(\S+)/) {
- $parm_elem->setAttribute('type', $1);
- $name = $2;
- }elsif ($parm =~ /(unsigned )?(\S+)\s+(\S+)/) {
- $parm_elem->setAttribute('type', $1 . $2);
- $name = $3;
- } elsif ($parm =~ /(\S+)/) {
- $parm_elem->setAttribute('type', $1);
- $name = "arg" . $parm_num;
- }
- if ($name =~ /(\w+)\[.*\]/) {
- $name = $1;
- $parm_elem->setAttribute('type', $parm_elem->getAttribute('type') . '[]');
- }
- if ($out) {
- $parm_elem->setAttribute('direction', "out");
- }
- $parm_elem->setAttribute('name', $name);
- }
-}
-
-sub addReturnElem
-{
- my ($parent, $ret) = @_;
-
- $ret =~ s/(\w+)\s+const\s*\*/const \1\*/g;
- $ret =~ s/const|G_CONST_RETURN/const-/g;
- $ret =~ s/\s+//g;
- $ret =~ s/(const-)?(\w+)\*(const-)\*/const-\2\*\*/g;
-
- $ret =~ s/(boolean|int|double)\*$/\1\[\]/;
-
- my $ret_elem = $doc->createElement('return-type');
- $parent->appendChild($ret_elem);
- $ret_elem->setAttribute('type', $ret);
- return $ret_elem;
-}
-
-sub addPropElem
-{
- my ($spec, $node, $is_child) = @_;
- my ($name, $mode, $docs);
- $spec =~ /g_param_spec_(\w+)\s*\((.*)\s*\)\s*\)/;
- my $type = $1;
- my @params = split(/,/, $2);
-
- $name = $params[0];
- if ($defines{$name}) {
- $name = $defines{$name};
- } else {
- $name =~ s/\s*\"//g;
- }
-
- $mode = $params[$#params];
-
- if ($type =~ /boolean|float|double|^u?int|pointer|unichar/) {
- $type = "g$type";
- } elsif ($type =~ /string/) {
- $type = "gchar*";
- } elsif ($type =~ /boxed|object/) {
- $type = $params[$#params-1];
- $type =~ s/TYPE_//;
- $type =~ s/\s+//g;
- $type = StudlyCaps(lc($type));
- } elsif ($type =~ /enum|flags/) {
- $type = $params[$#params-2];
- $type =~ s/TYPE_//;
- $type =~ s/\s+//g;
- $type = StudlyCaps(lc($type));
- }
-
- $prop_elem = $doc->createElement($is_child ? "childprop" : "property");
- $node->appendChild($prop_elem);
- $prop_elem->setAttribute('name', $name);
-
- $prop_elem->setAttribute('readable', "1") if ($mode =~ /READ/);
- $prop_elem->setAttribute('writable', "1") if ($mode =~ /WRIT/);
- $prop_elem->setAttribute('construct', "1") if ($mode =~ /CONSTRUCT(?!_)/);
- $prop_elem->setAttribute('construct-only', "1") if ($mode =~ /CONSTRUCT_ONLY/);
-
- $prop_elem->setAttribute('type', $type);
-}
-
-sub parseTypeToken
-{
- my ($tok) = @_;
-
- if ($tok =~ /G_TYPE_(\w+)/) {
- my $type = $1;
- if ($type eq "NONE") {
- return "void";
- } elsif ($type eq "INT") {
- return "gint32";
- } elsif ($type eq "UINT") {
- return "guint32";
- } elsif ($type eq "ENUM" || $type eq "FLAGS") {
- return "gint32";
- } elsif ($type eq "STRING") {
- return "gchar*";
- } elsif ($type eq "OBJECT") {
- return "GObject*";
- } else {
- return "g" . lc ($type);
- }
- } else {
- $tok =~ s/_TYPE//;
- $tok =~ s/\|.*STATIC_SCOPE//;
- $tok =~ s/\W+//g;
- return StudlyCaps (lc($tok));
- }
-}
-
-sub addSignalElem
-{
- my ($spec, $class, $node) = @_;
- $spec =~ s/\n\s*//g; $class =~ s/\n\s*//g;
-
- $sig_elem = $doc->createElement('signal');
- $node->appendChild($sig_elem);
-
- if ($spec =~ /[\s]*\([\s]*\"([\w\-]+)\"/) {
- my $cname = $1;
- $cname =~ s/-/_/g;
- $sig_elem->setAttribute('name', $cname);
- }
- if ($spec =~ /_RUN_(\w+)/) {
- $sig_elem->setAttribute('when', $1);
- } else {
- $sig_elem->setAttribute('when', "LAST");
- }
-
- my $method = "";
- if ($spec =~ /_OFFSET\s*\(\w+,\s*(\w+)\)/) {
- $method = $1;
- } else {
- @args = split(/,/, $spec);
- my $rettype = parseTypeToken ($args[7]);
- addReturnElem($sig_elem, $rettype);
- $parmcnt = $args[8];
- $parmcnt =~ s/.*(\d+).*/\1/;
- $parms_elem = $doc->createElement('parameters');
- $sig_elem->appendChild($parms_elem);
- $parm_elem = $doc->createElement('parameter');
- $parms_elem->appendChild($parm_elem);
- $parm_elem->setAttribute('name', "inst");
- $parm_elem->setAttribute('type', "$inst*");
- for (my $idx = 0; $idx < $parmcnt; $idx++) {
- my $argtype = parseTypeToken ($args[9+$idx]);
- $parm_elem = $doc->createElement('parameter');
- $parms_elem->appendChild($parm_elem);
- $parm_elem->setAttribute('name', "p$idx");
- $parm_elem->setAttribute('type', $argtype);
- }
- return $class;
- }
-
- if ($class =~ /;\s*(\/\*< public >\*\/)?(G_CONST_RETURN\s+)?(\w+\s*\**)\s*\(\s*\*\s*$method\)\s*\((.*?)\);/) {
- $ret = $3; $parms = $4;
- addReturnElem($sig_elem, $ret);
- if ($parms && ($parms ne "void")) {
- addParamsElem($sig_elem, split(/,/, $parms));
- }
- $class =~ s/;\s*(\/\*< public >\*\/)?(G_CONST_RETURN\s+)?\w+\s*\**\s*\(\s*\*\s*$method\)\s*\(.*?\);/;/;
- } else {
- #die "$method $class";
- return $class;
- }
-
- return $class;
-}
-
-sub addVirtualMethods
-{
- my ($class, $node) = @_;
- $class =~ s/\n\s*//g;
- $class =~ s/\/\*.*?\*\///g;
-
- while ($class =~ /;\s*(G_CONST_RETURN\s+)?(\S+\s*\**)\s*\(\s*\*\s*(\w+)\)\s*\((.*?)\);/) {
- $ret = $1 . $2; $cname = $3; $parms = $4;
- if ($cname !~ /reserved/) {
- $vm_elem = $doc->createElement('vfunc');
- $node->appendChild($vm_elem);
- $vm_elem->setAttribute('name', $cname);
- addReturnElem($vm_elem, $ret);
- if ($parms && ($parms ne "void")) {
- addParamsElem($vm_elem, split(/,/, $parms));
- }
- }
- $class =~ s/;\s*(G_CONST_RETURN\s+)?\S+\s*\**\s*\(\s*\*\s*\w+\)\s*\(.*?\);/;/;
- }
-}
-
-sub addImplementsElem
-{
- my ($spec, $node) = @_;
- $spec =~ s/\n\s*//g;
- if ($spec =~ /,\s*(\w+)_TYPE_(\w+),/) {
- $impl_elem = $doc->createElement('interface');
- $name = StudlyCaps (lc ("$1_$2"));
- $impl_elem->setAttribute ("name", "$name");
- $node->appendChild($impl_elem);
- }
-}
-
-
-sub parseInitFunc
-{
- my ($obj_el, $initfunc) = @_;
-
- my @init_lines = split (/\n/, $initfunc);
-
- my $linenum = 0;
- while ($linenum < @init_lines) {
-
- my $line = $init_lines[$linenum];
-
- if ($line =~ /#define/) {
- # FIXME: This ignores the bool helper macro thingie.
- } elsif ($line =~ /g_object_(class|interface)_install_prop/) {
- my $prop = $line;
- do {
- $prop .= $init_lines[++$linenum];
- } until ($init_lines[$linenum] =~ /\)\s*;/);
- addPropElem ($prop, $obj_el, 0);
- $propcnt++;
- # FIXME: how to handle childprops in GIDL?
- #} elsif ($line =~ /gtk_container_class_install_child_property/) {
- # my $prop = $line;
- # do {
- # $prop .= $init_lines[++$linenum];
- # } until ($init_lines[$linenum] =~ /\)\s*;/);
- # addPropElem ($prop, $obj_el, 1);
- # $childpropcnt++;
- } elsif ($line =~ /\bg.*_signal_new/) {
- my $sig = $line;
- do {
- $sig .= $init_lines[++$linenum];
- } until ($init_lines[$linenum] =~ /;/);
- $classdef = addSignalElem ($sig, $classdef, $obj_el);
- $sigcnt++;
- }
- $linenum++;
- }
-
- addVirtualMethods ($classdef, $obj_el);
-}
-
-sub parseTypeFuncMacro
-{
- my ($obj_el, $typefunc) = @_;
-
- $impls_node = undef;
- while ($typefunc =~ /G_IMPLEMENT_INTERFACE\s*\(\s*(\w+)/) {
- $iface = $1;
- if (not $impls_node) {
- $impls_node = $doc->createElement ("implements");
- $obj_el->appendChild ($impls_node);
- }
- addImplementsElem ($prop, $impl_node);
- if ($iface =~ /(\w+)_TYPE_(\w+)/) {
- $impl_elem = $doc->createElement('interface');
- $name = StudlyCaps (lc ("$1_$2"));
- $impl_elem->setAttribute ("name", "$name");
- if ($name !~ /GtkFileChooserEmbed/) {
- $impls_node->appendChild($impl_elem);
- }
- }
- $typefunc =~ s/G_IMPLEMENT_INTERFACE\s*\(.*?\)//;
- }
-}
-
-sub parseTypeFunc
-{
- my ($obj_el, $typefunc) = @_;
-
- my @type_lines = split (/\n/, $typefunc);
-
- my $linenum = 0;
- $impl_node = undef;
- while ($linenum < @type_lines) {
-
- my $line = $type_lines[$linenum];
-
- if ($line =~ /#define/) {
- # FIXME: This ignores the bool helper macro thingie.
- } elsif ($line =~ /g_type_add_interface_static/) {
- my $prop = $line;
- do {
- $prop .= $type_lines[++$linenum];
- } until ($type_lines[$linenum] =~ /;/);
- if (not $impl_node) {
- $impl_node = $doc->createElement ("implements");
- $obj_el->appendChild ($impl_node);
- }
- addImplementsElem ($prop, $impl_node);
- }
- $linenum++;
- }
-}
-
-##############################################################
-# Converts a dash or underscore separated name to StudlyCaps.
-##############################################################
-
-%num2txt = ('1', "One", '2', "Two", '3', "Three", '4', "Four", '5', "Five",
- '6', "Six", '7', "Seven", '8', "Eight", '9', "Nine", '0', "Zero");
-
-sub StudlyCaps
-{
- my ($symb) = @_;
- $symb =~ s/^([a-z])/\u\1/;
- $symb =~ s/^(\d)/\1_/;
- $symb =~ s/[-_]([a-z])/\u\1/g;
- $symb =~ s/[-_](\d)/\1/g;
- $symb =~ s/^2/Two/;
- $symb =~ s/^3/Three/;
- return $symb;
-}
-
projects / thirdparty / vala.git / commitdiff
