Timothy Pearson
13 years ago
parent
795a0355a4
commit
cf5706eb5a
@ -0,0 +1,5 @@
|
||||
|
||||
all: configure
|
||||
|
||||
configure: configure.in
|
||||
autoconf
|
||||
@ -0,0 +1,53 @@
|
||||
prefix = @prefix@
|
||||
exec_prefix = @exec_prefix@
|
||||
perl = @perl@
|
||||
install = @INSTALL@
|
||||
bin = kalyptus
|
||||
pm = kdocUtil.pm kdocAstUtil.pm kdocParseDoc.pm kdocLib.pm \
|
||||
Ast.pm kalyptusDataDict.pm kalyptusCxxToC.pm \
|
||||
kalyptusCxxToObjc.pm kalyptusCxxToJava.pm \
|
||||
kalyptusCxxToSmoke.pm kalyptusCxxToCSharp.pm \
|
||||
Iter.pm
|
||||
pmextra =
|
||||
bindir = ${exec_prefix}/bin
|
||||
pmdir = ${prefix}/share/kalyptus
|
||||
srcdocdir= .
|
||||
VERSION=@Version@
|
||||
|
||||
all: kalyptus.local
|
||||
|
||||
kalyptus.local: @srcdir@/kalyptus
|
||||
cp @srcdir@/kalyptus kalyptus.local
|
||||
perl -npi -e 's%^#\!.*$$%#!'${perl}' -I'${pmdir}'%g;' kalyptus.local
|
||||
perl -npi -e 's#\$$Version\\\$$#'"${VERSION}"'#g;' kalyptus.local
|
||||
|
||||
install: all
|
||||
${install} -d $(DESTDIR)${bindir}
|
||||
${install} -m 755 kalyptus.local $(DESTDIR)${bindir}/kalyptus
|
||||
${install} -d $(DESTDIR)${pmdir}
|
||||
for file in ${pm} ${pmextra}; do \
|
||||
${install} -m 644 @srcdir@/$$file $(DESTDIR)${pmdir}; \
|
||||
done
|
||||
|
||||
uninstall:
|
||||
(cd $(DESTDIR)${bindir} && rm -f ${bin})
|
||||
(cd $(DESTDIR)${pmdir} && rm -f ${pm})
|
||||
-rmdir $(DESTDIR)${bindir}
|
||||
-rmdir $(DESTDIR)${pmdir}
|
||||
|
||||
clean:
|
||||
rm -f kalyptus.local
|
||||
|
||||
distclean: clean
|
||||
rm -f Makefile config.status config.log config.cache perlbin
|
||||
|
||||
srcdoc:
|
||||
pod2html --flush --title KALYPTUS $(bin) $(pm) \
|
||||
--outfile $(srcdocdir)/kalyptus-doc.html
|
||||
tags:
|
||||
perltags kalyptus *.pm
|
||||
|
||||
check:
|
||||
@for dir in $(bin) $(pm); do \
|
||||
echo "** Checking: $$dir"; \
|
||||
perl -wc $$dir; done
|
||||
@ -0,0 +1,28 @@
|
||||
AC_INIT(kalyptus)
|
||||
|
||||
AC_DEFUN(AC_FIND_PERL,
|
||||
[
|
||||
AC_MSG_CHECKING(for perl 5 or greater)
|
||||
if $srcdir/findperl; then
|
||||
$1=`cat perlbin`
|
||||
echo $$1
|
||||
else
|
||||
echo "Couldn't find perl 5 or later. kdoc will not run."
|
||||
exit 1
|
||||
fi
|
||||
])
|
||||
|
||||
AC_DEFUN(AC_KALYPTUS_VERSION,
|
||||
[
|
||||
AC_MSG_CHECKING(kalyptus version)
|
||||
$1=`cat $srcdir/Version | sed 's#Revision##g' | tr -d '\$:'`
|
||||
echo $$1
|
||||
])
|
||||
|
||||
AC_PROG_INSTALL
|
||||
AC_FIND_PERL(perl)
|
||||
AC_SUBST(perl)
|
||||
AC_KALYPTUS_VERSION(Version)
|
||||
AC_SUBST(Version)
|
||||
|
||||
AC_OUTPUT(Makefile)
|
||||
@ -0,0 +1,12 @@
|
||||
#!/bin/sh
|
||||
if [[ -z $KALYPTUS || ! -d $KALYPTUS ]]
|
||||
then
|
||||
echo "Please set enviroment variable KALYPTUS to point to your tdebindings/kaltyptus checkout directory"
|
||||
exit
|
||||
fi
|
||||
perl -I$KALYPTUS $KALYPTUS/kalyptus $2 --allow_k_dcop_accessors -f dcopidl $1 2>/tmp/dcopidlng.stderr.$$
|
||||
if [[ $? -ne 0 ]]
|
||||
then
|
||||
cat /tmp/dcopidlng.stderr.$$
|
||||
fi
|
||||
rm /tmp/dcopidlng.stderr.$$
|
||||
@ -0,0 +1,17 @@
|
||||
#!/bin/sh
|
||||
|
||||
test -f perlbin && rm perlbin
|
||||
|
||||
for p in `echo $PATH | tr ":" " "`
|
||||
do
|
||||
if [ -x $p/perl ]
|
||||
then
|
||||
if $p/perl -e 'require 5.000;'
|
||||
then
|
||||
echo $p/perl > perlbin
|
||||
exit 0
|
||||
fi
|
||||
fi
|
||||
|
||||
done
|
||||
exit 1
|
||||
@ -0,0 +1,251 @@
|
||||
#!/bin/sh
|
||||
#
|
||||
# install - install a program, script, or datafile
|
||||
# This comes from X11R5 (mit/util/scripts/install.sh).
|
||||
#
|
||||
# Copyright 1991 by the Massachusetts Institute of Technology
|
||||
#
|
||||
# Permission to use, copy, modify, distribute, and sell this software and its
|
||||
# documentation for any purpose is hereby granted without fee, provided that
|
||||
# the above copyright notice appear in all copies and that both that
|
||||
# copyright notice and this permission notice appear in supporting
|
||||
# documentation, and that the name of M.I.T. not be used in advertising or
|
||||
# publicity pertaining to distribution of the software without specific,
|
||||
# written prior permission. M.I.T. makes no representations about the
|
||||
# suitability of this software for any purpose. It is provided "as is"
|
||||
# without express or implied warranty.
|
||||
#
|
||||
# Calling this script install-sh is preferred over install.sh, to prevent
|
||||
# `make' implicit rules from creating a file called install from it
|
||||
# when there is no Makefile.
|
||||
#
|
||||
# This script is compatible with the BSD install script, but was written
|
||||
# from scratch. It can only install one file at a time, a restriction
|
||||
# shared with many OS's install programs.
|
||||
|
||||
|
||||
# set DOITPROG to echo to test this script
|
||||
|
||||
# Don't use :- since 4.3BSD and earlier shells don't like it.
|
||||
doit="${DOITPROG-}"
|
||||
|
||||
|
||||
# put in absolute paths if you don't have them in your path; or use env. vars.
|
||||
|
||||
mvprog="${MVPROG-mv}"
|
||||
cpprog="${CPPROG-cp}"
|
||||
chmodprog="${CHMODPROG-chmod}"
|
||||
chownprog="${CHOWNPROG-chown}"
|
||||
chgrpprog="${CHGRPPROG-chgrp}"
|
||||
stripprog="${STRIPPROG-strip}"
|
||||
rmprog="${RMPROG-rm}"
|
||||
mkdirprog="${MKDIRPROG-mkdir}"
|
||||
|
||||
transformbasename=""
|
||||
transform_arg=""
|
||||
instcmd="$mvprog"
|
||||
chmodcmd="$chmodprog 0755"
|
||||
chowncmd=""
|
||||
chgrpcmd=""
|
||||
stripcmd=""
|
||||
rmcmd="$rmprog -f"
|
||||
mvcmd="$mvprog"
|
||||
src=""
|
||||
dst=""
|
||||
dir_arg=""
|
||||
|
||||
while [ x"$1" != x ]; do
|
||||
case $1 in
|
||||
-c) instcmd="$cpprog"
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-d) dir_arg=true
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-m) chmodcmd="$chmodprog $2"
|
||||
shift
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-o) chowncmd="$chownprog $2"
|
||||
shift
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-g) chgrpcmd="$chgrpprog $2"
|
||||
shift
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-s) stripcmd="$stripprog"
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-t=*) transformarg=`echo $1 | sed 's/-t=//'`
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
|
||||
shift
|
||||
continue;;
|
||||
|
||||
*) if [ x"$src" = x ]
|
||||
then
|
||||
src=$1
|
||||
else
|
||||
# this colon is to work around a 386BSD /bin/sh bug
|
||||
:
|
||||
dst=$1
|
||||
fi
|
||||
shift
|
||||
continue;;
|
||||
esac
|
||||
done
|
||||
|
||||
if [ x"$src" = x ]
|
||||
then
|
||||
echo "install: no input file specified"
|
||||
exit 1
|
||||
else
|
||||
true
|
||||
fi
|
||||
|
||||
if [ x"$dir_arg" != x ]; then
|
||||
dst=$src
|
||||
src=""
|
||||
|
||||
if [ -d $dst ]; then
|
||||
instcmd=:
|
||||
chmodcmd=""
|
||||
else
|
||||
instcmd=mkdir
|
||||
fi
|
||||
else
|
||||
|
||||
# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
|
||||
# might cause directories to be created, which would be especially bad
|
||||
# if $src (and thus $dsttmp) contains '*'.
|
||||
|
||||
if [ -f $src -o -d $src ]
|
||||
then
|
||||
true
|
||||
else
|
||||
echo "install: $src does not exist"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ x"$dst" = x ]
|
||||
then
|
||||
echo "install: no destination specified"
|
||||
exit 1
|
||||
else
|
||||
true
|
||||
fi
|
||||
|
||||
# If destination is a directory, append the input filename; if your system
|
||||
# does not like double slashes in filenames, you may need to add some logic
|
||||
|
||||
if [ -d $dst ]
|
||||
then
|
||||
dst="$dst"/`basename $src`
|
||||
else
|
||||
true
|
||||
fi
|
||||
fi
|
||||
|
||||
## this sed command emulates the dirname command
|
||||
dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
|
||||
|
||||
# Make sure that the destination directory exists.
|
||||
# this part is taken from Noah Friedman's mkinstalldirs script
|
||||
|
||||
# Skip lots of stat calls in the usual case.
|
||||
if [ ! -d "$dstdir" ]; then
|
||||
defaultIFS='
|
||||
'
|
||||
IFS="${IFS-${defaultIFS}}"
|
||||
|
||||
oIFS="${IFS}"
|
||||
# Some sh's can't handle IFS=/ for some reason.
|
||||
IFS='%'
|
||||
set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
|
||||
IFS="${oIFS}"
|
||||
|
||||
pathcomp=''
|
||||
|
||||
while [ $# -ne 0 ] ; do
|
||||
pathcomp="${pathcomp}${1}"
|
||||
shift
|
||||
|
||||
if [ ! -d "${pathcomp}" ] ;
|
||||
then
|
||||
$mkdirprog "${pathcomp}"
|
||||
else
|
||||
true
|
||||
fi
|
||||
|
||||
pathcomp="${pathcomp}/"
|
||||
done
|
||||
fi
|
||||
|
||||
if [ x"$dir_arg" != x ]
|
||||
then
|
||||
$doit $instcmd $dst &&
|
||||
|
||||
if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
|
||||
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
|
||||
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
|
||||
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
|
||||
else
|
||||
|
||||
# If we're going to rename the final executable, determine the name now.
|
||||
|
||||
if [ x"$transformarg" = x ]
|
||||
then
|
||||
dstfile=`basename $dst`
|
||||
else
|
||||
dstfile=`basename $dst $transformbasename |
|
||||
sed $transformarg`$transformbasename
|
||||
fi
|
||||
|
||||
# don't allow the sed command to completely eliminate the filename
|
||||
|
||||
if [ x"$dstfile" = x ]
|
||||
then
|
||||
dstfile=`basename $dst`
|
||||
else
|
||||
true
|
||||
fi
|
||||
|
||||
# Make a temp file name in the proper directory.
|
||||
|
||||
dsttmp=$dstdir/#inst.$$#
|
||||
|
||||
# Move or copy the file name to the temp name
|
||||
|
||||
$doit $instcmd $src $dsttmp &&
|
||||
|
||||
trap "rm -f ${dsttmp}" 0 &&
|
||||
|
||||
# and set any options; do chmod last to preserve setuid bits
|
||||
|
||||
# If any of these fail, we abort the whole thing. If we want to
|
||||
# ignore errors from any of these, just make sure not to ignore
|
||||
# errors from the above "$doit $instcmd $src $dsttmp" command.
|
||||
|
||||
if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
|
||||
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
|
||||
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
|
||||
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
|
||||
|
||||
# Now rename the file to the real destination.
|
||||
|
||||
$doit $rmcmd -f $dstdir/$dstfile &&
|
||||
$doit $mvcmd $dsttmp $dstdir/$dstfile
|
||||
|
||||
fi &&
|
||||
|
||||
|
||||
exit 0
|
||||
@ -0,0 +1,62 @@
|
||||
# You might want to change the next 2 lines, the rest should be ok
|
||||
%define qtdir /usr/lib/qt-3.0.0
|
||||
Prefix: /opt/trinity
|
||||
|
||||
Name: kalyptus
|
||||
Icon: kde-icon.xpm
|
||||
Summary: Bindings generation tools for the K Desktop Environment (KDE) 3.0.
|
||||
Version: @VERSION@
|
||||
Release: 1
|
||||
Epoch: 1
|
||||
#Source: ftp://ftp.kde.org/pub/kde/stable/%{version}/distribution/tar/generic/source/kdoc-%{version}.tar.bz2
|
||||
Group: Bindings
|
||||
BuildRoot: /var/tmp/%{name}-buildroot
|
||||
Copyright: GPL
|
||||
BuildArch: noarch
|
||||
|
||||
%description
|
||||
Bindings generation tools for the K Desktop Environment 3.0.
|
||||
|
||||
%prep
|
||||
rm -rf $RPM_BUILD_ROOT
|
||||
|
||||
%setup -q -n %{name}
|
||||
make -f Makefile.cvs
|
||||
|
||||
%build
|
||||
export TDEDIR=%{prefix} QTDIR=%{qtdir}
|
||||
CXXFLAGS="$RPM_OPT_FLAGS -I%{prefix}/include/kde" ./configure \
|
||||
--prefix=%{prefix}
|
||||
make CXXFLAGS="$RPM_OPT_FLAGS -DNO_DEBUG -DNDEBUG"
|
||||
|
||||
%install
|
||||
make install DESTDIR=$RPM_BUILD_ROOT
|
||||
|
||||
cd $RPM_BUILD_ROOT
|
||||
find . -type d | sed '1,3d;s,^\.,\%attr(-\,root\,root) \%dir ,' > \
|
||||
$RPM_BUILD_DIR/file.list.%{name}
|
||||
perl -pi -e "s|\%attr\(-,root,root\) \%dir %{prefix}/man/man1||" $RPM_BUILD_DIR/file.list.%{name}
|
||||
perl -pi -e "s|\%attr\(-,root,root\) \%dir %{prefix}/man||" $RPM_BUILD_DIR/file.list.%{name}
|
||||
perl -pi -e "s|\%attr\(-,root,root\) \%dir %{prefix}/bin||" $RPM_BUILD_DIR/file.list.%{name}
|
||||
perl -pi -e "s|\%attr\(-,root,root\) \%dir %{prefix}/lib$||" $RPM_BUILD_DIR/file.list.%{name}
|
||||
|
||||
find . -type f | sed -e 's,^\.,\%attr(-\,root\,root) ,' \
|
||||
-e '/\/config\//s|^|%config|' >> \
|
||||
$RPM_BUILD_DIR/file.list.%{name}
|
||||
|
||||
find . -type l | sed 's,^\.,\%attr(-\,root\,root) ,' >> \
|
||||
$RPM_BUILD_DIR/file.list.%{name}
|
||||
|
||||
sed -e "s,%{prefix}/man/.*,&*,g" $RPM_BUILD_DIR/file.list.%{name} >$RPM_BUILD_DIR/file.list.%{name}.new
|
||||
mv -f $RPM_BUILD_DIR/file.list.%{name}.new $RPM_BUILD_DIR/file.list.%{name}
|
||||
|
||||
echo "%docdir %{prefix}/doc/kde" >> $RPM_BUILD_DIR/file.list.%{name}
|
||||
|
||||
%clean
|
||||
rm -rf $RPM_BUILD_ROOT $RPM_BUILD_DIR/file.list.%{name}
|
||||
|
||||
%files -f ../file.list.%{name}
|
||||
|
||||
%changelog
|
||||
* Thu May 11 2000 Bernhard Rosenkraenzer <bero@redhat.com>
|
||||
- initial
|
||||
@ -0,0 +1,764 @@
|
||||
#***************************************************************************
|
||||
# copyright : (C) 2000-2001 Lost Highway Ltd. All Rights Reserved.
|
||||
# (C) 2002 Adam Treat. All Rights Reserved.
|
||||
# email : manyoso@yahoo.com
|
||||
# author : Adam Treat & Richard Dale.
|
||||
#***************************************************************************/
|
||||
|
||||
#/***************************************************************************
|
||||
# * *
|
||||
# * 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 kalyptusCxxToCSharp;
|
||||
|
||||
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/ @clist $host $who $now $gentext %functionId $docTop
|
||||
$lib $rootnode $outputdir $opt $debug $typeprefix $eventHandlerCount
|
||||
$pastaccess $pastname $pastreturn $pastparams $nullctor $constructorCount *CLASS *HEADER *TQTCTYPES *KDETYPES /;
|
||||
|
||||
BEGIN
|
||||
{
|
||||
@clist = ();
|
||||
|
||||
|
||||
# Page footer
|
||||
|
||||
$who = kdocUtil::userName();
|
||||
$host = kdocUtil::hostName();
|
||||
$now = localtime;
|
||||
$gentext = "$who using kalyptus $main::Version.";
|
||||
|
||||
$docTop =<<EOF
|
||||
|
||||
// begin : $now
|
||||
// copyright : (C) 2002 Adam Treat. All rights reserved.
|
||||
// email : manyoso\@yahoo.com
|
||||
// generated by : $gentext
|
||||
|
||||
// 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.
|
||||
|
||||
EOF
|
||||
}
|
||||
|
||||
sub cplusplusToCSharp
|
||||
{
|
||||
my ( $cplusplusType ) = @_;
|
||||
if ( $cplusplusType =~ /bool/ && kalyptusDataDict::ctypemap($cplusplusType) eq "int" ) {
|
||||
return "bool";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*void\s*\**/ ) {
|
||||
return "int";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*int\s*\&*/ ) {
|
||||
return "int";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*int\s*\*/) {
|
||||
return "int[]";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*double\s*\*/ ) {
|
||||
return "double[]";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*short\s*\*/ ) {
|
||||
return "short[]";
|
||||
} elsif ( $cplusplusType =~ /TQByteArray/ || $cplusplusType =~ /TQBitArray/ ) {
|
||||
return "byte[]";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*char\s*\*\*/ ) {
|
||||
return "string[]";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*char\s*\**/ ) {
|
||||
return "string";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned int\s*\**/ ) {
|
||||
return "uint";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned short\s*\**/ ) {
|
||||
return "ushort";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned long\s*\**/ ) {
|
||||
return "ulong";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned char\s*\**/ ) {
|
||||
return "string";
|
||||
} elsif ( $cplusplusType =~ /^GUID/ ) {
|
||||
return "System.Guid";
|
||||
} elsif ( $cplusplusType =~ /^FILE/ ) {
|
||||
return "string";
|
||||
} elsif ( $cplusplusType =~ /^_NPStream/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQPtrCollection/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQStyleHintReturn/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^type/i ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^Key/ || $cplusplusType =~ /^key_type/ || $cplusplusType =~ /^K/) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQUnknownInterface/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^GDHandle/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQTextParag/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQDiskFont/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQDomNodePrivate/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^Display/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQUuid/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^Q_REFCOUNT/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^EventRef/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^MSG/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQWSEvent/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^XEvent/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^CGContextRef/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQWSDecoration/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQTextFormat/ || $cplusplusType =~ /^TQTextDocument/ || $cplusplusType =~ /^TQTextCursor/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^TQSqlRecordPrivate/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^Text/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^Event/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /^NavDirection/ ) {
|
||||
return "IntPtr";
|
||||
} elsif (
|
||||
$cplusplusType =~ /^pointer$/
|
||||
|| $cplusplusType =~/T\*$/
|
||||
|| $cplusplusType =~/T\&*$/
|
||||
|| $cplusplusType =~/T1\&*$/
|
||||
|| $cplusplusType =~/T2\&*$/
|
||||
|| $cplusplusType =~/^Iterator/i
|
||||
|| $cplusplusType =~/^_iterator/i
|
||||
|| $cplusplusType =~/^reference/
|
||||
|| $cplusplusType =~/^_reference/) {
|
||||
return "IntPtr";
|
||||
} elsif ($cplusplusType =~ /::/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /::/ ||
|
||||
$cplusplusType =~ /&$/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /&$/ ||
|
||||
$cplusplusType =~ /\*/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /\*/) {
|
||||
|
||||
$cplusplusType =~ s/::/./g;
|
||||
$cplusplusType =~ s/&//g;
|
||||
$cplusplusType =~ s/\*//g;
|
||||
return $cplusplusType;
|
||||
|
||||
} else {
|
||||
return kalyptusDataDict::ctypemap($cplusplusType);
|
||||
}
|
||||
}
|
||||
|
||||
sub cplusplusToPInvoke
|
||||
{
|
||||
my ( $cplusplusType ) = @_;
|
||||
if ( $cplusplusType =~ /bool/ && kalyptusDataDict::ctypemap($cplusplusType) eq "int" ) {
|
||||
return "bool";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*void\s*\*/ ) {
|
||||
return "int";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*int\s*\&*/ ) {
|
||||
return "int";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*int\s*\*/) {
|
||||
return "int[]";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*double\s*\*/ ) {
|
||||
return "double[]";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*short\s*\*/ ) {
|
||||
return "short[]";
|
||||
} elsif ( $cplusplusType =~ /TQByteArray/ || $cplusplusType =~ /TQBitArray/ ) {
|
||||
return "byte[]";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*char\s*\*\*/ ) {
|
||||
return "string[]";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*char\s*\**/ ) {
|
||||
return "string";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned int\s*\**/ ) {
|
||||
return "uint";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned short\s*\**&*/ ) {
|
||||
return "ushort";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned long\s*\**/ ) {
|
||||
return "ulong";
|
||||
} elsif ( kalyptusDataDict::ctypemap($cplusplusType) =~ /\s*unsigned char\s*\**/ ) {
|
||||
return "string";
|
||||
} elsif ( $cplusplusType =~ /^GUID/ ) {
|
||||
return "System.Guid";
|
||||
} elsif ( $cplusplusType =~ /^FILE/ ) {
|
||||
return "string";
|
||||
} elsif ( $cplusplusType =~ /^_NPStream/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQPtrCollection/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQStyleHintReturn/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^type/i ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^Key/ || $cplusplusType =~ /^key_type/ || $cplusplusType =~ /^K/) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQUnknownInterface/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^GDHandle/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQTextParag/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQDiskFont/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQDomNodePrivate/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^Display/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQUuid/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^Q_REFCOUNT/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^EventRef/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^MSG/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQWSEvent/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^XEvent/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^CGContextRef/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQWSDecoration/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQTextFormat/ || $cplusplusType =~ /^TQTextDocument/ || $cplusplusType =~ /^TQTextCursor/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^TQSqlRecordPrivate/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^Text/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^Event/ ) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /^NavDirection/ ) {
|
||||
return "RawObject";
|
||||
} elsif (
|
||||
$cplusplusType =~ /^pointer$/
|
||||
|| $cplusplusType =~/T\*$/
|
||||
|| $cplusplusType =~/T\&*$/
|
||||
|| $cplusplusType =~/T1\&*$/
|
||||
|| $cplusplusType =~/T2\&*$/
|
||||
|| $cplusplusType =~/^iterator/i
|
||||
|| $cplusplusType =~/^_iterator/i
|
||||
|| $cplusplusType =~/^reference/
|
||||
|| $cplusplusType =~/^_reference/) {
|
||||
return "RawObject";
|
||||
} elsif ( $cplusplusType =~ /&$/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /&$/ ) {
|
||||
return "IntPtr";
|
||||
} elsif ( $cplusplusType =~ /\*/ || kalyptusDataDict::ctypemap($cplusplusType) =~ /\*/ ) {
|
||||
return "IntPtr";
|
||||
} else {
|
||||
return kalyptusDataDict::ctypemap($cplusplusType);
|
||||
}
|
||||
}
|
||||
|
||||
sub checkReserved
|
||||
{
|
||||
my ( $name ) = @_;
|
||||
|
||||
if ( $name =~ /^lock$/i ) {
|
||||
return "res_$name";
|
||||
} elsif ( $name =~ /^object$/i ) {
|
||||
return "res_$name";
|
||||
} elsif ( $name =~ /^ref$/i ) {
|
||||
return "res_$name";
|
||||
} elsif ( $name =~ /^base$/i ) {
|
||||
return "res_$name";
|
||||
} elsif ( $name =~ /^string$/i ) {
|
||||
return "res_$name";
|
||||
} elsif ( $name =~ /^const$/i ) {
|
||||
return "res_$name";
|
||||
} elsif ( $name =~ /^event$/i ) {
|
||||
return "res_$name";
|
||||
} elsif ( $name =~ /^internal$/i ) {
|
||||
return "res_$name";
|
||||
} else {
|
||||
return $name;
|
||||
}
|
||||
}
|
||||
|
||||
sub writeDoc
|
||||
{
|
||||
( $lib, $rootnode, $outputdir, $opt ) = @_;
|
||||
|
||||
$debug = $main::debuggen;
|
||||
|
||||
mkpath( $outputdir ) unless -f $outputdir;
|
||||
|
||||
|
||||
# Document all compound nodes
|
||||
Iter::LocalCompounds( $rootnode, sub { writeClassDoc( shift ); } );
|
||||
|
||||
}
|
||||
|
||||
sub writeClassDoc
|
||||
{
|
||||
my( $node ) = @_;
|
||||
|
||||
print "Enter: $node->{astNodeName}\n" if $debug;
|
||||
if( exists $node->{ExtSource} ) {
|
||||
warn "Trying to write doc for ".$node->{AstNodeName}.
|
||||
" from ".$node->{ExtSource}."\n";
|
||||
return;
|
||||
}
|
||||
|
||||
my $typeName = $node->{astNodeName}."*";
|
||||
|
||||
if ( kalyptusDataDict::ctypemap($typeName) eq "" ) {
|
||||
$typeprefix = ($typeName =~ /^Q/ ? "qt_" : "kde_");
|
||||
kalyptusDataDict::setctypemap($typeName, $typeprefix.$node->{astNodeName}."*");
|
||||
print "'$typeName' => '$typeprefix$typeName',\n";
|
||||
} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^qt_/ ) {
|
||||
$typeprefix = "qt_";
|
||||
} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^kde_/ ) {
|
||||
$typeprefix = "kde_";
|
||||
} else {
|
||||
$typeprefix = "kde_";
|
||||
}
|
||||
|
||||
my $file = "$outputdir/".join("__", kdocAstUtil::heritage($node)).".cs";
|
||||
my $docnode = $node->{DocNode};
|
||||
my @list = ();
|
||||
my $version = undef;
|
||||
my $author = undef;
|
||||
|
||||
if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private") {
|
||||
return;
|
||||
}
|
||||
|
||||
open( CLASS, ">$file" ) || die "Couldn't create $file\n";
|
||||
$file =~ s/\.h/.cpp/;
|
||||
|
||||
my $short = "";
|
||||
my $extra = "";
|
||||
|
||||
print CLASS "// ", $node->{astNodeName}, ".cs - ", $node->{astNodeName}, " c-sharp implementation.";
|
||||
print CLASS $docTop;
|
||||
|
||||
print CLASS "\nnamespace Qt {";
|
||||
print CLASS "\n\n\tusing Qt;";
|
||||
print CLASS "\n\tusing System;";
|
||||
print CLASS "\n\tusing System.Runtime.InteropServices;";
|
||||
|
||||
# ancestors
|
||||
my @ancestors = ();
|
||||
Iter::Ancestors( $node, $rootnode, undef, undef,
|
||||
sub { # print
|
||||
my ( $ances, $name, $type, $template ) = @_;
|
||||
push @ancestors, $name;
|
||||
},
|
||||
undef
|
||||
);
|
||||
|
||||
if ( $#ancestors < 0 ) {
|
||||
print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : QtSupport {";
|
||||
|
||||
if ( kalyptusDataDict::interfacemap($node->{astNodeName}) ne () ) {
|
||||
$file = "$outputdir/".join("__", kdocAstUtil::heritage($node)).".cs";
|
||||
my $interfaceName = kalyptusDataDict::interfacemap($node->{astNodeName});
|
||||
$file =~ s/$node->{astNodeName}/$interfaceName/;
|
||||
open( INTERFACE, ">$file" ) || die "Couldn't create $file\n";
|
||||
print INTERFACE "// ", kalyptusDataDict::interfacemap($node->{astNodeName}), ".cs - ", kalyptusDataDict::interfacemap($node->{astNodeName}), " c-sharp implementation.";
|
||||
print INTERFACE $docTop;
|
||||
print INTERFACE "\nnamespace Qt {";
|
||||
print INTERFACE "\n\n\tusing Qt;";
|
||||
print INTERFACE "\n\n\tpublic interface ", kalyptusDataDict::interfacemap($node->{astNodeName}), " {";
|
||||
}
|
||||
|
||||
} else {
|
||||
my $ancestor;
|
||||
foreach $ancestor ( @ancestors ) {
|
||||
if ( kalyptusDataDict::interfacemap($ancestor) eq () ) {
|
||||
if ( $ancestor eq ("Qt") ){
|
||||
print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : TQNameSpace ";
|
||||
} else {
|
||||
print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : $ancestor";
|
||||
}
|
||||
last;
|
||||
} elsif ($ancestor eq @ancestors[$#ancestors] ) {
|
||||
if ( $ancestor eq ("Qt") ){
|
||||
print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : TQNameSpace ";
|
||||
} else {
|
||||
print CLASS "\n\n\tpublic class ", $node->{astNodeName}, " : ";
|
||||
}
|
||||
print CLASS @ancestors[$#ancestors], "";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $#ancestors >= 1 ) {
|
||||
foreach $ancestor ( @ancestors ) {
|
||||
if ( kalyptusDataDict::interfacemap($ancestor) ne () ) {
|
||||
print CLASS ", ".kalyptusDataDict::interfacemap($ancestor);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( kalyptusDataDict::interfacemap($node->{astNodeName}) ne () ) {
|
||||
print CLASS ",".kalyptusDataDict::interfacemap($node->{astNodeName});
|
||||
}
|
||||
|
||||
print CLASS " {";
|
||||
}
|
||||
|
||||
Iter::MembersByType ( $node,
|
||||
sub { print CLASS "", $_[0], ""; print JNISOURCE "", $_[0], ""; },
|
||||
sub { my ($node, $kid ) = @_;
|
||||
generateClassMethodForEnum( $node, $kid );
|
||||
},
|
||||
sub { print CLASS ""; print JNISOURCE ""; }
|
||||
);
|
||||
|
||||
%functionId = ();
|
||||
$eventHandlerCount = 0;
|
||||
|
||||
Iter::MembersByType ( $node,
|
||||
sub { print CLASS "", $_[0], ""; print CLASS "", $_[0], ""; },
|
||||
sub { my ($node, $kid ) = @_;
|
||||
listMember( $node, $kid );
|
||||
},
|
||||
sub { print CLASS ""; print CLASS ""; }
|
||||
);
|
||||
|
||||
if ($nullctor ne (1) ) {
|
||||
if ( $#ancestors >= 0 ) {
|
||||
print CLASS "\n\n\t\tpublic ", $node->{astNodeName}, "() : base() {";
|
||||
print CLASS "\n\n\t\t\t// Dummy constructor for inherited classes.";
|
||||
print CLASS "\n\t\t}";
|
||||
#print CLASS "\n\n\t\t// This is a convenience constructor for instantiating by passing a RawObject.";
|
||||
#print CLASS "\n\t\tpublic ", $node->{astNodeName}, "(IntPtr raw) : base((Class) null) {";
|
||||
#print CLASS "\n\n\t\t\tRawObject = raw;";
|
||||
#print CLASS "\n\t\t}";
|
||||
} else {
|
||||
print CLASS "\n\n\t\tpublic ", $node->{astNodeName}, "() : base() {";
|
||||
print CLASS "\n\n\t\t\t// Dummy constructor for inherited classes.";
|
||||
print CLASS "\n\t\t}";
|
||||
#print CLASS "\n\n\t\t// This is a convenience constructor for instantiating by passing a RawObject.";
|
||||
#print CLASS "\n\t\tpublic ", $node->{astNodeName}, "(IntPtr raw) {";
|
||||
#print CLASS "\n\n\t\t\tRawObject = raw;";
|
||||
#print CLASS "\n\t\t}";
|
||||
}
|
||||
}
|
||||
|
||||
print CLASS "\n\t}\n}\n";
|
||||
close CLASS;
|
||||
$nullctor = 0;
|
||||
|
||||
if ( kalyptusDataDict::interfacemap($node->{astNodeName}) ne () ) {
|
||||
print INTERFACE "\n\t}\n}\n";
|
||||
close INTERFACE;
|
||||
}
|
||||
}
|
||||
|
||||
sub listMember
|
||||
{
|
||||
my( $class, $m, $ancestorCount) = @_;
|
||||
my $name;
|
||||
my $function;
|
||||
my $csharpaccess;
|
||||
my $csharpparams;
|
||||
my $returnType;
|
||||
|
||||
$name = $m->{astNodeName} ;
|
||||
my $type = $m->{NodeType};
|
||||
my $docnode = $m->{DocNode};
|
||||
|
||||
if ( $m->{ReturnType} =~ /~/ ) {
|
||||
$name = "~".$name;
|
||||
}
|
||||
|
||||
if ( $functionId{$name} eq "" ) {
|
||||
$functionId{$name} = 0;
|
||||
$function = $name;
|
||||
} else {
|
||||
$functionId{$name}++;
|
||||
$function = $name.$functionId{$name};
|
||||
}
|
||||
|
||||
$function =~ s/~//;
|
||||
|
||||
if( $type eq "method" && $m->{Access} ne "private" && $m->{Access} ne "private_slots" && $m->{Access} ne "signals" ) {
|
||||
if ( $m->{ReturnType} =~ /[<>]/ || $m->{Params} =~ /[<>]/ || $m->{Params} =~ /\.\.\./ || $m->{Params} =~ /Impl/
|
||||
|| $m->{ReturnType} =~ /TQAuBucket/ || $m->{Params} =~ /TQAuBucket/
|
||||
|| $m->{ReturnType} =~ /TQMember/ || $m->{Params} =~ /TQMember/ ) {
|
||||
return;
|
||||
}
|
||||
|
||||
$returnType = $m->{ReturnType};
|
||||
$returnType =~ s/const\s*//;
|
||||
$returnType =~ s/inline\s*//;
|
||||
$returnType =~ s/\s*([,\*\&])\s*/$1/;
|
||||
$returnType =~ s/^\s*//;
|
||||
$returnType =~ s/\s*$//;
|
||||
|
||||
if ( $returnType ne "" && cplusplusToPInvoke($returnType) eq () ) {
|
||||
$returnType =~ s/^.*::.*$/int/;
|
||||
} else {
|
||||
$returnType = cplusplusToPInvoke($returnType);
|
||||
}
|
||||
|
||||
if ( $returnType eq "RawObject") {
|
||||
$returnType = "IntPtr";
|
||||
}
|
||||
|
||||
my $cparams = $m->{Params};
|
||||
my $cplusplusparams;
|
||||
my $pinvokeparams;
|
||||
my $pinvokeargs;
|
||||
|
||||
# TODO port to $m->{ParamList}
|
||||
$cparams =~ s/\s+/ /g;
|
||||
$cparams =~ s/\s*([,\*\&])\s*/$1 /g;
|
||||
$cparams =~ s/^\s*void\s*$//;
|
||||
my $argId = 0;
|
||||
my @cargs = kdocUtil::splitUnnested(",", $cparams);
|
||||
$cparams = "";
|
||||
foreach my $arg ( @cargs ) {
|
||||
my $argType;
|
||||
my $cargType;
|
||||
my $csharpargType;
|
||||
my $pinvokeargType;
|
||||
if ( $arg =~ /^\s*$/ ) {
|
||||
next;
|
||||
}
|
||||
|
||||
# A '<arg> = <value>' default parameter
|
||||
$arg =~ s/\s*([^\s].*[^\s])\s*/$1/;
|
||||
$arg =~ s/(\w+)\[\]/\* $1/;
|
||||
$arg =~ s/=\s*(("[^\"]*")|(\'.\')|(([-\w:.]*)\s*(\|\s*[-\w]*)*(\(\w*\))?))//;
|
||||
|
||||
if ( $arg =~ /^(.*)\s+(\w+)\s*$/ ) {
|
||||
$argType = $1;
|
||||
$arg = $2;
|
||||
} else {
|
||||
$argType = $arg;
|
||||
$argId++;
|
||||
$arg = "arg".$argId;
|
||||
}
|
||||
$arg =~ s/^id$/identifier/;
|
||||
$argType =~ s/\s*([^\s].*[^\s])\s*/$1/;
|
||||
$argType =~ s/\s*const//g;
|
||||
$argType =~ s/^\s*//;
|
||||
$argType =~ s/([\*\&])\s*([\*\&])/$1$2/;
|
||||
$cargType = kalyptusDataDict::ctypemap($argType);
|
||||
$csharpargType = cplusplusToCSharp($argType);
|
||||
$pinvokeargType = cplusplusToPInvoke($argType);
|
||||
|
||||
if ( $csharpargType eq "" ) {
|
||||
$csharpargType = $argType;
|
||||
$csharpargType =~ s/\&/\*/;
|
||||
$csharpargType =~ s/^.*::.*$/int/;
|
||||
}
|
||||
if ( $pinvokeargType eq "" ) {
|
||||
$pinvokeargType = $argType;
|
||||
$pinvokeargType =~ s/\&/\*/;
|
||||
$pinvokeargType =~ s/^.*::.*$/int/;
|
||||
}
|
||||
|
||||
$arg = checkReserved($arg);
|
||||
if ( $pinvokeargType =~ /IntPtr/ ) {
|
||||
$pinvokeargs .= "$arg.Ptr, ";
|
||||
} elsif ( $csharpargType =~ /\./ ) {
|
||||
$pinvokeargs .= "($pinvokeargType)$arg, ";
|
||||
} else {
|
||||
$pinvokeargs .= "$arg, ";
|
||||
}
|
||||
|
||||
if ( $pinvokeargType =~ /RawObject/ ) {
|
||||
$pinvokeargType =~ s/RawObject/IntPtr/;
|
||||
}
|
||||
$csharpparams .= "$csharpargType $arg, ";
|
||||
$pinvokeparams .= "$pinvokeargType $arg, ";
|
||||
}
|
||||
$cparams =~ s/, $//;
|
||||
$cplusplusparams =~ s/, $//;
|
||||
$csharpparams =~ s/, $//;
|
||||
$pinvokeparams =~ s/, $//;
|
||||
$pinvokeargs =~ s/, $//;
|
||||
|
||||
my $flags = $m->{Flags};
|
||||
|
||||
if ( !defined $flags ) {
|
||||
warn "Method ".$m->{astNodeName}. " has no flags\n";
|
||||
}
|
||||
|
||||
|
||||
my $extra = "";
|
||||
$extra .= "static " if $flags =~ "s";
|
||||
|
||||
if ( $name =~ /operator/ ) {
|
||||
return;
|
||||
}
|
||||
|
||||
if ( $m->{Access} =~ /protected/ && $name ne $class->{astNodeName} ) {
|
||||
if ( $class->{Pure} ) {
|
||||
return;
|
||||
}
|
||||
|
||||
$name = "protected_".$name;
|
||||
}
|
||||
|
||||
$m->{Access} =~ /([^_]*)(.*)?\s*/;
|
||||
$csharpaccess = $1;
|
||||
if ( $extra =~ /static/ ) {
|
||||
$csharpaccess .= " static";
|
||||
}
|
||||
|
||||
if ( $name eq $class->{astNodeName} && $class->{Pure} ) {
|
||||
return;
|
||||
}
|
||||
|
||||
if ( defined $docnode ) {
|
||||
if ( defined $docnode->{Text} ) {
|
||||
print CLASS "\n/** ";
|
||||
my $node;
|
||||
my $line;
|
||||
foreach $node ( @{$docnode->{Text}} ) {
|
||||
next if $node->{NodeType} ne "DocText";
|
||||
$line = $node->{astNodeName};
|
||||
print CLASS $line, "\n";
|
||||
}
|
||||
print CLASS "*/\n";
|
||||
}
|
||||
}
|
||||
|
||||
#This is to make sure we have no duplicate methods...
|
||||
my $currentmethod .= "$name $returnType $csharpparams";
|
||||
my $pastmethod .= "$pastname $pastreturn $pastparams";
|
||||
if($currentmethod ne $pastmethod) {
|
||||
|
||||
if ( $name eq $class->{astNodeName} ) {
|
||||
#All the constructors are generated here except the dummy constructor
|
||||
#print CLASS "\n// DLLImport goes here...";
|
||||
print CLASS "\n\n\t\t[DllImport(\"libqtc.so\", CharSet=CharSet.Ansi)]";
|
||||
print CLASS "\n\t\tprivate static extern IntPtr ", $typeprefix, "new_", $function, "(", $pinvokeparams, ");";
|
||||
print CLASS "\n\t\t", $csharpaccess, " ", $class->{astNodeName}, "(", $csharpparams, ") ";
|
||||
if ($ancestorCount >= 0) {
|
||||
print CLASS ": base() {";
|
||||
}
|
||||
else {
|
||||
print CLASS "{";
|
||||
}
|
||||
print CLASS "\n\n\t\t\tRawObject = ", $typeprefix, "new_", $function, "(", $pinvokeargs, ");";
|
||||
print CLASS "\n\t\t}";
|
||||
if ($csharpparams eq () ) {
|
||||
$nullctor = 1;
|
||||
}
|
||||
} elsif ( $returnType =~ /~/ ) {
|
||||
#The deconstructor is here
|
||||
print CLASS "\n\n\t\t// Deconstructor goes here...";
|
||||
print CLASS "\n\t\t", $csharpaccess, " void ", "del_", $function, "( ", $class->{astNodeName}, " p ){}";
|
||||
} else {
|
||||
if ( $name =~ /.*Event$/ ) {
|
||||
return;
|
||||
}
|
||||
|
||||
# Class or instance method
|
||||
my $selfstring;
|
||||
if ( $extra =~ /static/ ) {
|
||||
if ( exists $class->{Pure} || $constructorCount == 0 ) {
|
||||
$selfstring = kalyptusDataDict::addNamespace($class->{astNodeName})."::";
|
||||
} else {
|
||||
$selfstring = $class->{astNodeName}."Bridge::";
|
||||
}
|
||||
#Static Methods are generated here
|
||||
#print CLASS "\n\n\t\t// DLLImport method goes here...";
|
||||
print CLASS "\n\n\t\t[DllImport(\"libqtc.so\", CharSet=CharSet.Ansi)]";
|
||||
print CLASS "\n\t\tprivate static extern", " ", $returnType, " ", $typeprefix, $class->{astNodeName}, "_", $function, "(", $pinvokeparams, ");";
|
||||
print CLASS "\n\t\t", $csharpaccess, " ", $returnType, " ", $name, "(", $csharpparams, ") {";
|
||||
if ($returnType =~ /void/ ) {
|
||||
print CLASS "\n\n\t\t\t",$typeprefix, $class->{astNodeName}, "_", $function, "(", $pinvokeargs, ");";
|
||||
} else {
|
||||
print CLASS "\n\n\t\t\treturn ", $typeprefix, $class->{astNodeName}, "_", $function, "(", $pinvokeargs, ");";
|
||||
}
|
||||
print CLASS "\n\t\t}";
|
||||
} else {
|
||||
if ( exists $class->{Pure} || $constructorCount == 0 ) {
|
||||
$selfstring = "((".kalyptusDataDict::addNamespace($class->{astNodeName})."*)instPointer)->";
|
||||
} else {
|
||||
$selfstring = "((".$class->{astNodeName}."Bridge*)instPointer)->";
|
||||
}
|
||||
#Methods are generated here
|
||||
#print CLASS "\n\n\t\t// DLLImport method goes here...";
|
||||
print CLASS "\n\n\t\t[DllImport(\"libqtc.so\", CharSet=CharSet.Ansi)]";
|
||||
print CLASS "\n\t\tprivate static extern", " ", $returnType, " ", $typeprefix, $class->{astNodeName}, "_", $function, "(", "IntPtr raw", ($pinvokeparams eq "" ? "" : ", "), $pinvokeparams, ");";
|
||||
print CLASS "\n\t\t", $csharpaccess, " ", $returnType, " ", checkReserved($name), "(", $csharpparams, ") {";
|
||||
if ($returnType =~ /void/ ) {
|
||||
print CLASS "\n\n\t\t\t",$typeprefix, $class->{astNodeName}, "_", $function, "(", "RawObject", ($pinvokeargs eq "" ? "" : ", "), $pinvokeargs, ");";
|
||||
} else {
|
||||
print CLASS "\n\n\t\t\treturn ", $typeprefix, $class->{astNodeName}, "_", $function, "(", "RawObject", ($pinvokeargs eq "" ? "" : ", "), $pinvokeargs, ");";
|
||||
}
|
||||
print CLASS "\n\t\t}";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
#Part of the duplicate methods check.
|
||||
$pastname = $name;
|
||||
$pastreturn = $returnType;
|
||||
$pastparams = $csharpparams;
|
||||
$csharpparams = "";
|
||||
}
|
||||
|
||||
sub generateClassMethodForEnum
|
||||
{
|
||||
my( $class, $m ) = @_;
|
||||
my $enum = $m->{astNodeName};
|
||||
my $csharpaccess;
|
||||
|
||||
$m->{Access} =~ /([^_]*)(.*)?\s*/;
|
||||
$csharpaccess = $1;
|
||||
|
||||
if( $m->{NodeType} eq "enum" ) {
|
||||
my $enum = $m->{astNodeName};
|
||||
my @enums = split(",", $m->{Params});
|
||||
my $enumCount = 0;
|
||||
|
||||
if($enum ne " ") {
|
||||
print CLASS "\n\n\t\t$csharpaccess enum", $enum,":long {";
|
||||
|
||||
foreach my $enum ( @enums ) {
|
||||
$enum =~ s/\s//g;
|
||||
$enum =~ s/::/./g;
|
||||
if($#enums == $enumCount){
|
||||
|
||||
if ( $enum =~ /(.*)=(.*)/ ) {
|
||||
print CLASS "\n\t\t\t$1 = $2";
|
||||
} else {
|
||||
print CLASS "\n\t\t\t$enum = $enumCount";
|
||||
}
|
||||
|
||||
} else {
|
||||
|
||||
if ( $enum =~ /(.*)=(.*)/ ) {
|
||||
print CLASS "\n\t\t\t$1 = $2,";
|
||||
} else {
|
||||
print CLASS "\n\t\t\t$enum = $enumCount,";
|
||||
}
|
||||
|
||||
}
|
||||
$enumCount++;
|
||||
|
||||
}
|
||||
|
||||
print CLASS "\n\t\t}";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -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;
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,996 @@
|
||||
package kalyptusCxxToSwig;
|
||||
|
||||
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/ @clist $host $who $now $gentext %functionId $docTop %typedeflist
|
||||
$lib $rootnode $outputdir $opt $debug $typeprefix $eventHandlerCount
|
||||
$constructorCount *CLASS *HEADER *TQTCTYPES *KDETYPES /;
|
||||
|
||||
BEGIN
|
||||
{
|
||||
@clist = ();
|
||||
|
||||
%typedeflist =
|
||||
(
|
||||
'signed char' => 'char',
|
||||
'unsigned char' => 'uchar',
|
||||
'signed short' => 'short',
|
||||
'unsigned short' => 'ushort',
|
||||
'signed' => 'int',
|
||||
'signed int' => 'int',
|
||||
'unsigned' => 'uint',
|
||||
'unsigned int' => 'uint',
|
||||
'signed long' => 'long',
|
||||
'unsigned long' => 'ulong',
|
||||
'TQWSEvent*' => 'void*',
|
||||
'TQDiskFont*' => 'void*',
|
||||
'XEvent*' => 'void*',
|
||||
'TQStyleHintReturn*' => 'void*',
|
||||
'FILE*' => 'void*',
|
||||
'TQUnknownInterface*' => 'void*',
|
||||
'GDHandle' => 'void*',
|
||||
'_NPStream*' => 'void*',
|
||||
'TQTextFormat*' => 'void*',
|
||||
'TQTextDocument*' => 'void*',
|
||||
'TQTextCursor*' => 'void*',
|
||||
'TQTextParag**' => 'void*',
|
||||
'TQTextParag* *' => 'void*',
|
||||
'TQTextParag*' => 'void*',
|
||||
'TQRemoteInterface*' => 'void*',
|
||||
'TQSqlRecordPrivate*' => 'void*',
|
||||
'TQTSMFI' => 'void*', # TQTextStream's TQTSManip
|
||||
'const GUID&' => 'void*',
|
||||
'TQWidgetMapper*' => 'void*',
|
||||
'TQWidgetMapper *' => 'void*',
|
||||
'MSG*' => 'void*',
|
||||
'const TQSqlFieldInfoList&' => 'void*', # TQSqlRecordInfo - TODO (templates)
|
||||
|
||||
'TQPtrCollection::Item' => 'void*', # to avoid a warning
|
||||
|
||||
'mode_t' => 'long',
|
||||
'TQProcess::PID' => 'long',
|
||||
'size_type' => 'int', # TQSqlRecordInfo
|
||||
'TQt::ComparisonFlags' => 'uint',
|
||||
'TQt::ToolBarDock' => 'int', # compat thing, Qt shouldn't use it
|
||||
'TQIODevice::Offset' => 'ulong',
|
||||
'WState' => 'int',
|
||||
'WId' => 'ulong',
|
||||
'TQRgb' => 'uint',
|
||||
'TQRgb *' => 'uint*',
|
||||
'TQRgb*' => 'uint*',
|
||||
'const TQCOORD*' => 'const int*',
|
||||
'TQCOORD*' => 'int*',
|
||||
'TQCOORD' => 'int',
|
||||
'TQCOORD &' => 'int&',
|
||||
'TQTSMFI' => 'int',
|
||||
'TQt::WState' => 'int',
|
||||
'TQt::WFlags' => 'int',
|
||||
'TQt::HANDLE' => 'uint',
|
||||
'TQEventLoop::ProcessEventsFlags' => 'uint',
|
||||
'TQStyle::SCFlags' => 'int',
|
||||
'TQStyle::SFlags' => 'int',
|
||||
'TQStyleOption&' => 'int&',
|
||||
'const TQStyleOption&' => 'const int&',
|
||||
'Q_INT16' => 'short',
|
||||
'Q_INT32' => 'int',
|
||||
'Q_INT8' => 'char',
|
||||
'Q_LONG' => 'long',
|
||||
'Q_UINT16' => 'ushort',
|
||||
'Q_UINT32' => 'uint',
|
||||
'Q_UINT8' => 'uchar',
|
||||
'Q_ULONG' => 'long',
|
||||
);
|
||||
# Page footer
|
||||
|
||||
$who = kdocUtil::userName();
|
||||
$host = kdocUtil::hostName();
|
||||
$now = localtime;
|
||||
$gentext = "$who\@$host on $now, using kalyptus $main::Version.";
|
||||
|
||||
$docTop =<<EOF
|
||||
begin : $now
|
||||
copyright : (C) 2003 Ian Geiser, Zack Rusin
|
||||
email : geiseri\@kde.org, zack\@kde.org
|
||||
generated by : $gentext
|
||||
***************************************************************************/
|
||||
|
||||
/***************************************************************************
|
||||
* *
|
||||
* This library is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU Library General Public License as *
|
||||
* published by the Free Software Foundation; either version 2 of the *
|
||||
* License, or (at your option) any later version. *
|
||||
* *
|
||||
***************************************************************************/
|
||||
|
||||
EOF
|
||||
|
||||
}
|
||||
|
||||
# Returns 1 if the $kid of the $node should be skipped
|
||||
sub skipMethod($$)
|
||||
{
|
||||
my ($node, $kid) = @_;
|
||||
|
||||
if ( $kid->{NodeType} ne "method" ) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
my $access = $kid->{Access};
|
||||
# if ( $access eq "private" || $access eq "private_slots" || $access eq "signals" ) {
|
||||
if ( $access eq "private_slots" || $access eq "signals" ) {
|
||||
return 1;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# returns 1 if the $kid is not a protected method of object $node
|
||||
sub isNotProtectedMethod($$)
|
||||
{
|
||||
my ($node, $kid) = @_;
|
||||
|
||||
print "HERE $node->{NodeType} $node->{astNodeName}, $kid->{NodeType} $kid->{astNodeName} \n";
|
||||
if ( $kid->{NodeType} ne "method" ) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
my $access = $kid->{Access};
|
||||
if ( $access ne "protected" && $access ne "protected_slots" ) {
|
||||
return 1;
|
||||
}
|
||||
return undef;
|
||||
|
||||
}
|
||||
|
||||
# Returns the list of all classes this one inherits
|
||||
# If $recurse is defined function returns also all the parents
|
||||
# of the classes $classNode inherits from
|
||||
sub superClassList($;$)
|
||||
{
|
||||
my $classNode = shift;
|
||||
my $recurse = shift;
|
||||
my @super;
|
||||
my @nodes;
|
||||
|
||||
Iter::Ancestors( $classNode, $rootnode, undef, undef, sub {
|
||||
push @super, @_[0];
|
||||
if ( defined $recurse ) {
|
||||
push @super, superClassList( @_[0] );
|
||||
}
|
||||
}, undef );
|
||||
|
||||
return @super;
|
||||
}
|
||||
|
||||
# Returns the names of the classes the $classNode
|
||||
# inherits from
|
||||
sub parentClassNames($)
|
||||
{
|
||||
my $classNode = shift;
|
||||
my @names;
|
||||
my @supers = superClassList($classNode);
|
||||
foreach my $class (@supers) {
|
||||
push @names, $class->{astNodeName};
|
||||
}
|
||||
|
||||
return @names;
|
||||
}
|
||||
|
||||
#doesn't do anything, for me to test
|
||||
sub hasPublicConstructors($)
|
||||
{
|
||||
my ($node) = @_;
|
||||
our $exists;
|
||||
Iter::MembersByType ( $node,
|
||||
sub { print SWIG_HEADER "1) @_\n"; },
|
||||
sub { my ($node, $kid ) = @_;
|
||||
print SWIG_HEADER "\%$node->{NodeType} $node->{astNodeName}\% $kid->{NodeType} $kid->{astNodeName}\n";
|
||||
},
|
||||
sub { print SWIG_HEADER "3 @_ \n"; }
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
|
||||
# Returns string representing $child method declaration or definition.
|
||||
# $child is the method node for which the code should be generated,
|
||||
# $parentName is the name of the parent for which the code should be generated,
|
||||
# this is one is tricky, the reason for it is that $child node belongs
|
||||
# to some class e.g. TQWidget and we want to generate a code for $child
|
||||
# but in a class called TQWidget_bridge therefore we need to pass tha name
|
||||
# $mangleProtected will mangle the name of the method to look like normalNameProtected
|
||||
# $definition - if set the code generated will be a definition (without the opening
|
||||
# and closing {} )
|
||||
sub generateMethodsCode($$$;$$)
|
||||
{
|
||||
my ($child, $parentName, $mangleProtected, $definition, $inline ) = @_;
|
||||
|
||||
my $ret = "";
|
||||
|
||||
if ( !(defined $definition) ) {
|
||||
if ( $child->{Flags} =~ "s" ) {
|
||||
$ret = "\tstatic ";
|
||||
} elsif ( $child->{Flags} =~ "v" ) {
|
||||
$ret = "\tvirtual ";
|
||||
} else {
|
||||
$ret = "\t";
|
||||
}
|
||||
}
|
||||
if ( defined $definition && !(defined $inline)) {
|
||||
if ( $mangleProtected ) {
|
||||
$ret .= "$child->{ReturnType} $parentName"."::"."$child->{astNodeName}Protected";
|
||||
} else {
|
||||
$ret .= "$child->{ReturnType} $parentName"."::"."$child->{astNodeName}";
|
||||
}
|
||||
} else {
|
||||
if ( defined $inline ) {
|
||||
$ret .= "\t";
|
||||
}
|
||||
if ( $mangleProtected ) {
|
||||
$ret .="$child->{ReturnType} $child->{astNodeName}Protected";
|
||||
} else {
|
||||
$ret .= convertType($child->{ReturnType})." $child->{astNodeName}";
|
||||
}
|
||||
}
|
||||
$ret .= "(";
|
||||
#$ret .= " $child->{Params} "; #can't be used because it includes names and default values
|
||||
my @params = $child->{ParamList};
|
||||
foreach my $arg (@params) {
|
||||
if ( $arg ) {
|
||||
my @arr = @{$arg};
|
||||
my $num = @arr;
|
||||
my $defParam = 'a';
|
||||
foreach my $param ( @{$arg} ) {
|
||||
#print "Node: $param->{ArgType} is a $param->{NodeType}\n";
|
||||
# if ($param->{NodeType} eq "enum" ) {
|
||||
#fix up enums
|
||||
# $ret .= $parentName."::".$param->{astNodeName};
|
||||
#}
|
||||
#else{
|
||||
$ret .= convertType($param->{ArgType})." ";
|
||||
#}
|
||||
# Apparently some languages do not appreciate the names and default values
|
||||
## FIXME: generate argument names for functions that do not have them
|
||||
if ( ! $param->{ArgName} ) {
|
||||
$param->{ArgName} = $defParam++;
|
||||
$ret .= $param->{ArgName};
|
||||
} else {
|
||||
$ret .= " $param->{ArgName}";
|
||||
}
|
||||
# For some reason we are not getting all of these...
|
||||
#if ( ! (defined $definition) ) {
|
||||
# $ret .= "=$param->{DefaultValue}" if $param->{DefaultValue};
|
||||
#}
|
||||
--$num;
|
||||
$ret .= ", " if $num;
|
||||
}
|
||||
}
|
||||
}
|
||||
$ret .= ")";
|
||||
if ( $child->{Flags} =~ "c" ) {
|
||||
$ret .= " const";
|
||||
}
|
||||
if ( defined $definition ) {
|
||||
$ret .= "\n";
|
||||
} else {
|
||||
$ret .= ";\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub normalMethodDeclarations($$;$&$)
|
||||
{
|
||||
my ($node, $parentName, $definition, $writerSub, $inline) = @_;
|
||||
my $accessType = "";
|
||||
my $defaultConstructor = 0;
|
||||
my $hasPublicProtectedConstructor = 0;
|
||||
my $hasDestructor = 1;
|
||||
my $hasPublicDestructor = 1;
|
||||
my $hasCopyConstructor = 0;
|
||||
my $hasPrivateCopyConstructor = 1;
|
||||
my $enums = "";
|
||||
|
||||
my @methods;
|
||||
|
||||
my $ret = "";
|
||||
|
||||
Iter::MembersByType ( $node, undef,
|
||||
sub { my ($classNode, $methodNode ) = @_;
|
||||
if ( $methodNode->{NodeType} eq "method" ||
|
||||
$methodNode->{NodeType} eq "enum" ||
|
||||
$methodNode->{NodeType} eq "typedef" ) {
|
||||
if ( $methodNode->{Access} ne "protected" &&
|
||||
$methodNode->{Access} ne "protected_slots" &&
|
||||
#$methodNode->{Access} eq "private" &&
|
||||
$methodNode->{Access} ne "private_slots" &&
|
||||
$methodNode->{Access} ne "signals" &&
|
||||
!$methodNode->{Pure} &&
|
||||
$methodNode->{astNodeName} !~ /qt_/ &&
|
||||
$methodNode->{astNodeName} !~ /operator/ &&
|
||||
$methodNode->{Params} !~ /std\:\:/ &&
|
||||
$methodNode->{Params} !~ /\.\.\./){
|
||||
push @methods, $methodNode;
|
||||
}
|
||||
}
|
||||
}, undef );
|
||||
|
||||
foreach my $child ( @methods ) {
|
||||
if ( $child->{Access} ne $accessType ) {
|
||||
$accessType = $child->{Access};
|
||||
|
||||
if ( ! (defined $definition ) ) {
|
||||
if ( $accessType eq "public_slots" ) {
|
||||
$ret .= "public: //slots\n";
|
||||
} else {
|
||||
$ret .= "$accessType:\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
## check for private ctor, dtor or copy ctor...
|
||||
# print " public $node->{astNodeName}, $child->{astNodeName}\n";
|
||||
if ( $node->{astNodeName} eq $child->{astNodeName} ) {
|
||||
# print "Constructor...";
|
||||
if ( $child->{ReturnType} =~ /~/ ) {
|
||||
# A destructor
|
||||
$hasPublicDestructor = 0 if $child->{Access} ne 'public';
|
||||
$hasDestructor = 1;
|
||||
} else {
|
||||
if ( $child->{Params} eq '' && $child->{Access} ne 'private'){
|
||||
# A constructor
|
||||
$defaultConstructor = 1;
|
||||
}
|
||||
}
|
||||
# $hasPublicProtectedConstructor = 1 if ( $child->{Access} ne 'private' );
|
||||
|
||||
# Copy constructor?
|
||||
if ( $#{$child->{ParamList}} == 0 ) {
|
||||
my $theArgType = @{$child->{ParamList}}[0]->{ArgType};
|
||||
if ($theArgType =~ /$parentName\s*\&/) {
|
||||
$hasCopyConstructor = 1;
|
||||
$hasPrivateCopyConstructor = 1 if ( $child->{Access} eq 'private' );
|
||||
}
|
||||
}
|
||||
# Hack the return type for constructors, since constructors return an object pointer
|
||||
#$child->{ReturnType} = $node->{astNodeName}."*";
|
||||
|
||||
}
|
||||
|
||||
if( $child->{NodeType} eq "enum"){
|
||||
$ret .= "\tenum ".$child->{astNodeName}." {".$child->{Params}."};\n";
|
||||
$enums .= "\tenum ".$child->{astNodeName}." {".$child->{Params}."};\n";
|
||||
}
|
||||
else{
|
||||
if ( $child->{NodeType} eq "typedef"){
|
||||
$ret .= "\t".$child->{NodeType}." ".$child->{Type}." ".$child->{astNodeName}.";\n";
|
||||
$enums .= "\t".$child->{NodeType}." ".$child->{Type}." ".$child->{astNodeName}.";\n";
|
||||
}
|
||||
else{
|
||||
$ret .= generateMethodsCode( $child, $parentName, 0, $definition, $inline );
|
||||
}
|
||||
}
|
||||
|
||||
if ( defined $definition && defined $writerSub ) {
|
||||
if ( defined $inline ) { $ret .= "\t"; }
|
||||
$ret .= "{\n";
|
||||
$ret .= &$writerSub( $child );
|
||||
if ( defined $inline ) { $ret .= "\t"; }
|
||||
$ret .= "}\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if ( $defaultConstructor == 0)
|
||||
{
|
||||
#print "Private ctor for $node->{astNodeName}\n";
|
||||
$ret .= "private:\n\t";
|
||||
$ret .= $node->{astNodeName}."();\n";
|
||||
}
|
||||
|
||||
if ( $hasCopyConstructor == 1 && $hasPrivateCopyConstructor == 1)
|
||||
{
|
||||
#print "Private copy ctor for $node->{astNodeName}\n";
|
||||
$ret .= "private:\n\t";
|
||||
$ret .= $node->{astNodeName}."(const ".$node->{astNodeName}."& );\n";
|
||||
}
|
||||
|
||||
if ( $hasPublicDestructor == 0)
|
||||
{
|
||||
#print "Private dtor for $node->{astNodeName}\n";
|
||||
$ret .= "private:\n\t";
|
||||
$ret .= "~".$node->{astNodeName}."();\n";
|
||||
}
|
||||
|
||||
if ( $enums ne "")
|
||||
{
|
||||
print "inlineing enums...\n";
|
||||
$ret .= "\n\n%{\n";
|
||||
$ret .= $enums;
|
||||
$ret .= "%}\n";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub definitionParentWriter
|
||||
{
|
||||
my ($child) = @_;
|
||||
my $ret = "\t\t$child->{Parent}->{astNodeName}::$child->{astNodeName}\( ";
|
||||
$ret .= pureParamNames( $child );
|
||||
$ret .= ");\n";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub bridgeWriter
|
||||
{
|
||||
my ($child) = @_;
|
||||
my $ret = "\t\t$child->{astNodeName}Protected\( ";
|
||||
$ret .= pureParamNames( $child );
|
||||
$ret .= ");\n";
|
||||
|
||||
return $ret;
|
||||
|
||||
}
|
||||
|
||||
# returns a list of parameter names for $method in the form:
|
||||
# "a,b,c,d", suitable to call another method with the same
|
||||
# parameters
|
||||
sub pureParamNames($)
|
||||
{
|
||||
my $method = shift;
|
||||
my $ret = "";
|
||||
|
||||
my @params = $method->{ParamList};
|
||||
foreach my $arg (@params) {
|
||||
if ( $arg ) {
|
||||
my @arr = @{$arg};
|
||||
my $num = @arr;
|
||||
foreach my $param ( @{$arg} ) {
|
||||
$ret .= " $param->{ArgName}";
|
||||
--$num;
|
||||
$ret .= ", " if $num;
|
||||
}
|
||||
}
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub mangledProtectedDeclarations($$$;$$$)
|
||||
{
|
||||
my ($node, $parentName, $mangle, $definition, $writerSub, $inline) = @_;
|
||||
my $accessType = "";
|
||||
|
||||
my @methods;
|
||||
|
||||
my $ret = "";
|
||||
|
||||
Iter::MembersByType ( $node, undef,
|
||||
sub { my ($classNode, $methodNode ) = @_;
|
||||
|
||||
if ( $methodNode->{NodeType} eq "method" ) {
|
||||
if ( $methodNode->{Access} eq "protected" ||
|
||||
$methodNode->{Access} eq "protected_slots" ) {
|
||||
push @methods, $methodNode;
|
||||
}
|
||||
}
|
||||
}, undef );
|
||||
|
||||
foreach my $child ( @methods ) {
|
||||
if ( $child->{Access} ne $accessType ) {
|
||||
$accessType = $child->{Access};
|
||||
|
||||
if ( ! (defined $definition ) ) {
|
||||
if ( $accessType eq "protected_slots" ) {
|
||||
$ret .= "protected: //slots\n";
|
||||
} else {
|
||||
$ret .= "$accessType:\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
$ret .= generateMethodsCode( $child, $parentName, $mangle, $definition, $inline );
|
||||
if ( defined $definition && defined $writerSub ) {
|
||||
if ( defined $inline ) { $ret .= "\t"; }
|
||||
$ret .= "{\n";
|
||||
#FIXME : from which of the parents does the method come from?
|
||||
$ret .= &$writerSub( $child );
|
||||
if ( defined $inline ) { $ret .= "\t"; }
|
||||
$ret .= "}\n";
|
||||
}
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub neededImportsForObject($)
|
||||
{
|
||||
my ($node) = @_;
|
||||
# our @imports;
|
||||
my @imports;
|
||||
Iter::MembersByType ( $node,
|
||||
sub { },
|
||||
sub { my ($node, $kid ) = @_;
|
||||
if ( $kid->{NodeType} eq "method" &&
|
||||
$kid->{Access} eq "public" &&
|
||||
$kid->{astNodeName} !~ /qt_/
|
||||
) {
|
||||
#print "Method: $kid->{ReturnType} $kid->{astNodeName}\n";
|
||||
|
||||
my @params = $kid->{ParamList};
|
||||
foreach my $arg (@params) {
|
||||
if ( $arg ) {
|
||||
foreach my $param ( @{$arg} ) {
|
||||
my $pname = convertType($param->{ArgType});
|
||||
if ( $pname !~ /\bQ_[A-Z0-9_]+/ &&
|
||||
$pname =~ /\bQ[A-Za-z0-9_]+/ &&
|
||||
$& ne $node->{astNodeName}
|
||||
) {
|
||||
push @imports, checkObj($&);
|
||||
#print "Adding $&\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
my $pname = convertType($kid->{ReturnType});
|
||||
if ( $pname !~ /\bQ_[A-Z0-9_]+/ &&
|
||||
$pname =~ /\bQ[A-Za-z0-9_]+/ &&
|
||||
$& ne $node->{astNodeName}
|
||||
) {
|
||||
push @imports, checkObj($&);
|
||||
#print "Adding $&\n";
|
||||
}
|
||||
}
|
||||
},
|
||||
sub { }
|
||||
);
|
||||
my %seen = ();
|
||||
my @uniq;
|
||||
foreach my $item (@imports) {
|
||||
push(@uniq, $item) unless $seen{$item}++;
|
||||
}
|
||||
return @uniq;
|
||||
}
|
||||
|
||||
sub convertType($)
|
||||
{
|
||||
my ($item) = @_;
|
||||
#print "-$item-\n";
|
||||
if (exists $typedeflist{$item}) {
|
||||
print "$item change to $typedeflist{$item}\n";
|
||||
return $typedeflist{$item};
|
||||
} else {
|
||||
return $item;
|
||||
}
|
||||
}
|
||||
|
||||
sub checkObj($)
|
||||
{
|
||||
|
||||
my ($item) = @_;
|
||||
# Yes some of this is in kalyptusDataDict's ctypemap
|
||||
# but that one would need to be separated (builtins vs normal classes)
|
||||
|
||||
my $node = kdocAstUtil::findRef( $rootnode, $item );
|
||||
#print "Data item $item is a $node->{Access} node $node->{astNodeName}\n";
|
||||
return $node->{astNodeName};
|
||||
|
||||
}
|
||||
sub generateNeededTemplatesForObject($)
|
||||
{
|
||||
my ($node) = @_;
|
||||
|
||||
Iter::MembersByType ( $node,
|
||||
sub { },
|
||||
sub { my ($node, $kid ) = @_;
|
||||
if ( $kid->{NodeType} eq "method" ) {
|
||||
my @params = $kid->{ParamList};
|
||||
foreach my $arg (@params) {
|
||||
if ( $arg ) {
|
||||
foreach my $param ( @{$arg} ) {
|
||||
my $pname = $param->{ArgType};
|
||||
if ( $pname =~ /\b(Q[A-Za-z0-9_]+)\<([A-Za-z0-9_]+)\>/ ) {
|
||||
my $cname = $1;
|
||||
my $tname = $2;
|
||||
if ( $tname eq "type" || $tname eq "T"){
|
||||
$tname = "int";
|
||||
}else{
|
||||
print "Template $1::$2 in $pname\n";
|
||||
print SWIG_HEADER "\%template($tname",$cname,") $cname"."<",$tname,">;\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
my $returnName = $kid->{ReturnType};
|
||||
if ( $returnName =~ /\b(Q[A-Za-z0-9_]+)\<([A-Za-z0-9_]+)\>/ ) {
|
||||
my $cname = $1;
|
||||
my $tname = $2;
|
||||
if ( $tname eq "type" || $tname eq "T"){
|
||||
$tname = "int";
|
||||
#}else{
|
||||
print "Template $1::$2 in $returnName\n";
|
||||
print SWIG_HEADER "\%template($tname",$cname,") $cname"."<",$tname,">;\n";
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
},
|
||||
sub { }
|
||||
);
|
||||
}
|
||||
|
||||
sub generateHeader($$)
|
||||
{
|
||||
my ($node, $filename) = @_;
|
||||
|
||||
open ( HEADER, ">$outputdir/$filename" ) || die "Can't open header $filename\n";
|
||||
print HEADER documentationHeader( $filename, "header file" );
|
||||
|
||||
my $macro = uc $filename;
|
||||
$macro =~ s/\./_/g;
|
||||
print HEADER "#ifndef ", $macro, "\n";
|
||||
print HEADER "#define ", $macro, "\n";
|
||||
|
||||
print HEADER "class $node->{astNodeName}Bridge;\n";
|
||||
my @parentNames = parentClassNames($node);
|
||||
my $len = @parentNames;
|
||||
if ( $len ) {
|
||||
print HEADER "\n";
|
||||
print HEADER "$node->{NodeType} ",$typeprefix,$node->{astNodeName}," ";
|
||||
my $idx = 0;
|
||||
my $start = 0;
|
||||
while ( $len-- ) {
|
||||
if ( $len ) {
|
||||
if ($parentNames[$idx] ) {
|
||||
if ( !$start ) {
|
||||
print HEADER ": ";
|
||||
$start = 1;
|
||||
}
|
||||
print HEADER " public ",$typeprefix,"$parentNames[$idx],\n\t" if $parentNames[$idx];
|
||||
}
|
||||
} else {
|
||||
if ($parentNames[$idx] ) {
|
||||
if ( !$start ) {
|
||||
print HEADER ": ";
|
||||
$start = 1;
|
||||
}
|
||||
print HEADER " public ",$typeprefix,"$parentNames[$idx]\n" if $parentNames[$idx];
|
||||
}
|
||||
}
|
||||
++$idx;
|
||||
}
|
||||
} else {
|
||||
print HEADER "$node->{NodeType} $node->{astNodeName} ";
|
||||
}
|
||||
print HEADER "{\n";
|
||||
print HEADER normalMethodDeclarations( $node, $typeprefix + $node->{NodeType} );
|
||||
my $prot = mangledProtectedDeclarations( $node, $typeprefix + $node->{NodeType}, 0 );
|
||||
$prot =~ s/protected\:/public\:/g;
|
||||
print HEADER $prot;
|
||||
print HEADER "private:\n";
|
||||
print HEADER "\t$node->{astNodeName}Bridge *mBridge;\n";
|
||||
print HEADER "};\n\n";
|
||||
print HEADER "#endif //", uc $filename, "\n";
|
||||
close HEADER;
|
||||
}
|
||||
|
||||
sub generateBridge($*)
|
||||
{
|
||||
my($node, $fh) = @_;
|
||||
|
||||
print $fh "$node->{NodeType} $node->{astNodeName}Bridge : public $node->{astNodeName}\n";
|
||||
print $fh "{\n";
|
||||
# print $fh "public:\n";
|
||||
# print $fh normalMethodDeclarations( $node, $node->{astNodeName}."Bridge" , 1, sub { definitionParentWriter(@_) }, 1 );
|
||||
print $fh "public:\n";
|
||||
print $fh mangledProtectedDeclarations( $node, $node->{astNodeName}."Bridge", 1, 1, sub { definitionParentWriter(@_) }, 1 );
|
||||
print $fh "protected:\n";
|
||||
print $fh mangledProtectedDeclarations( $node, $node->{astNodeName}."Bridge", 0, 1, sub { bridgeWriter(@_) }, 1 );
|
||||
print $fh "\n";
|
||||
print $fh "\n";
|
||||
print $fh "};\n";
|
||||
|
||||
}
|
||||
|
||||
sub generateWrapper($*)
|
||||
{
|
||||
my($node, $fh) = @_;
|
||||
|
||||
}
|
||||
|
||||
sub generateSource
|
||||
{
|
||||
my ($node, $filename) = @_;
|
||||
|
||||
open ( SOURCE, ">$outputdir/$filename" ) || die "Can't open $filename\n";
|
||||
|
||||
$filename =~ s/\.cpp$/\.h/;
|
||||
print SOURCE "#include \"$filename\";\n\n\n";
|
||||
|
||||
generateBridge( $node, *SOURCE );
|
||||
generateWrapper( $node, *SOURCE );
|
||||
|
||||
close SOURCE;
|
||||
}
|
||||
|
||||
sub protectedMethods($)
|
||||
{
|
||||
|
||||
}
|
||||
|
||||
sub documentationHeader($$)
|
||||
{
|
||||
my ($file, $descr) = @_;
|
||||
my $ret = "/***************************************************************************\n";
|
||||
$ret .= " File: $file - $descr\n";
|
||||
$ret .= $docTop;
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub writeDoc
|
||||
{
|
||||
( $lib, $rootnode, $outputdir, $opt ) = @_;
|
||||
|
||||
$debug = $main::debuggen;
|
||||
|
||||
mkpath( $outputdir ) unless -f $outputdir;
|
||||
unlink $outputdir."/interfaces_all.i";
|
||||
|
||||
# Document all compound nodes
|
||||
Iter::LocalCompounds( $rootnode, sub { writeClassDoc( shift ); } );
|
||||
}
|
||||
|
||||
|
||||
sub addInterface($$$)
|
||||
{
|
||||
my ($outputdir,$typeprefix,$node) = @_;
|
||||
my $interfacesFile = "interfaces_all.i";
|
||||
open( IFILE, ">>$outputdir/$interfacesFile" ) || die "Can't open $outputdir/$interfacesFile";
|
||||
print IFILE "%include \"$typeprefix", kdocAstUtil::heritage($node),".i\"\n";
|
||||
close IFILE;
|
||||
}
|
||||
|
||||
|
||||
sub writeClassDoc
|
||||
{
|
||||
my( $node ) = @_;
|
||||
|
||||
if( exists $node->{ExtSource} ) {
|
||||
print "Trying to write doc for ".$node->{AstNodeName}.
|
||||
" from ".$node->{ExtSource}."\n";
|
||||
return;
|
||||
}
|
||||
|
||||
if( $node->{Access} eq "private" ||
|
||||
$node->{Access} eq "protected" ) {
|
||||
return;
|
||||
}
|
||||
|
||||
my $typeName = $node->{astNodeName}."*";
|
||||
|
||||
if ( kalyptusDataDict::ctypemap($typeName) eq "" ) {
|
||||
$typeprefix = ($typeName =~ /^Q/ ? "qt_" : "kde_");
|
||||
kalyptusDataDict::setctypemap($typeName, $typeprefix.$node->{astNodeName}."*");
|
||||
print "'$typeName' => '$typeprefix$typeName',\n";
|
||||
} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^qt_/ ) {
|
||||
$typeprefix = "qt_";
|
||||
} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^kde_/ ) {
|
||||
$typeprefix = "kde_";
|
||||
} else {
|
||||
$typeprefix = "kde_";
|
||||
}
|
||||
|
||||
my $basefile = "$typeprefix".join("__", kdocAstUtil::heritage($node)).".i";
|
||||
my $cppfile = $basefile;
|
||||
$cppfile =~ s/\.i/_wrap\.cpp/;
|
||||
|
||||
|
||||
my $file = "$outputdir/$typeprefix".join("__", kdocAstUtil::heritage($node)).".i";
|
||||
my $docnode = $node->{DocNode};
|
||||
my @list = ();
|
||||
my $version = undef;
|
||||
my $author = undef;
|
||||
|
||||
addInterface( $outputdir, $typeprefix, $node );
|
||||
|
||||
# if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private" || exists $node->{Tmpl} ) {
|
||||
if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private") {
|
||||
return;
|
||||
}
|
||||
|
||||
open( SWIG_HEADER, ">$file" ) || die "Couldn't create $file\n";
|
||||
|
||||
# Header
|
||||
|
||||
my $short = "";
|
||||
my $extra = "";
|
||||
|
||||
my $f = $typeprefix . $node->{astNodeName} . ".h";
|
||||
my $descr = documentationHeader( $f, "header" );
|
||||
print SWIG_HEADER $descr;
|
||||
|
||||
generateHeader( $node, $f );
|
||||
$f =~ s/\.h$/\.cpp/;
|
||||
generateSource( $node, $f );
|
||||
|
||||
if ( defined $docnode ) {
|
||||
print SWIG_HEADER "/**\n";
|
||||
if ( defined $docnode->{Text} ) {
|
||||
my $node;
|
||||
foreach $node ( @{$docnode->{Text}} ) {
|
||||
next if $node->{NodeType} ne "DocText";
|
||||
print SWIG_HEADER $node->{astNodeName}, "\n";
|
||||
}
|
||||
}
|
||||
|
||||
exists $docnode->{Author} && print SWIG_HEADER " \@author ", $docnode->{Author}, "\n";
|
||||
exists $docnode->{Version} && print SWIG_HEADER " \@version ", $docnode->{Version}, "\n";
|
||||
exists $docnode->{ClassShort} && print SWIG_HEADER " \@short ", $docnode->{ClassShort}, "\n";
|
||||
print SWIG_HEADER "*/\n";
|
||||
}
|
||||
|
||||
my $sourcename = $node->{Source}->{astNodeName};
|
||||
|
||||
if ( $sourcename =~ m!.*(dom|kabc|tdeprint|tdesu|kio|kjs|kparts|ktexteditor|libkmid)/([^/]*$)! ) {
|
||||
$sourcename = $1."/".$2;
|
||||
} else {
|
||||
$sourcename =~ s!.*/([^/]*$)!$1!;
|
||||
}
|
||||
|
||||
print SWIG_HEADER "\%module ",$typeprefix,$node->{astNodeName},"\n\n";
|
||||
|
||||
print SWIG_HEADER "\%{\n#include <",$sourcename , ">\n\%}\n\n";
|
||||
|
||||
#print SWIG_HEADER "\%import \"interfaces_all.i\"\n";
|
||||
|
||||
#print SWIG_HEADER "\%import \"", $basefile ,"\"\n";
|
||||
|
||||
# make this smarter i guess...
|
||||
# my @types = neededImportsForObject($node);
|
||||
# foreach my $f ( @types ) {
|
||||
# print SWIG_HEADER "\%import \"qt_".$f.".i\"\n";
|
||||
# }
|
||||
# print SWIG_HEADER "\%import \"qt_Qt.i\"\n";
|
||||
|
||||
# my @impor = parentClassNames($node);
|
||||
# foreach my $f ( @impor ) {
|
||||
# print SWIG_HEADER "\%import \"qt_".$f.".i\"\n";
|
||||
# }
|
||||
|
||||
# Iter::LocalCompounds( $node, sub { my ($node) = @_; print STDERR "$node->{NodeType}||$node->{astNodeName} \n"; } );
|
||||
# Iter::Generic( $node, undef,
|
||||
# &isNotProtectedMethod,
|
||||
# sub { my ($node, $kid) = @_; debugPrint "This is :: ", $node->{astNodeName}, " | ", $kid->{astNodeName}, "\n"; },
|
||||
# undef );
|
||||
# Iter::MembersByType ( $node, undef,
|
||||
# sub { my ($classNode, $methodNode ) = @_;
|
||||
#
|
||||
# if ( $methodNode->{NodeType} eq "method" ) {
|
||||
# print SWIG_HEADER generateMethodsCode( $methodNode, 0 );
|
||||
# }
|
||||
# }, undef );
|
||||
|
||||
my @parentNames = parentClassNames($node);
|
||||
my $len = @parentNames;
|
||||
if ( $len ) {
|
||||
print SWIG_HEADER "\n";
|
||||
print SWIG_HEADER "$node->{NodeType} ",$node->{astNodeName}," ";
|
||||
my $idx = 0;
|
||||
my $start = 0;
|
||||
while ( $len-- ) {
|
||||
if ( $len ) {
|
||||
if ($parentNames[$idx] ) {
|
||||
if ( !$start ) {
|
||||
print SWIG_HEADER ": ";
|
||||
$start = 1;
|
||||
}
|
||||
print SWIG_HEADER " public $parentNames[$idx],\n\t" if $parentNames[$idx];
|
||||
}
|
||||
} else {
|
||||
if ($parentNames[$idx] ) {
|
||||
if ( !$start ) {
|
||||
print SWIG_HEADER ": ";
|
||||
$start = 1;
|
||||
}
|
||||
print SWIG_HEADER " public $parentNames[$idx]\n" if $parentNames[$idx];
|
||||
}
|
||||
}
|
||||
++$idx;
|
||||
}
|
||||
} else {
|
||||
print SWIG_HEADER "$node->{NodeType} $node->{astNodeName} ";
|
||||
}
|
||||
print SWIG_HEADER "{\n";
|
||||
# my $name = $node->{astNodeName}."Bridge";
|
||||
# print SWIG_HEADER normalMethodDeclarations( $node, $name, 1 );
|
||||
print SWIG_HEADER normalMethodDeclarations( $node, $typeprefix + $node->{NodeType} );
|
||||
print SWIG_HEADER "};\n\n\n";
|
||||
|
||||
|
||||
# generateNeededTemplatesForObject( $node );
|
||||
print SWIG_HEADER "\n";
|
||||
|
||||
#print SWIG_HEADER "\%inline \%{\n\n";
|
||||
|
||||
#print SWIG_HEADER "class ",$node->{astNodeName},";\n";
|
||||
#print SWIG_HEADER "#include <",$sourcename , ">\n";
|
||||
#print SWIG_HEADER $node->{astNodeName}, " *",$node->{astNodeName},"Null()\n";
|
||||
#print SWIG_HEADER "{\n";
|
||||
#print SWIG_HEADER "\treturn ($node->{astNodeName}*)0L;\n";
|
||||
#print SWIG_HEADER "}\n\n";
|
||||
#print SWIG_HEADER "\%}\n";
|
||||
|
||||
$constructorCount = 0;
|
||||
|
||||
# Iter::MembersByType ( $node,
|
||||
# sub { print SWIG_HEADER "", $_[0], ""; },
|
||||
# sub { my ($node, $kid ) = @_;
|
||||
# preParseMember( $node, $kid );
|
||||
# },
|
||||
# sub { print SWIG_HEADER ""; }
|
||||
# );
|
||||
|
||||
# if ( ! exists $node->{Pure} && $constructorCount > 0 ) {
|
||||
# print SWIG_HEADER "CLASS HEADER = class ", $node->{astNodeName}, "Bridge : public ", kalyptusDataDict::addNamespace($node->{astNodeName}), "\n{\npublic:\n";
|
||||
|
||||
# Iter::MembersByType ( $node,
|
||||
# sub { print SWIG_HEADER "", $_[0], ""; },
|
||||
# sub { my ($node, $kid ) = @_;
|
||||
# generateBridgeClass( $node, $kid );
|
||||
# },
|
||||
# sub { print SWIG_HEADER ""; }
|
||||
# );
|
||||
|
||||
# generateBridgeEventHandlers($node);
|
||||
# }
|
||||
|
||||
%functionId = ();
|
||||
$eventHandlerCount = 0;
|
||||
|
||||
# Iter::MembersByType ( $node,
|
||||
# sub { print SWIG_HEADER "", $_[0], ""; },
|
||||
# sub { my ($node, $kid ) = @_;
|
||||
# listMember( $node, $kid );
|
||||
# },
|
||||
# sub { print SWIG_HEADER ""; }
|
||||
# );
|
||||
|
||||
# ancestors
|
||||
# my @ancestors = ();
|
||||
# Iter::Ancestors( $node, $rootnode, undef, undef,
|
||||
# sub { # print
|
||||
# my ( $ances, $name, $type, $template ) = @_;
|
||||
#
|
||||
# push @ancestors, $name;
|
||||
#
|
||||
# },
|
||||
# undef
|
||||
# );
|
||||
|
||||
# if ( $#ancestors > 0 ) {
|
||||
# # 'type transfer' functions to cast for correct use of multiple inheritance
|
||||
# foreach my $ancestor (@ancestors) {
|
||||
# print SWIG_HEADER "\n/\*\* Casts a '$typeprefix", $node->{astNodeName}, " *' to a '", kalyptusDataDict::ctypemap($ancestor."\*"), "' \*/\n";
|
||||
# print SWIG_HEADER kalyptusDataDict::ctypemap($ancestor."\*"), " ", $typeprefix, $node->{astNodeName}, "_", $ancestor;
|
||||
# print SWIG_HEADER "(", $typeprefix, $node->{astNodeName}, "* instPointer);\n";
|
||||
|
||||
# print CLASS kalyptusDataDict::ctypemap($ancestor."\*"), " ", $typeprefix, $node->{astNodeName}, "_", $ancestor;
|
||||
# print CLASS "(", $typeprefix, $node->{astNodeName}, "* instPointer){\n";
|
||||
# print CLASS "\treturn (", kalyptusDataDict::ctypemap($ancestor."\*"), ") (", $ancestor, " *) (", $node->{astNodeName}, " *) instPointer;\n}\n";
|
||||
# }
|
||||
# }
|
||||
|
||||
close SWIG_HEADER;
|
||||
}
|
||||
|
||||
###################################################################################
|
||||
|
||||
1;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1 @@
|
||||
/usr/bin/perl
|
||||
Loading…
Reference in new issue