initial commit for vba blob ( not including container_control stuff )

1 files changed, 150 insertions, 15 deletions

diff --git a/basic/source/classes/sbxmod.cxx b/basic/source/classes/sbxmod.cxx
index 8b1069bbeab3..e2d80e1e89fc 100644
--- a/basic/source/classes/sbxmod.cxx
+++ b/basic/source/classes/sbxmod.cxx
@@ -58,6 +58,7 @@
 #include <com/sun/star/lang/XServiceInfo.hpp>
 #include <com/sun/star/script/ModuleType.hpp>
 #include <com/sun/star/script/vba/XVBACompatibility.hpp>
+#include <com/sun/star/document/XVbaMethodParameter.hpp>
 #include <com/sun/star/beans/XPropertySet.hpp>
 
 using namespace com::sun::star;
@@ -500,7 +501,6 @@ IMPL_LINK( AsyncQuitHandler, OnAsyncQuit, void*, /*pNull*/ )
     return 0L;
 }
 
-#if 0
 bool UnlockControllerHack( StarBASIC* pBasic )
 {
     bool bRes = false;
@@ -526,7 +526,7 @@ bool UnlockControllerHack( StarBASIC* pBasic )
     }
     return bRes;
 }
-#endif
+
 /////////////////////////////////////////////////////////////////////////////
 
 // Ein BASIC-Modul hat EXTSEARCH gesetzt, damit die im Modul enthaltenen
@@ -795,6 +795,82 @@ void SbModule::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
         SbxVariable* pVar = pHint->GetVar();
         SbProperty* pProp = PTR_CAST(SbProperty,pVar);
         SbMethod* pMeth = PTR_CAST(SbMethod,pVar);
