Update embedded kalyptus installation

1 files changed, 570 insertions, 0 deletions

diff --git a/kalyptus/kalyptusCxxToECMA.pm b/kalyptus/kalyptusCxxToECMA.pm
new file mode 100644
index 0000000..5b41973
--- /dev/null
+++ b/kalyptus/kalyptusCxxToECMA.pm
@@ -0,0 +1,570 @@
+#***************************************************************************
+#            kalyptusCxxToEMA.pm -  Generates class info for ECMA bindings in KDE
+#                             -------------------
+#    begin                : Fri Jan 25 12:00:00 2000
+#    copyright            : (C) 2002 Lost Highway Ltd. All Rights Reserved.
+#    email                : david@mandrakesoft.com
+#    author               : David Faure.
+#***************************************************************************/
+
+#/***************************************************************************
+# *                                                                         *
+# *   This program is free software; you can redistribute it and/or modify  *
+# *   it under the terms of the GNU General Public License as published by  *
+# *   the Free Software Foundation; either version 2 of the License, or     *
+# *   (at your option) any later version.                                   *
+# *                                                                         *
+#***************************************************************************/
+
+package kalyptusCxxToECMA;
+
+use File::Path;
+use File::Basename;
+
+use Carp;
+use Ast;
+use kdocAstUtil;
+use kdocUtil;
+use Iter;
+use kalyptusDataDict;
+
+use strict;
+no strict "subs";
+
+use vars qw/
+	$libname $rootnode $outputdir $opt $debug
+	%skippedClasses %hasHashTable %hasFunctions %hasBridge %hasGet %hasPut/;
+
+sub writeDoc
+{
+	( $libname, $rootnode, $outputdir, $opt ) = @_;
+
+	print STDERR "Starting writeDoc for $libname...\n";
+
+	$debug = $main::debuggen;
+
+	mkpath( $outputdir ) unless -f $outputdir;
+
+	# Preparse everything, to prepare some additional data in the classes and methods
+	Iter::LocalCompounds( $rootnode, sub { preParseClass( shift ); } );
+
+	print STDERR "Writing generateddata.cpp...\n";
+
+	writeInheritanceFile($rootnode);
+
+	print STDERR "Done.\n";
+}
+
+=head2 preParseClass
+	Called for each class
+=cut
+sub preParseClass
+{
+	my( $classNode ) = @_;
+	my $className = join( "::", kdocAstUtil::heritage($classNode) );
+
+	if ( $className =~ /Proto$/ ) {
+	    my $c = $className;
+	    $c =~ s/Proto$//;
+	    #print STDERR "$c -> $className\n";
+	    $hasFunctions{$c} = $className; # Associate class -> proto
+	    #print STDERR "Found proto $className -> skipping\n";
+	    $skippedClasses{$className} = 1; # Skip proto
+	    return;
+	}
+
+	if( $classNode->{Access} eq "private" ||
+	    $classNode->{Access} eq "protected" || # e.g. TQPixmap::TQPixmapData
+	    exists $classNode->{Tmpl} ||
+	    $className eq 'KJS' || $className eq 'KSVG' || # namespaces
+	    $className =~ /^KSVG::KSVG/ || $className eq 'KSVG::CachedGlyph' || # Not DOM classes
+	    $className eq 'KSVG::ImageStreamMap' ||
+	    $className eq 'KSVG::SVGBBoxTarget' ||
+	    $className eq 'KSVG::SVGLoader' ||
+	    $className eq 'KSVG::SVGElementImpl::MouseEvent' ||
+		$className eq 'KSVG::SVGRegisteredEventListener' ||
+	    $classNode->{NodeType} eq 'union' # Skip unions for now, e.g. TQPDevCmdParam
+	  ) {
+	    print STDERR "Skipping $className "; #if ($debug);
+
+	    #print STDERR "(nothing in it)\n" if ( $#{$classNode->{Kids}} < 0 );
+	    if ( exists $classNode->{Tmpl} ) {
+		print STDERR "(template)\n";
+	    } elsif ( $classNode->{Access} eq "private" or $classNode->{Access} eq "protected" ) {
+	        print STDERR "(not public)\n";
+	    } elsif ( $classNode->{NodeType} eq 'union') {
+		print STDERR "(union)\n";
+	    } elsif ( $className =~ /^KSVG::KSVG/ || $className eq 'KSVG::CachedGlyph' ) {
+		print STDERR "(not a DOM class)\n";
+	    } else {
+		print STDERR "\n";
+	    }
+	    $skippedClasses{$className} = 1;
+	    #delete $classNode->{Compound}; # Cheat, to get it excluded from Iter::LocalCompounds
+            # Can't do that, it's recursive (KSVG::* disappears)
+	    return;
+	}
+
+    # Iterate over methods
+    Iter::MembersByType ( $classNode, undef,
+			  sub {	my ($classNode, $methodNode ) = @_;
+
+        if ( $methodNode->{NodeType} eq 'method' ) {
+	    if ( $methodNode->{astNodeName} eq 'get' ) {
+		$hasGet{$className} = '1';
+	    } elsif ( $methodNode->{astNodeName} eq 'getforward' ) {
+		$hasGet{$className} = '2';
+	    } elsif ( $methodNode->{astNodeName} eq 'put' ) {
+		$hasPut{$className} = '1';
+	    } elsif ( $methodNode->{astNodeName} eq 'putforward' ) {
+		$hasPut{$className} = '2';
+	    } elsif ( $methodNode->{astNodeName} eq 'getValueProperty' ) {
+		$hasHashTable{$className} = '1';
+	    } elsif ( $methodNode->{astNodeName} eq 'bridge' ) {
+		$hasBridge{$className} = '1';
+	    }
+
+	}
+			    } );
+}
+
+# List of all super-classes for a given class
+sub superclass_list($)
+{
+    my $classNode = shift;
+    my @super;
+    Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
+			push @super, @_[0];
+			push @super, superclass_list( @_[0] );
+		     }, undef );
+    return @super;
+}
+
+# Adds the header for node $1 to be included in $2 if not already there
+# Prints out debug stuff if $3
+sub addIncludeForClass($$$)
+{
+    my ( $node, $addInclude, $debugMe ) = @_;
+    my $sourcename = $node->{Source}->{astNodeName};
+    $sourcename =~ s!.*/(.*)!$1!m;
+    unless ( defined $addInclude->{$sourcename} ) {
+	print "  Including $sourcename\n" if ($debugMe);
+	$addInclude->{$sourcename} = 1;
+    }
+    else { print "  $sourcename already included.\n" if ($debugMe); }
+}
+
+=head2
+	Write out the smokedata.cpp file containing all the arrays.
+=cut
+
+sub writeInheritanceFile($) {
+    my $rootnode = shift;
+
+    # Make list of classes
+    my %allIncludes; # list of all header files for all classes
+    my @classlist;
+    push @classlist, ""; # Prepend empty item for "no class"
+    Iter::LocalCompounds( $rootnode, sub {
+	my $classNode = $_[0];
+	my $className = join( "::", kdocAstUtil::heritage($classNode) );
+        return if ( defined $skippedClasses{$className} );
+	push @classlist, $className;
+	$classNode->{ClassIndex} = $#classlist;
+	addIncludeForClass( $classNode, \%allIncludes, undef );
+    } );
+
+    my %classidx = do { my $i = 0; map { $_ => $i++ } @classlist };
+    #foreach my $debugci (keys %classidx) {
+    # print STDERR "$debugci: $classidx{$debugci}\n";
+    #}
+
+    my $file = "$outputdir/generateddata.cpp";
+    open OUT, ">$file" or die "Couldn't create $file\n";
+    print OUT "#include <ksvg_lookup.h>\n";
+    print OUT "#include <ksvg_ecma.h>\n";
+
+    foreach my $incl (keys %allIncludes) {
+	die if $incl eq '';
+	print OUT "#include <$incl>\n";
+    }	
+
+    print OUT "\n";
+
+    # Prepare descendants information for each class
+    my %descendants; # classname -> list of descendant nodes
+    #my $SVGElementImplNode;
+    Iter::LocalCompounds( $rootnode, sub {
+	my $classNode = shift;
+	my $className = join( "::", kdocAstUtil::heritage($classNode) );
+	# Get _all_ superclasses (up any number of levels)
+	# and store that $classNode is a descendant of $s
+	my @super = superclass_list($classNode);
+	for my $s (@super) {
+	    my $superClassName = join( "::", kdocAstUtil::heritage($s) );
+	    Ast::AddPropList( \%descendants, $superClassName, $classNode );
+	}
+	# Found SVGElementImpl itself
+	if ( $className eq 'KSVG::SVGElementImpl' ) {
+	    $classNode->{IsSVGElement} = '1';
+	    #$SVGElementImplNode = $classNode;
+	}
+    } );
+
+    # Mark all SVGElementImpl descendants as svg elements
+    if ( defined $descendants{'KSVG::SVGElementImpl'} ) {
+	my @desc = @{$descendants{'KSVG::SVGElementImpl'}};
+	for my $d (@desc) {
+	    $d->{IsSVGElement} = '1' ;
+	    print STDERR $d->{astNodeName}. " is an SVGElement\n" if($debug);
+	}
+    }
+
+    # Propagate $hasPut and $hasGet 
+    Iter::LocalCompounds( $rootnode, sub {
+	my $classNode = shift;
+	my $className = join( "::", kdocAstUtil::heritage($classNode) );
+	if ( defined $descendants{$className} ) {
+	    my @desc = @{$descendants{$className}};
+	    for my $d (@desc) {
+		my $c = join( "::", kdocAstUtil::heritage($d) );
+		$hasPut{$c} = '2' if (!$hasPut{$c} && $hasPut{$className});
+		$hasGet{$c} = '2' if (!$hasGet{$c} && $hasGet{$className});
+	    }
+	}
+
+        # This code prints out the base classes - useful for KSVG_BASECLASS_GET
+	if ( 0 && defined $descendants{$className} ) {
+	    my $baseClass = 1;
+	    Iter::Ancestors( $classNode, $rootnode, sub { # called if no ancestors
+			     }, undef, sub { # called for each ancestor
+			     my $superClassName = join( "::", kdocAstUtil::heritage($_[0]) );
+			     $baseClass = 0 if ( $superClassName ne '' ); # happens with unknown parents;
+			 } );
+           print STDERR "$className is a base class.\n" if ($baseClass);
+	}
+
+    } );
+
+	# Write namespaces
+	print OUT "using namespace KSVG;\n";
+	print OUT "using namespace KJS;\n\n";
+	
+    # Write classInfos
+    print OUT "// For all classes with generated data: the ClassInfo\n";
+    Iter::LocalCompounds( $rootnode, sub {
+	my $classNode = shift;
+	my $className = join( "::", kdocAstUtil::heritage($classNode) );
+
+	# We use namespace declartions!
+	my $printName = $className;
+	$printName =~ s/KSVG:://;
+
+	# Write tagNames
+	if ($hasBridge{$className}) {
+		my $tagName = $printName;
+		$tagName =~ s/SVG//;
+		$tagName =~ s/ElementImpl//;
+
+		$tagName = lcfirst($tagName);
+
+		# Special cases, otherwhise they'd be "tRef" / "tSpan" / "sVG"
+		if($printName eq "SVGTRefElementImpl" or
+		   $printName eq "SVGTSpanElementImpl" or
+		   $printName eq "SVGSVGElementImpl") {
+			$tagName =~ tr/A-Z/a-z/;
+		}
+
+		while($tagName =~ /[A-Z]/g) {
+				# Special case: color-profile instead of ie. animateColor/animateMotion
+				if($printName eq "SVGColorProfileElementImpl") {
+					$tagName = substr($tagName, 0, pos($tagName) - 1) . "-" . lc($&) . substr($tagName, pos($tagName));
+				}
+		}
+
+		# Special cases: gradient & poly aren't element! 
+		if($tagName ne "" and $tagName ne "gradient" and $tagName ne "poly") {
+			print OUT "const DOM::DOMString ${printName}::s_tagName = \"$tagName\";\n";
+		}
+	}
+
+	# Skip classes without KSVG_GENERATEDDATA
+	if (!$hasGet{$className} && !$skippedClasses{$className}) {
+	    $skippedClasses{$className} = '1' ;
+	    print STDERR "Skipping $className, no get()\n";
+	}
+
+        return if ( defined $skippedClasses{$className} );
+
+	my $ok = $hasHashTable{$className};
+	print STDERR "$className has get() but no hashtable - TODO\n" if (!$ok && $hasGet{$className} eq '1');
+
+	print OUT "const ClassInfo ${printName}::s_classInfo = {\"$className\",0,";
+	if ($ok) {
+	    print OUT "\&${printName}::s_hashTable";
+	} else {
+	    print OUT "0";
+	}
+        print OUT ",0};\n";
+	#die "problem with $className" unless defined $classinherit{$className};
+	#print OUT "const short int ${className}::s_inheritanceIndex = $classinherit{$className};\n";
+    } );
+
+    # Generated methods
+    print OUT "\n";
+    Iter::LocalCompounds( $rootnode, sub {
+	my $classNode = shift;
+	my $className = join( "::", kdocAstUtil::heritage($classNode) );
+        return if ( defined $skippedClasses{$className} );
+
+	# We use namespace declartions!
+	my $printName = $className;
+	$printName =~ s/KSVG:://;
+
+	my $paramsUsed = 0;
+	
+	print OUT "bool ${printName}::hasProperty(ExecState *p1,const Identifier &p2) const\n";
+	print OUT "{\n";
+
+	if ($hasHashTable{$className}) {
+	    print OUT "    const HashEntry *e = Lookup::findEntry(\&${printName}::s_hashTable,p2);\n";
+	    print OUT "    if(e) return true;\n";
+	    $paramsUsed=1;
+	}
+	# Now look in prototype, if it exists
+	if ( defined $hasFunctions{$className} ) {
+
+		# We use namespace declartions!
+		my $output = $hasFunctions{$className};
+		$output =~ s/KSVG:://;
+
+	    print OUT "    Object proto = " . $output . "::self(p1);\n";
+	    print OUT "    if(proto.hasProperty(p1,p2)) return true;\n";
+	}
+	# For each direct ancestor...
+	Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
+			     my $superClassName = join( "::", kdocAstUtil::heritage($_[0]) );
+				
+				 # We use namespace declartions!
+				 my $printSuperClassName = $superClassName;
+				 $printSuperClassName =~ s/KSVG:://;
+
+			     if ( $superClassName ne '' ) { # happens with unknown parents
+			       return if ( defined $skippedClasses{$superClassName} );
+			        print OUT "    if(${printSuperClassName}::hasProperty(p1,p2)) return true;\n";
+				$paramsUsed=2;
+			     }
+		    }, undef );
+	if ($paramsUsed == 1 && !defined $hasFunctions{$className}){
+	    print OUT "    Q_UNUSED(p1);\n";
+	}
+	if ($paramsUsed == 0){
+	    print OUT "    Q_UNUSED(p1); Q_UNUSED(p2);\n";
+	}
+        print OUT "    return false;\n";
+        print OUT "}\n\n";
+
+	my @ancestorsWithGet;
+	Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
+			     my $superClassName = join( "::", kdocAstUtil::heritage($_[0]) );
+			     if ( $superClassName ne '' # happens with unknown parents
+				  && ! defined $skippedClasses{$superClassName} ) {
+				 if ( $hasGet{$superClassName} ) {
+				     push @ancestorsWithGet, $superClassName;
+				 }
+			     }
+		    }, undef );
+
+	if ($hasHashTable{$className}) {
+	    die unless $hasGet{$className};
+	    if ( $hasGet{$className} eq '1' ) {
+		print OUT "Value ${printName}::get(GET_METHOD_ARGS) const\n";
+		print OUT "{\n";
+		if ( defined $hasFunctions{$className} ) {
+
+			# We use namespace declartions!
+			my $output = $hasFunctions{$className};
+			$output =~ s/KSVG:://;
+
+		    print OUT "    return lookupGet<${output}Func,${printName}>(p1,p2,&s_hashTable,this,p3);\n";
+		} else {
+		    print OUT "    return lookupGetValue<${printName}>(p1,p2,&s_hashTable,this,p3);\n";
+		}
+		print OUT "}\n\n";
+
+		if ( defined $hasFunctions{$className} ) {
+
+			# We use namespace declartions!
+			my $output = $hasFunctions{$className};
+			$output =~ s/KSVG:://;
+
+		    my $methodName = "${output}Func::cast";
+		    my $const = 'const';
+		    # Special case - we also need that code in toNode()
+		    if ($methodName eq 'SVGDOMNodeBridgeProtoFunc::cast') {
+			print OUT "${printName} *$methodName(const ObjectImp *p1) const\n";
+			$methodName = 'KSVG::toNodeBridge';
+			print OUT "{\n";
+			print OUT "    return $methodName(p1);\n";
+			print OUT "}\n\n";
+			$const = '';
+		    }
+
+		    # Type resolver for the Func class
+		    print OUT "${printName} *$methodName(const ObjectImp *p1) $const\n";
+		    print OUT "{\n";
+		    my @toTry;
+		    push @toTry, $classNode;
+		    if ( defined $descendants{$className} ) {
+			push @toTry, @{$descendants{$className}};
+		    }
+		    foreach my $d (@toTry) {
+			my $c = join( "::", kdocAstUtil::heritage($d) );
+
+			# We use namespace declartions!
+			my $d = $c;
+			$d =~ s/KSVG:://;
+			
+			print OUT "    { const KSVGBridge<$d> *test = dynamic_cast<const KSVGBridge<$d> * >(p1);\n";
+			print OUT "    if(test) return test->impl(); }\n";
+		    }
+		    print OUT "    return 0;\n";
+		    print OUT "}\n\n";
+		}
+	    }
+	}
+
+	my $methodName = $hasGet{$className} eq '1' ? 'getInParents' : 'get';
+        print OUT "Value ${printName}::$methodName(GET_METHOD_ARGS) const\n";
+        print OUT "{\n";
+	my $paramsUsed = 0;
+	# Now look in prototype, if it exists
+	if ( defined $hasFunctions{$className} ) {
+	    # Prototype exists (because the class has functions)
+
+		# We use namespace declartions!
+		my $output = $hasFunctions{$className};
+		$output =~ s/KSVG:://;
+
+	    print OUT "    Object proto = " . $output . "::self(p1);\n";
+	    print OUT "    if(proto.hasProperty(p1,p2)) return proto.get(p1,p2);\n"; ## TODO get() directly
+	    $paramsUsed = 1;
+	}
+	foreach my $anc (@ancestorsWithGet) {
+		# We use namespace declartions!
+		my $printAnc = $anc;
+		$printAnc =~ s/KSVG:://;
+
+		print OUT "    if(${printAnc}::hasProperty(p1,p2)) return ${printAnc}::get(p1,p2,p3);\n"; ## TODO get() directly
+	    $paramsUsed = 2;
+	}
+
+	if ($paramsUsed == 0 ){
+	    print OUT "    Q_UNUSED(p1); Q_UNUSED(p2); Q_UNUSED(p3);\n";
+	} elsif ( $paramsUsed == 1 ) {
+	    print OUT "    Q_UNUSED(p3);\n";
+	}
+        print OUT "    return Undefined();\n";
+        print OUT "}\n\n";
+
+	if ( $hasPut{$className} )
+	{
+	    if ( $hasPut{$className} eq '1' ) {
+		if ($hasHashTable{$className}) {
+		    print OUT "bool ${printName}::put(PUT_METHOD_ARGS)\n";
+		    print OUT "{\n";
+		    print OUT "    return lookupPut<${printName}>(p1,p2,p3,p4,&s_hashTable,this);\n";
+		    print OUT "}\n\n";
+		}
+		print OUT "bool ${printName}::putInParents(PUT_METHOD_ARGS)\n";
+	    } else { # forward put
+		print OUT "bool ${printName}::put(PUT_METHOD_ARGS)\n";
+	    }
+	    print OUT "{\n";
+	    my $paramsUsed = 0;
+	    Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
+			     my $superClassName = join( "::", kdocAstUtil::heritage($_[0]) );
+
+				 # We use namespace declartions!
+				 my $printSuperClassName = $superClassName;
+				 $printSuperClassName =~ s/KSVG:://;
+
+			     if ( $superClassName ne '' ) { # happens with unknown parents
+				 if ( $hasPut{$superClassName} ) {
+				     print OUT "    if(${printSuperClassName}::hasProperty(p1,p2)) {\n";
+				     print OUT "        ${printSuperClassName}::put(p1,p2,p3,p4);\n";
+				     print OUT "        return true;\n";
+				     print OUT "    }\n";
+				     $paramsUsed=1;
+				 }
+			     }
+		    }, undef );
+	    if (!$paramsUsed){
+		print OUT "    Q_UNUSED(p1); Q_UNUSED(p2); Q_UNUSED(p3); Q_UNUSED(p4);\n";
+	    }
+	    print OUT "    return false;\n";
+	    print OUT "}\n\n";
+	}
+
+	# Write prototype method
+	print OUT "Object ${printName}::prototype(ExecState *p1) const\n";
+	print OUT "{\n";
+	if ( defined $hasFunctions{$className} ) {
+
+		# We use namespace declartions!
+		my $output = $hasFunctions{$className};
+		$output =~ s/KSVG:://;
+
+	    # Prototype exists (because the class has functions)
+	    print OUT "    if(p1) return " . $output . "::self(p1);\n";
+	} else {
+	    # Standard Object prototype
+	    print OUT "    if(p1) return p1->interpreter()->builtinObjectPrototype();\n";
+	}
+	print OUT "    return Object::dynamicCast(Null());\n"; # hmm
+
+        print OUT "}\n\n";
+
+	# Process classes only with KSVG_BRIDGE
+	if ($hasBridge{$className}) {
+
+		#print STDERR "Writing bridge() for $className...\n";
+		
+		# Write bridge method
+		print OUT "ObjectImp *${printName}::bridge(ExecState *p1) const\n";
+		print OUT "{\n";
+		
+		if ($hasPut{$className})
+		{
+			print OUT "    return new KSVGRWBridge<${printName}>(p1,const_cast<${printName} *>(this));\n";
+		}
+		else
+		{
+			print OUT "    return new KSVGBridge<${printName}>(p1,const_cast<${printName} *>(this));\n";
+		}
+		
+		print OUT "}\n\n";
+	}
+
+	if ($hasGet{$className}) {
+		# Write cache method
+		print OUT "Value ${printName}::cache(ExecState *p1) const\n";
+		print OUT "{\n";
+		
+		if ($hasPut{$className})
+		{
+			print OUT "    return KJS::Value(cacheDOMObject<${printName},KSVGRWBridge<${printName}> >(p1,const_cast<${printName} *>(this)));\n";
+		}
+		else
+		{
+			print OUT "    return KJS::Value(cacheDOMObject<${printName},KSVGBridge<${printName}> >(p1,const_cast<${printName} *>(this)));\n";
+		}
+		
+		print OUT "}\n\n";
+	}
+	
+	} );
+
+}
+
+1;