CWS-TOOLING: integrate CWS mib16

4 files changed, 411 insertions, 25 deletions

diff --git a/basic/source/classes/disas.cxx b/basic/source/classes/disas.cxx
index 36e88b6353e8..7317005d74fe 100644
--- a/basic/source/classes/disas.cxx
+++ b/basic/source/classes/disas.cxx
@@ -89,7 +89,8 @@ static const char* pOp1[] = {
     "INITFOREACH",
     "VBASET",
     "ERASE_CLEAR",
-    "ARRAYACCESS"
+    "ARRAYACCESS",
+    "BYVAL"
 };
 
 static const char* pOp2[] = {
diff --git a/basic/source/classes/sb.cxx b/basic/source/classes/sb.cxx
index 4f2f90d5da1f..79c5f78601ea 100755
--- a/basic/source/classes/sb.cxx
+++ b/basic/source/classes/sb.cxx
@@ -321,23 +321,52 @@ SbxObject* SbOLEFactory::CreateObject( const String& rClassName )
 }
 
 
-// Factory class to create user defined objects (type command)
-class SbTypeFactory : public SbxFactory
-{
-    SbxObject* cloneTypeObjectImpl( const SbxObject& rTypeObj );
+//========================================================================
+// SbFormFactory, show user forms by: dim as new <user form name>
 
+class SbFormFactory : public SbxFactory
+{
 public:
     virtual SbxBase* Create( UINT16 nSbxId, UINT32 = SBXCR_SBX );
     virtual SbxObject* CreateObject( const String& );
 };
 
-SbxBase* SbTypeFactory::Create( UINT16, UINT32 )
+SbxBase* SbFormFactory::Create( UINT16, UINT32 )
 {
     // Not supported
     return NULL;
 }
 
-SbxObject* SbTypeFactory::cloneTypeObjectImpl( const SbxObject& rTypeObj )
+SbxObject* SbFormFactory::CreateObject( const String& rClassName )
+{
+    static String aLoadMethodName( RTL_CONSTASCII_USTRINGPARAM("load") );
+
+    SbxObject* pRet = NULL;
+    SbModule* pMod = pMOD;
+    if( pMod )
+    {
+        SbxVariable* pVar = pMod->Find( rClassName, SbxCLASS_OBJECT );
+        if( pVar )
+        {
+            SbxBase* pObj = pVar->GetObject();
+            SbUserFormModule* pFormModule = PTR_CAST( SbUserFormModule, pObj );
+
+            if( pFormModule != NULL )
+            {
+                pFormModule->load();
+                SbUserFormModuleInstance* pFormInstance = pFormModule->CreateInstance();
+                pRet = pFormInstance;
+            }
+        }
+    }
+    return pRet;
+}
+
+
+//========================================================================
+// SbTypeFactory
+
+SbxObject* cloneTypeObjectImpl( const SbxObject& rTypeObj )
 {
     SbxObject* pRet = new SbxObject( rTypeObj );
     pRet->PutObject( pRet );
@@ -352,7 +381,8 @@ SbxObject* SbTypeFactory::cloneTypeObjectImpl( const SbxObject& rTypeObj )
         if( pProp )
         {
             SbxProperty* pNewProp = new SbxProperty( *pProp );
-            if( pVar->GetType() & SbxARRAY )
+            SbxDataType eVarType = pVar->GetType();
+            if( eVarType & SbxARRAY )
             {
                 SbxBase* pParObj = pVar->GetObject();
                 SbxDimArray* pSource = PTR_CAST(SbxDimArray,pParObj);
@@ -379,12 +409,35 @@ SbxObject* SbTypeFactory::cloneTypeObjectImpl( const SbxObject& rTypeObj )
                 pNewProp->PutObject( pDest );
                 pNewProp->SetFlags( nSavFlags );
             }
+            if( eVarType == SbxOBJECT )
+            {
+                SbxBase* pObjBase = pVar->GetObject();
+                SbxObject* pSrcObj = PTR_CAST(SbxObject,pObjBase);
+                SbxObject* pDestObj = NULL;
+                if( pSrcObj != NULL )
+                    pDestObj = cloneTypeObjectImpl( *pSrcObj );
+                pNewProp->PutObject( pDestObj );
+            }
             pProps->PutDirect( pNewProp, i );
         }
     }
     return pRet;
 }
 