+        SbProcedureProperty* pProcProperty = PTR_CAST( SbProcedureProperty, pVar );
+        if( pProcProperty )
+        {
+
+            if( pHint->GetId() == SBX_HINT_DATAWANTED )
+            {
+                String aProcName;
+                aProcName.AppendAscii( "Property Get " );
+                aProcName += pProcProperty->GetName();
+
+                SbxVariable* pMethVar = Find( aProcName, SbxCLASS_METHOD );
+                if( pMethVar )
+                {
+                    SbxValues aVals;
+                    aVals.eType = SbxVARIANT;
+
+                    SbxArray* pArg = pVar->GetParameters();
+                    USHORT nVarParCount = (pArg != NULL) ? pArg->Count() : 0;
+                    if( nVarParCount > 1 )
+                    {
+                        SbxArrayRef xMethParameters = new SbxArray;
+                        xMethParameters->Put( pMethVar, 0 );    // Method as parameter 0
+                        for( USHORT i = 1 ; i < nVarParCount ; ++i )
+                        {
+                            SbxVariable* pPar = pArg->Get( i );
+                            xMethParameters->Put( pPar, i );
+                        }
+
+                        pMethVar->SetParameters( xMethParameters );
+                        pMethVar->Get( aVals );
+                        pMethVar->SetParameters( NULL );
+                    }
+                    else
+                    {
+                        pMethVar->Get( aVals );
+                    }
+
+                    pVar->Put( aVals );
+                }
+            }
+            else if( pHint->GetId() == SBX_HINT_DATACHANGED )
+            {
+                SbxVariable* pMethVar = NULL;
+
+                bool bSet = pProcProperty->isSet();
+                if( bSet )
+                {
+                    pProcProperty->setSet( false );
+
+                    String aProcName;
+                    aProcName.AppendAscii( "Property Set " );
+                    aProcName += pProcProperty->GetName();
+                    pMethVar = Find( aProcName, SbxCLASS_METHOD );
+                }
+                if( !pMethVar ) // Let
+                {
+                    String aProcName;
+                    aProcName.AppendAscii( "Property Let " );
+                    aProcName += pProcProperty->GetName();
+                    pMethVar = Find( aProcName, SbxCLASS_METHOD );
+                }
+
+                if( pMethVar )
+                {
+                    // Setup parameters
+                    SbxArrayRef xArray = new SbxArray;
+                    xArray->Put( pMethVar, 0 ); // Method as parameter 0
+                    xArray->Put( pVar, 1 );
+                    pMethVar->SetParameters( xArray );
+
+                    SbxValues aVals;
+                    pMethVar->Get( aVals );
+                    pMethVar->SetParameters( NULL );
+                }
+            }
+        }
         if( pProp )
         {
             if( pProp->GetModule() != this )
@@ -849,6 +925,7 @@ void SbModule::SetSource32( const ::rtl::OUString& r )
     aOUSource = r;
     StartDefinitions();
     SbiTokenizer aTok( r );
+        aTok.SetCompatible( IsVBACompat() );
     while( !aTok.IsEof() )
     {
         SbiToken eEndTok = NIL;
@@ -1036,12 +1113,14 @@ void SbModule::SetVBACompat( BOOL bCompat )
 // Ausfuehren eines BASIC-Unterprogramms
 USHORT SbModule::Run( SbMethod* pMeth )
 {
+    OSL_TRACE("About to run %s, vba compatmode is %d", rtl::OUStringToOString( pMeth->GetName(), RTL_TEXTENCODING_UTF8 ).getStr(), mbVBACompat );
     static USHORT nMaxCallLevel = 0;
     static String aMSOMacroRuntimeLibName = String::CreateFromAscii( "Launcher" );
     static String aMSOMacroRuntimeAppSymbol = String::CreateFromAscii( "Application" );
 
     USHORT nRes = 0;
     BOOL bDelInst = BOOL( pINST == NULL );
+        bool bQuit = false;
     StarBASICRef xBasic;
     if( bDelInst )
     {
@@ -1174,6 +1253,15 @@ USHORT SbModule::Run( SbMethod* pMeth )
 
             delete pRt;
             pMOD = pOldMod;
+            if ( pINST->nCallLvl == 0 && IsVBACompat() )
+            {
+                // VBA always ensure screenupdating is enabled after completing
+                StarBASIC* pBasic = PTR_CAST(StarBASIC,GetParent());
+                if ( pBasic && pBasic->IsDocBasic() )
+                {
+                    UnlockControllerHack( pBasic );
+                }
+            }
             if( bDelInst )
             {
                 // #57841 Uno-Objekte, die in RTL-Funktionen gehalten werden,
@@ -1201,10 +1289,8 @@ USHORT SbModule::Run( SbMethod* pMeth )
 
     // VBA always ensure screenupdating is enabled after completing
     StarBASIC* pBasic = PTR_CAST(StarBASIC,GetParent());
-#if 0
     if ( pBasic && pBasic->IsDocBasic() && !pINST )
         UnlockControllerHack( pBasic );
-#endif
     if( bDelInst )
     {
         // #57841 Uno-Objekte, die in RTL-Funktionen gehalten werden,
@@ -1215,6 +1301,8 @@ USHORT SbModule::Run( SbMethod* pMeth )
         pINST = NULL;
     }
     if ( pBasic && pBasic->IsDocBasic() && pBasic->IsQuitApplication() && !pINST )
+            bQuit = true;
+        if ( bQuit )
     {
         Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ), NULL );
     }
@@ -1676,6 +1764,48 @@ BOOL SbModule::ExceedsLegacyModuleSize()
     return false;
 }
 
+class ErrorHdlResetter
+{
+    Link    mErrHandler;
+    bool mbError;
+    public:
+    ErrorHdlResetter() : mbError( false )
+    {
+        // save error handler
+        mErrHandler = StarBASIC::GetGlobalErrorHdl();
+        // set new error handler
+        StarBASIC::SetGlobalErrorHdl( LINK( this, ErrorHdlResetter, BasicErrorHdl ) );
+    }
+    ~ErrorHdlResetter()
+    {
+        // restore error handler
+        StarBASIC::SetGlobalErrorHdl(mErrHandler);
+    }
+    DECL_LINK( BasicErrorHdl, StarBASIC * );
+    bool HasError() { return mbError; }
+};
+IMPL_LINK( ErrorHdlResetter, BasicErrorHdl, StarBASIC *, /*pBasic*/)
+{
+    mbError = true;
+    return 0;
+}
+
+bool SbModule::HasExeCode()
+{
+
+        ErrorHdlResetter aGblErrHdl;
+    // And empty Image always has the Global Chain set up
+        static const unsigned char pEmptyImage[] = { 0x45, 0x0 , 0x0, 0x0, 0x0 };
+        // lets be stricter for the moment than VBA
+
+    bool bRes = false;
+    if ( !IsCompiled() )
+        Compile();
+    if ( pImage && !( pImage->GetCodeSize() == 5 && ( memcmp( pImage->GetCode(), pEmptyImage, pImage->GetCodeSize() ) == 0 ) )
+        || aGblErrHdl.HasError() )
+        bRes = true;
+    return bRes;
+}
 
 // Store only image, no source
 BOOL SbModule::StoreBinaryData( SvStream& rStrm )
@@ -1725,7 +1855,6 @@ BOOL SbModule::LoadBinaryData( SvStream& rStrm )
     return bRet;
 }
 
-
 BOOL SbModule::LoadCompleted()
 {
     SbxArray* p = GetMethods();
@@ -1793,6 +1922,7 @@ SbMethod::SbMethod( const String& r, SbxDataType t, SbModule* p )
     nLine1       =
     nLine2       = 0;
     refStatics = new SbxArray;
+    mCaller          = 0;
     // AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden'
     SetFlag( SBX_NO_MODIFY );
 }
@@ -1807,6 +1937,7 @@ SbMethod::SbMethod( const SbMethod& r )
     nLine1       = r.nLine1;
     nLine2       = r.nLine2;
         refStatics = r.refStatics;
+    mCaller          = r.mCaller;
     SetFlag( SBX_NO_MODIFY );
 }
 
