summaryrefslogtreecommitdiffstats
path: root/dcop/dcopidlng/kalyptusCxxToDcopIDL.pm
diff options
context:
space:
mode:
authortoma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da>2009-11-25 17:56:58 +0000
committertoma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da>2009-11-25 17:56:58 +0000
commitce4a32fe52ef09d8f5ff1dd22c001110902b60a2 (patch)
tree5ac38a06f3dde268dc7927dc155896926aaf7012 /dcop/dcopidlng/kalyptusCxxToDcopIDL.pm
downloadtdelibs-ce4a32fe52ef09d8f5ff1dd22c001110902b60a2.tar.gz
tdelibs-ce4a32fe52ef09d8f5ff1dd22c001110902b60a2.zip
Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features.
BUG:215923 git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdelibs@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da
Diffstat (limited to 'dcop/dcopidlng/kalyptusCxxToDcopIDL.pm')
-rw-r--r--dcop/dcopidlng/kalyptusCxxToDcopIDL.pm213
1 files changed, 213 insertions, 0 deletions
diff --git a/dcop/dcopidlng/kalyptusCxxToDcopIDL.pm b/dcop/dcopidlng/kalyptusCxxToDcopIDL.pm
new file mode 100644
index 000000000..8a2988f06
--- /dev/null
+++ b/dcop/dcopidlng/kalyptusCxxToDcopIDL.pm
@@ -0,0 +1,213 @@
+#***************************************************************************
+# kalyptusCxxToDcopIDL.pm - Generates idl from dcop headers
+# -------------------
+# begin : Fri Jan 25 12:00:00 2000
+# copyright : (C) 2003 Alexander Kellett
+# email : lypanov@kde.org
+# author : Alexander Kellett
+#***************************************************************************/
+
+#/***************************************************************************
+# * *
+# * 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 kalyptusCxxToDcopIDL;
+
+use File::Path;
+use File::Basename;
+use Carp;
+use Ast;
+use kdocAstUtil;
+use kdocUtil;
+use Iter;
+
+use strict;
+no strict "subs";
+
+use vars qw/$libname $rootnode $outputdir $opt $debug/;
+
+BEGIN
+{
+}
+
+sub writeDoc
+{
+ ( $libname, $rootnode, $outputdir, $opt ) = @_;
+
+ $debug = $main::debuggen;
+
+ print STDERR "Preparsing...\n";
+
+ # Preparse everything, to prepare some additional data in the classes and methods
+ Iter::LocalCompounds( $rootnode, sub { preParseClass( shift ); } );
+
+ kdocAstUtil::dumpAst($rootnode) if ($debug);
+
+ print STDERR "Writing dcopidl...\n";
+
+ print STDOUT "<!DOCTYPE DCOP-IDL><DCOP-IDL>\n";
+
+ print STDOUT "<SOURCE>".@{$rootnode->{Sources}}[0]->{astNodeName}."</SOURCE>\n";
+
+ print STDOUT map { "<INCLUDE>$_</INCLUDE>\n" } @main::includes_list;
+
+ Iter::LocalCompounds( $rootnode, sub {
+ my ($node) = @_;
+
+ my ($methodCode) = generateAllMethods( $node );
+ my $className = join "::", kdocAstUtil::heritage($node);
+
+ if ($node->{DcopExported}) {
+ print STDOUT "<CLASS>\n";
+ print STDOUT " <NAME>$className</NAME>\n";
+ print STDOUT " <LINK_SCOPE>$node->{Export}</LINK_SCOPE>\n" if ($node->{Export});
+ print STDOUT join("\n", map { " <SUPER>$_</SUPER>"; } grep { $_ ne "Global"; }
+ map {
+ my $name = $_->{astNodeName};
+ $name =~ s/</&lt;/;
+ $name =~ s/>/&gt;/;
+ my $tmpl = $_->{TmplType};
+ $tmpl =~ s/</&lt;/;
+ $tmpl =~ s/>/&gt;/;
+ $tmpl ? "$name&lt;<TYPE>$tmpl</TYPE>&gt;" : $name;
+ } @{$node->{InList}}) . "\n";
+ print STDOUT $methodCode;
+
+ print STDOUT "</CLASS>\n";
+ }
+ });
+
+ print STDOUT "</DCOP-IDL>\n";
+
+ print STDERR "Done.\n";
+}
+
+=head2 preParseClass
+ Called for each class
+=cut
+sub preParseClass
+{
+ my( $classNode ) = @_;
+ my $className = join( "::", kdocAstUtil::heritage($classNode) );
+
+ if( $#{$classNode->{Kids}} < 0 ||
+ $classNode->{Access} eq "private" ||
+ $classNode->{Access} eq "protected" || # e.g. QPixmap::QPixmapData
+ exists $classNode->{Tmpl} ||
+ $classNode->{NodeType} eq 'union' # Skip unions for now, e.g. QPDevCmdParam
+ ) {
+ print STDERR "Skipping $className\n" if ($debug);
+ print STDERR "Skipping union $className\n" if ( $classNode->{NodeType} eq 'union');
+ delete $classNode->{Compound}; # Cheat, to get it excluded from Iter::LocalCompounds
+ return;
+ }
+}
+
+
+sub generateMethod($$)
+{
+ my( $classNode, $m ) = @_; # input
+ my $methodCode = ''; # output
+
+ my $name = $m->{astNodeName}; # method name
+ my @heritage = kdocAstUtil::heritage($classNode);
+ my $className = join( "::", @heritage );
+
+ # Check some method flags: constructor, destructor etc.
+ my $flags = $m->{Flags};
+
+ if ( !defined $flags ) {
+ warn "Method ".$name. " has no flags\n";
+ }
+
+ my $returnType = $m->{ReturnType};
+ $returnType = undef if ($returnType eq 'void');
+
+ # Don't use $className here, it's never the fully qualified (A::B) name for a ctor.
+ my $isConstructor = ($name eq $classNode->{astNodeName} );
+ my $isDestructor = ($returnType eq '~');
+
+ if ($debug) {
+ print STDERR " Method $name";
+ print STDERR ", is DTOR" if $isDestructor;
+ print STDERR ", returns $returnType" if $returnType;
+ #print STDERR " ($m->{Access})";
+ print STDERR "\n";
+ }
+
+ # Don't generate anything for destructors
+ return if $isDestructor;
+
+ my $args = "";
+
+ foreach my $arg ( @{$m->{ParamList}} ) {
+
+ print STDERR " Param ".$arg->{astNodeName}." type: ".$arg->{ArgType}." name:".$arg->{ArgName}." default: ".$arg->{DefaultValue}."\n" if ($debug);
+
+ my $argType = $arg->{ArgType};
+
+ my $x_isConst = ($argType =~ s/const//);
+ my $x_isRef = ($argType =~ s/&//);
+
+ my $typeAttrs = "";
+ $typeAttrs .= " qleft=\"const\"" if $x_isConst;
+ $typeAttrs .= " qright=\"&amp;\"" if $x_isRef;
+
+ $argType =~ s/^\s*(.*?)\s*$/$1/;
+ $argType =~ s/</&lt;/g;
+ $argType =~ s/>/&gt;/g;
+ $argType =~ s/\s//g;
+
+ $args .= " <ARG><TYPE$typeAttrs>$argType</TYPE><NAME>$arg->{ArgName}</NAME></ARG>\n";
+ }
+
+ my $qual = "";
+ $qual .= " qual=\"const\"" if $flags =~ "c";
+
+ $returnType = "void" unless $returnType;
+ $returnType =~ s/</&lt;/g;
+ $returnType =~ s/>/&gt;/g;
+ $returnType =~ s/^\s*const\s*//;
+
+ my $methodCode = "";
+
+ my $tagType = ($flags !~ /z/) ? "FUNC" : "SIGNAL";
+ my $tagAttr = "";
+ $tagAttr .= " hidden=\"yes\"" if $flags =~ /y/;
+
+ if (!$isConstructor) {
+ $methodCode .= " <$tagType$tagAttr$qual>\n";
+ $methodCode .= " <TYPE>$returnType</TYPE>\n";
+ $methodCode .= " <NAME>$name</NAME>\n";
+ $methodCode .= "$args";
+ $methodCode .= " </$tagType>\n";
+ }
+
+ return ( $methodCode );
+}
+
+sub generateAllMethods
+{
+ my ($classNode) = @_;
+ my $methodCode = '';
+
+ # Then all methods
+ Iter::MembersByType ( $classNode, undef,
+ sub { my ($classNode, $methodNode ) = @_;
+
+ if ( $methodNode->{NodeType} eq 'method' ) {
+ next unless $methodNode->{Flags} =~ /(d|z|y)/;
+ my ($meth) = generateMethod( $classNode, $methodNode );
+ $methodCode .= $meth;
+ }
+ }, undef );
+
+ return ( $methodCode );
+}
+
+1;