+// Factory class to create user defined objects (type command)
+class SbTypeFactory : public SbxFactory
+{
+public:
+    virtual SbxBase* Create( UINT16 nSbxId, UINT32 = SBXCR_SBX );
+    virtual SbxObject* CreateObject( const String& );
+};
+
+SbxBase* SbTypeFactory::Create( UINT16, UINT32 )
+{
+    // Not supported
+    return NULL;
+}
+
 SbxObject* SbTypeFactory::CreateObject( const String& rClassName )
 {
     SbxObject* pRet = NULL;
@@ -728,6 +781,8 @@ StarBASIC::StarBASIC( StarBASIC* p, BOOL bIsDocBasic  )
         AddFactory( pCLASSFAC );
         pOLEFAC = new SbOLEFactory;
         AddFactory( pOLEFAC );
+        pFORMFAC = new SbFormFactory;
+        AddFactory( pFORMFAC );
     }
     pRtl = new SbiStdObject( String( RTL_CONSTASCII_USTRINGPARAM(RTLNAME) ), this );
     // Search via StarBasic is always global
@@ -748,15 +803,17 @@ StarBASIC::~StarBASIC()
     if( !--GetSbData()->nInst )
     {
         RemoveFactory( pSBFAC );
-        pSBFAC = NULL;
+        delete pSBFAC; pSBFAC = NULL;
         RemoveFactory( pUNOFAC );
-        pUNOFAC = NULL;
+        delete pUNOFAC; pUNOFAC = NULL;
         RemoveFactory( pTYPEFAC );
-        pTYPEFAC = NULL;
+        delete pTYPEFAC; pTYPEFAC = NULL;
         RemoveFactory( pCLASSFAC );
-        pCLASSFAC = NULL;
+        delete pCLASSFAC; pCLASSFAC = NULL;
         RemoveFactory( pOLEFAC );
-        pOLEFAC = NULL;
+        delete pOLEFAC; pOLEFAC = NULL;
+        RemoveFactory( pFORMFAC );
+        delete pFORMFAC; pFORMFAC = NULL;
 
 #ifdef DBG_UTIL
     // There is no need to clean SbiData at program end,
diff --git a/basic/source/classes/sbunoobj.cxx b/basic/source/classes/sbunoobj.cxx
index 849fd839bfd1..e51a0c09270b 100644..100755
--- a/basic/source/classes/sbunoobj.cxx
+++ b/basic/source/classes/sbunoobj.cxx
@@ -49,6 +49,7 @@
 #include <com/sun/star/uno/XComponentContext.hpp>
 #include <com/sun/star/uno/DeploymentException.hpp>
 #include <com/sun/star/lang/XTypeProvider.hpp>
+#include <com/sun/star/lang/XSingleServiceFactory.hpp>
 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
 #include <com/sun/star/lang/XServiceInfo.hpp>
 #include <com/sun/star/beans/PropertyAttribute.hpp>
@@ -1074,8 +1075,19 @@ Any sbxToUnoValueImpl( SbxVariable* pVar, bool bBlockConversionToSmallestType =
     if( eBaseType == SbxOBJECT )
     {
         SbxBaseRef xObj = (SbxBase*)pVar->GetObject();
-        if( xObj.Is() && xObj->ISA(SbUnoAnyObject) )
-            return ((SbUnoAnyObject*)(SbxBase*)xObj)->getValue();
+        if( xObj.Is() )
+        {
+            if( xObj->ISA(SbUnoAnyObject) )
+                return ((SbUnoAnyObject*)(SbxBase*)xObj)->getValue();
+            if( xObj->ISA(SbClassModuleObject) )
+            {
+                Any aRetAny;
+                SbClassModuleObject* pClassModuleObj = (SbClassModuleObject*)(SbxBase*)xObj;
+                SbModule* pClassModule = pClassModuleObj->getClassModule();
+                if( pClassModule->createCOMWrapperForIface( aRetAny, pClassModuleObj ) )
+                    return aRetAny;
+            }
+        }
     }
 
     Type aType = getUnoTypeForSbxValue( pVar );
@@ -1581,12 +1593,18 @@ String getBasicObjectTypeName( SbxObject* pObj )
 bool checkUnoObjectType( SbUnoObject* pUnoObj,
     const String& aClass )
 {
-    bool result = false;
     Any aToInspectObj = pUnoObj->getUnoAny();
     TypeClass eType = aToInspectObj.getValueType().getTypeClass();
     if( eType != TypeClass_INTERFACE )
         return false;
     const Reference< XInterface > x = *(Reference< XInterface >*)aToInspectObj.getValue();
+
+    // Return true for XInvocation based objects as interface type names don't count then
+    Reference< XInvocation > xInvocation( x, UNO_QUERY );
+    if( xInvocation.is() )
+        return true;
+
+    bool result = false;
     Reference< XTypeProvider > xTypeProvider( x, UNO_QUERY );
     if( xTypeProvider.is() )
     {
@@ -4135,3 +4153,267 @@ void RTL_Impl_CreateUnoValue( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
     refVar->PutObject( xUnoAnyObject );
 }
 
+//==========================================================================
+
+typedef WeakImplHelper1< XInvocation > ModuleInvocationProxyHelper;
+
+class ModuleInvocationProxy : public ModuleInvocationProxyHelper
+{
+    ::rtl::OUString     m_aPrefix;
+    SbxObjectRef        m_xScopeObj;
+    bool                m_bProxyIsClassModuleObject;
+
+public:
+    ModuleInvocationProxy( const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj );
+    ~ModuleInvocationProxy()
+    {}
+
+    // XInvocation
+    virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection() throw();
+    virtual void SAL_CALL setValue( const ::rtl::OUString& rProperty, const Any& rValue )
+        throw( UnknownPropertyException );
+    virtual Any SAL_CALL getValue( const ::rtl::OUString& rProperty )
+        throw( UnknownPropertyException );
+    virtual sal_Bool SAL_CALL hasMethod( const ::rtl::OUString& rName ) throw();
+    virtual sal_Bool SAL_CALL hasProperty( const ::rtl::OUString& rProp ) throw();
+
+    virtual Any SAL_CALL invoke( const ::rtl::OUString& rFunction,
+                                 const Sequence< Any >& rParams,
+                                 Sequence< sal_Int16 >& rOutParamIndex,
+                                 Sequence< Any >& rOutParam )
+        throw( CannotConvertException, InvocationTargetException );
+};
+
+ModuleInvocationProxy::ModuleInvocationProxy( const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj )
+    : m_aPrefix( aPrefix + ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("_") ) )
+    , m_xScopeObj( xScopeObj )
+{
+    m_bProxyIsClassModuleObject = xScopeObj.Is() ? xScopeObj->ISA(SbClassModuleObject) : false;
+}
+
+Reference< XIntrospectionAccess > SAL_CALL ModuleInvocationProxy::getIntrospection() throw()
+{
+    return Reference< XIntrospectionAccess >();
+}
+
+void SAL_CALL ModuleInvocationProxy::setValue( const ::rtl::OUString& rProperty, const Any& rValue ) throw( UnknownPropertyException )
+{
+    if( !m_bProxyIsClassModuleObject )
+        throw UnknownPropertyException();
+
+    NAMESPACE_VOS(OGuard) guard( Application::GetSolarMutex() );
+
+    ::rtl::OUString aPropertyFunctionName( RTL_CONSTASCII_USTRINGPARAM( "Property Set ") );
+    aPropertyFunctionName += m_aPrefix;
+    aPropertyFunctionName += rProperty;
+
+    SbxVariable* p = m_xScopeObj->Find( aPropertyFunctionName, SbxCLASS_METHOD );
+    SbMethod* pMeth = p != NULL ? PTR_CAST(SbMethod,p) : NULL;
+    if( pMeth == NULL )
+    {
+        // TODO: Check vba behavior concernig missing function
+        //StarBASIC::Error( SbERR_NO_METHOD, aFunctionName );
+        throw UnknownPropertyException();
+    }
+
+    // Setup parameter
+    SbxArrayRef xArray = new SbxArray;
+    SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+    unoToSbxValue( (SbxVariable*)xVar, rValue );
+    xArray->Put( xVar, 1 );
+
+    // Call property method
+    SbxVariableRef xValue = new SbxVariable;
+    pMeth->SetParameters( xArray );
+    pMeth->Call( xValue );
+    //aRet = sbxToUnoValue( xValue );
+    pMeth->SetParameters( NULL );
+
+    // TODO: OutParameter?
+
+    // throw InvocationTargetException();
+
+    //return aRet;
+
+}
+
+Any SAL_CALL ModuleInvocationProxy::getValue( const ::rtl::OUString& rProperty ) throw( UnknownPropertyException )
+{
+    if( !m_bProxyIsClassModuleObject )
+        throw UnknownPropertyException();
+
+    NAMESPACE_VOS(OGuard) guard( Application::GetSolarMutex() );
+
+    ::rtl::OUString aPropertyFunctionName( RTL_CONSTASCII_USTRINGPARAM( "Property Get ") );
+    aPropertyFunctionName += m_aPrefix;
+    aPropertyFunctionName += rProperty;
+
+    SbxVariable* p = m_xScopeObj->Find( aPropertyFunctionName, SbxCLASS_METHOD );
+    SbMethod* pMeth = p != NULL ? PTR_CAST(SbMethod,p) : NULL;
+    if( pMeth == NULL )
+    {
+        // TODO: Check vba behavior concernig missing function
+        //StarBASIC::Error( SbERR_NO_METHOD, aFunctionName );
+        throw UnknownPropertyException();
+    }
+
+    // Call method
+    SbxVariableRef xValue = new SbxVariable;
+    pMeth->Call( xValue );
+    Any aRet = sbxToUnoValue( xValue );
+    return aRet;
+}
+
+sal_Bool SAL_CALL ModuleInvocationProxy::hasMethod( const ::rtl::OUString& ) throw()
+{
+    return sal_False;
+}
+
+sal_Bool SAL_CALL ModuleInvocationProxy::hasProperty( const ::rtl::OUString& ) throw()
+{
+    return sal_False;
+}
+
+Any SAL_CALL ModuleInvocationProxy::invoke( const ::rtl::OUString& rFunction,
+                                            const Sequence< Any >& rParams,
+                                            Sequence< sal_Int16 >&,
+                                            Sequence< Any >& )
+    throw( CannotConvertException, InvocationTargetException )
+{
+    NAMESPACE_VOS(OGuard) guard( Application::GetSolarMutex() );
+
+    Any aRet;
+    if( !m_xScopeObj.Is() )
+        return aRet;
+
+    ::rtl::OUString aFunctionName = m_aPrefix;
+    aFunctionName += rFunction;
+
+    SbxVariable* p = m_xScopeObj->Find( aFunctionName, SbxCLASS_METHOD );
+    SbMethod* pMeth = p != NULL ? PTR_CAST(SbMethod,p) : NULL;
+    if( pMeth == NULL )
+    {
+        // TODO: Check vba behavior concernig missing function
+        //StarBASIC::Error( SbERR_NO_METHOD, aFunctionName );
+        return aRet;
+    }
+
+    // Setup parameters
+    SbxArrayRef xArray;
+    sal_Int32 nParamCount = rParams.getLength();
+    if( nParamCount )
+    {
+        xArray = new SbxArray;
+        const Any *pArgs = rParams.getConstArray();
+        for( sal_Int32 i = 0 ; i < nParamCount ; i++ )
+        {
+            SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+            unoToSbxValue( (SbxVariable*)xVar, pArgs[i] );
+            xArray->Put( xVar, sal::static_int_cast< USHORT >(i+1) );
+        }
+    }
+
+    // Call method
+    SbxVariableRef xValue = new SbxVariable;
+    if( xArray.Is() )
+        pMeth->SetParameters( xArray );
+    pMeth->Call( xValue );
+    aRet = sbxToUnoValue( xValue );
+    pMeth->SetParameters( NULL );
+
+    // TODO: OutParameter?
+
+    return aRet;
+}
+
+Reference< XInterface > createComListener( const Any& aControlAny, const ::rtl::OUString& aVBAType,
+                                           const ::rtl::OUString& aPrefix, SbxObjectRef xScopeObj )
+{
+    Reference< XInterface > xRet;
+
+    Reference< XComponentContext > xContext = getComponentContext_Impl();
+    Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
+
+    Reference< XInvocation > xProxy = new ModuleInvocationProxy( aPrefix, xScopeObj );
+
+    Sequence<Any> args( 3 );
+    args[0] <<= aControlAny;
+    args[1] <<= aVBAType;
+    args[2] <<= xProxy;
+
+    try
+    {
+        xRet = xServiceMgr->createInstanceWithArgumentsAndContext(
+            ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.custom.UnoComListener")),
+            args, xContext );
+    }
+    catch( const Exception& )
+    {
+        implHandleAnyException( ::cppu::getCaughtException() );
+    }
+
+    return xRet;
+}
+
+// Handle module implements mechanism for OLE types
+bool SbModule::createCOMWrapperForIface( Any& o_rRetAny, SbClassModuleObject* pProxyClassModuleObject )
+{
+    // For now: Take first interface that allows to instantiate COM wrapper
+    // TODO: Check if support for multiple interfaces is needed
+
+    Reference< XComponentContext > xContext = getComponentContext_Impl();
+    Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
+    Reference< XSingleServiceFactory > xComImplementsFactory
+    (
+        xServiceMgr->createInstanceWithContext(
+            ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.custom.ComImplementsFactory")), xContext ),
+        UNO_QUERY
+    );
+    if( !xComImplementsFactory.is() )
+        return false;
+
+    bool bSuccess = false;
+
+    SbxArray* pModIfaces = pClassData->mxIfaces;
+    USHORT nCount = pModIfaces->Count();
+    for( USHORT i = 0 ; i < nCount ; ++i )
+    {
+        SbxVariable* pVar = pModIfaces->Get( i );
+        ::rtl::OUString aIfaceName = pVar->GetName();
+
+        if( aIfaceName.getLength() != 0 )
+        {
+            ::rtl::OUString aPureIfaceName = aIfaceName;
+            sal_Int32 indexLastDot = aIfaceName.lastIndexOf('.');
+            if ( indexLastDot > -1 )
+                aPureIfaceName = aIfaceName.copy( indexLastDot + 1 );
+
+            Reference< XInvocation > xProxy = new ModuleInvocationProxy( aPureIfaceName, pProxyClassModuleObject );
+
+            Sequence<Any> args( 2 );
+            args[0] <<= aIfaceName;
+            args[1] <<= xProxy;
+
+            Reference< XInterface > xRet;
+            bSuccess = false;
+            try
+            {
+                xRet = xComImplementsFactory->createInstanceWithArguments( args );
+                bSuccess = true;
+            }
+            catch( const Exception& )
+            {
+                implHandleAnyException( ::cppu::getCaughtException() );
+            }
+
+            if( bSuccess )
+            {
+                o_rRetAny <<= xRet;
+                break;
+            }
+        }
+     }
+
+    return bSuccess;
+}
+
diff --git a/basic/source/classes/sbxmod.cxx b/basic/source/classes/sbxmod.cxx
index 4b58942d77aa..1b49a376c9bd 100644
--- a/basic/source/classes/sbxmod.cxx
+++ b/basic/source/classes/sbxmod.cxx
@@ -190,6 +190,11 @@ SbModule::SbModule( const String& rName,  BOOL bVBACompat )
     SetName( rName );
     SetFlag( SBX_EXTSEARCH | SBX_GBLSEARCH );
     SetModuleType( script::ModuleType::NORMAL );
+
+    // #i92642: Set name property to intitial name
+    SbxVariable* pNameProp = pProps->Find( String( RTL_CONSTASCII_USTRINGPARAM("Name") ), SbxCLASS_PROPERTY );
+    if( pNameProp != NULL )
+        pNameProp->PutString( GetName() );
 }
 
 SbModule::~SbModule()
@@ -366,7 +371,7 @@ SbxVariable* SbModule::Find( const XubString& rName, SbxClassType t )
 {
     // make sure a search in an uninstatiated class module will fail
     SbxVariable* pRes = SbxObject::Find( rName, t );
-    if ( bIsProxyModule )
+    if ( bIsProxyModule && !GetSbData()->bRunInit )
         return NULL;
     if( !pRes && pImage )
     {
@@ -452,7 +457,19 @@ void SbModule::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
             }
         }
         else
-            SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType );
+        {
+            // #i92642: Special handling for name property to avoid
+            // side effects when using name as variable implicitely
+            bool bForwardToSbxObject = true;
+
+            ULONG nId = pHint->GetId();
+            if( (nId == SBX_HINT_DATAWANTED || nId == SBX_HINT_DATACHANGED) &&
+                pVar->GetName().EqualsIgnoreCaseAscii( "name" ) )
+                    bForwardToSbxObject = false;
+
+            if( bForwardToSbxObject )
+                SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType );
+        }
     }
 }
 