@@ -1875,8 +2006,13 @@ SbxInfo* SbMethod::GetInfo()
 // Schnittstelle zum Ausfuehren einer Methode aus den Applikationen
 // #34191# Mit speziellem RefCounting, damit das Basic nicht durch CloseDocument()
 // abgeschossen werden kann. Rueckgabewert wird als String geliefert.
-ErrCode SbMethod::Call( SbxValue* pRet )
+ErrCode SbMethod::Call( SbxValue* pRet, SbxVariable* pCaller )
 {
+    if ( pCaller )
+    {
+        OSL_TRACE("SbMethod::Call Have been passed a caller 0x%x", pCaller );
+        mCaller = pCaller;
+    }
     // RefCount vom Modul hochzaehlen
     SbModule* pMod_ = (SbModule*)GetParent();
     pMod_->AddRef();
@@ -1904,7 +2040,7 @@ ErrCode SbMethod::Call( SbxValue* pRet )
     // Objekte freigeben
     pMod_->ReleaseRef();
     pBasic->ReleaseRef();
-
+    mCaller = 0;
     return nErr;
 }
 
@@ -2087,9 +2223,8 @@ public:
     }
 
     //liuchen 2009-7-21, support Excel VBA Form_QueryClose event
-    virtual void SAL_CALL windowClosing( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
+    virtual void SAL_CALL windowClosing( const lang::EventObject& e ) throw (uno::RuntimeException)
     {
-#if IN_THE_FUTURE
         uno::Reference< awt::XDialog > xDialog( e.Source, uno::UNO_QUERY );
         if ( xDialog.is() )
         {
@@ -2117,7 +2252,6 @@ public:
         }
 
         mpUserForm->triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_QueryClose") ) );
-#endif
     }
     //liuchen 2009-7-21
 
@@ -2214,14 +2348,13 @@ void SbUserFormModule::triggerMethod( const String& aMethodToRun )
     Sequence< Any > aArguments;
     triggerMethod( aMethodToRun, aArguments );
 }
-void SbUserFormModule::triggerMethod( const String& aMethodToRun, Sequence< Any >& /*aArguments*/)
+void SbUserFormModule::triggerMethod( const String& aMethodToRun, Sequence< Any >& aArguments)
 {
     OSL_TRACE("*** trigger %s ***", rtl::OUStringToOString( aMethodToRun, RTL_TEXTENCODING_UTF8 ).getStr() );
     // Search method
     SbxVariable* pMeth = SbObjModule::Find( aMethodToRun, SbxCLASS_METHOD );
     if( pMeth )
     {
-#if IN_THE_FUTURE
                  //liuchen 2009-7-21, support Excel VBA UserForm_QueryClose event with parameters
         if ( aArguments.getLength() > 0 )   // Setup parameters
         {
@@ -2251,7 +2384,6 @@ void SbUserFormModule::triggerMethod( const String& aMethodToRun, Sequence< Any
         }
         else
 //liuchen 2009-7-21
-#endif
         {
             SbxValues aVals;
             pMeth->Get( aVals );
@@ -2353,7 +2485,10 @@ void SbUserFormModule::Unload()
     triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_QueryClose") ), aParams);
 
     aParams[0] >>= nCancel;
-    if (nCancel == 1)
+    // basic boolean ( and what the user might use ) can be ambiguous ( e.g. basic true = -1 )
+    // test agains 0 ( false ) and assume anything else is true
+    // ( Note: ) this used to work ( something changes somewhere )
+    if (nCancel != 0)
     {
         return;
     }
@@ -2414,7 +2549,7 @@ void SbUserFormModule::InitObject()
             aArgs[ 0 ] = uno::Any();
             aArgs[ 1 ] <<= m_xDialog;
             aArgs[ 2 ] <<= m_xModel;
-            aArgs[ 3 ] <<= rtl::OUString( GetParent()->GetName() );
+            aArgs[ 3 ] <<= sProjectName;
             pDocObject = new SbUnoObject( GetName(), uno::makeAny( xVBAFactory->createInstanceWithArguments( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ooo.vba.msforms.UserForm")), aArgs  ) ) );
             uno::Reference< lang::XComponent > xComponent( aArgs[ 1 ], uno::UNO_QUERY_THROW );
             // remove old listener if it exists