@@ -646,7 +663,7 @@ void ClearUnoObjectsInRTL_Impl( StarBASIC* pBasic )
     if( ((StarBASIC*)p) != pBasic )
         ClearUnoObjectsInRTL_Impl_Rek( (StarBASIC*)p );
 }
-BOOL SbModule::IsVBACompat()
+BOOL SbModule::IsVBACompat() const
 {
     return mbVBACompat;
 }
@@ -1710,18 +1727,20 @@ public:
 };
 
 SbUserFormModule::SbUserFormModule( const String& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsCompat )
-    :SbObjModule( rName, mInfo, bIsCompat ), mbInit( false )
+    : SbObjModule( rName, mInfo, bIsCompat )
+    , m_mInfo( mInfo )
+    , mbInit( false )
 {
-        m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW );
+    m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW );
 }
 
 void SbUserFormModule::ResetApiObj()
 {
-        if (  m_xDialog.is() ) // probably someone close the dialog window
+    if (  m_xDialog.is() ) // probably someone close the dialog window
     {
-            triggerTerminateEvent();
-        }
-        pDocObject = NULL;
+        triggerTerminateEvent();
+    }
+    pDocObject = NULL;
     m_xDialog = NULL;
 }
 
@@ -1807,6 +1826,33 @@ void SbUserFormModule::triggerTerminateEvent( void )
     mbInit=false;
 }
 
+SbUserFormModuleInstance* SbUserFormModule::CreateInstance()
+{
+    SbUserFormModuleInstance* pInstance = new SbUserFormModuleInstance( this, GetName(), m_mInfo, IsVBACompat() );
+    return pInstance;
+}
+
+SbUserFormModuleInstance::SbUserFormModuleInstance( SbUserFormModule* pParentModule,
+    const String& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVBACompat )
+        : SbUserFormModule( rName, mInfo, bIsVBACompat )
+        , m_pParentModule( pParentModule )
+{
+}
+
+BOOL SbUserFormModuleInstance::IsClass( const XubString& rName ) const
+{
+    BOOL bParentNameMatches = m_pParentModule->GetName().EqualsIgnoreCaseAscii( rName );
+    BOOL bRet = bParentNameMatches || SbxObject::IsClass( rName );
+    return bRet;
+}
+
+SbxVariable* SbUserFormModuleInstance::Find( const XubString& rName, SbxClassType t )
+{
+    SbxVariable* pVar = m_pParentModule->Find( rName, t );
+    return pVar;
+}
+
+
 void SbUserFormModule::load()
 {
     OSL_TRACE("** load() ");