diff options
Diffstat (limited to 'basic')
31 files changed, 1336 insertions, 95 deletions
diff --git a/basic/inc/basic/sberrors.hxx b/basic/inc/basic/sberrors.hxx index c21b3b0237b8..c34176e0bde7 100644 --- a/basic/inc/basic/sberrors.hxx +++ b/basic/inc/basic/sberrors.hxx @@ -287,6 +287,8 @@ typedef ULONG SbError; #define ERRCODE_BASIC_LOOP_NOT_INIT ((LAST_SBX_ERROR_ID+109UL) | ERRCODE_AREA_SBX | \ ERRCODE_CLASS_COMPILER) // For loop not initialized +#define ERRCODE_BASIC_COMPAT ((LAST_SBX_ERROR_ID+103UL)| ERRCODE_AREA_SBX | ERRCODE_CLASS_RUNTIME) + // Map old codes to new codes #define SbERR_SYNTAX ERRCODE_BASIC_SYNTAX #define SbERR_NO_GOSUB ERRCODE_BASIC_NO_GOSUB @@ -410,6 +412,7 @@ typedef ULONG SbError; #define SbERR_PROG_TOO_LARGE ERRCODE_BASIC_PROG_TOO_LARGE #define SbERR_NO_STRINGS_ARRAYS ERRCODE_BASIC_NO_STRINGS_ARRAYS #define SbERR_BASIC_EXCEPTION ERRCODE_BASIC_EXCEPTION +#define SbERR_BASIC_COMPAT ERRCODE_BASIC_COMPAT #define SbERR_BASIC_ARRAY_FIX ERRCODE_BASIC_ARRAY_FIX #define SbERR_BASIC_STRING_OVERFLOW ERRCODE_BASIC_STRING_OVERFLOW #define SbERR_BASIC_EXPR_TOO_COMPLEX ERRCODE_BASIC_EXPR_TOO_COMPLEX diff --git a/basic/inc/basic/sbmod.hxx b/basic/inc/basic/sbmod.hxx index d73c9780b1bb..63ffef6cdd61 100644 --- a/basic/inc/basic/sbmod.hxx +++ b/basic/inc/basic/sbmod.hxx @@ -31,9 +31,7 @@ #include <basic/sbdef.hxx> #include <basic/sbxobj.hxx> #include <basic/sbxdef.hxx> -#ifndef _RTL_USTRING_HXX #include <rtl/ustring.hxx> -#endif class SbMethod; class SbProperty; @@ -63,6 +61,10 @@ protected: SbiImage* pImage; // the Image SbiBreakpoints* pBreaks; // Breakpoints SbClassData* pClassData; + BOOL mbVBACompat; + INT32 mnType; + SbxObjectRef pDocObject; // an impl object ( used by Document Modules ) + bool bIsProxyModule; void StartDefinitions(); SbMethod* GetMethod( const String&, SbxDataType ); @@ -87,7 +89,7 @@ protected: public: SBX_DECL_PERSIST_NODATA(SBXCR_SBX,SBXID_BASICMOD,2); TYPEINFO(); - SbModule( const String& ); + SbModule( const String&, BOOL bCompat = FALSE ); virtual void SetParent( SbxObject* ); virtual void Clear(); @@ -123,6 +125,11 @@ public: BOOL LoadBinaryData( SvStream& ); BOOL ExceedsLegacyModuleSize(); void fixUpMethodStart( bool bCvtToLegacy, SbiImage* pImg = NULL ) const; + BOOL IsVBACompat(); + void SetVBACompat( BOOL bCompat ); + INT32 GetModuleType() { return mnType; } + void SetModuleType( INT32 nType ) { mnType = nType; } + bool GetIsProxyModule() { return bIsProxyModule; } }; #ifndef __SB_SBMODULEREF_HXX diff --git a/basic/inc/basic/sbobjmod.hxx b/basic/inc/basic/sbobjmod.hxx new file mode 100644 index 000000000000..ad804dcfab38 --- /dev/null +++ b/basic/inc/basic/sbobjmod.hxx @@ -0,0 +1,97 @@ +/************************************************************************* + * + * OpenOffice.org - a multi-platform office productivity suite + * + * $RCSfile: sbobjmod.hxx,v $ + * + * $Revision: 1.4 $ + * + * last change: $Author: $ $Date: 2007/08/27 16:31:39 $ + * + * The Contents of this file are made available subject to + * the terms of GNU Lesser General Public License Version 2.1. + * + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2005 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + ************************************************************************/ + +#ifndef _SB_OBJMOD_HXX +#define _SB_OBJMOD_HXX + +#include <basic/sbmod.hxx> +#include <basic/sbstar.hxx> +#include <com/sun/star/script/ModuleInfo.hpp> +#include <com/sun/star/lang/XEventListener.hpp> +#include <com/sun/star/awt/XDialog.hpp> +#include <com/sun/star/frame/XModel.hpp> + +namespace css = ::com::sun::star; + +// Basic-Module for excel object. + +class SbObjModule : public SbModule +{ + SbObjModule( const SbObjModule& ); + SbObjModule(); +public: + TYPEINFO(); + SbObjModule( const String& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVbaCompatible ); + virtual SbxVariable* Find( const XubString& rName, SbxClassType t ); + using SbxValue::GetObject; + SbxVariable* GetObject(); + void SetUnoObject( const com::sun::star::uno::Any& aObj )throw ( com::sun::star::uno::RuntimeException ) ; +}; + +class SbUserFormModule : public SbObjModule +{ + css::uno::Reference<css::lang::XEventListener> m_DialogListener; + css::uno::Reference<css::awt::XDialog> m_xDialog; + css::uno::Reference<css::frame::XModel> m_xModel; + String sFormName; + bool mbInit; + SbUserFormModule( const SbUserFormModule& ); + SbUserFormModule(); + +protected: + virtual void InitObject(); +public: + TYPEINFO(); + SbUserFormModule( const String& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVBACompat ); + virtual SbxVariable* Find( const XubString& rName, SbxClassType t ); + void ResetApiObj(); + void Unload(); + void load(); + void triggerMethod( const String& ); + void triggerMethod( const String&, css::uno::Sequence< css::uno::Any >& ); + void triggerActivateEvent(); + void triggerDeActivateEvent(); + void triggerInitializeEvent(); + void triggerTerminateEvent(); +}; + +#ifndef __SB_SBOBJMODULEREF_HXX +#define __SB_SBOBJMODULEREF_HXX + +SV_DECL_IMPL_REF(SbObjModule); + +#endif +#endif + diff --git a/basic/inc/basic/sbstar.hxx b/basic/inc/basic/sbstar.hxx index bdc4aa011cc9..a234dc206ec7 100644 --- a/basic/inc/basic/sbstar.hxx +++ b/basic/inc/basic/sbstar.hxx @@ -37,6 +37,7 @@ #include <basic/sbdef.hxx> #include <basic/sberrors.hxx> +#include <com/sun/star/script/ModuleInfo.hpp> class SbModule; // completed module class SbiInstance; // runtime instance @@ -69,6 +70,7 @@ class StarBASIC : public SbxObject BOOL bNoRtl; // if TRUE: do not search RTL BOOL bBreak; // if TRUE: Break, otherwise Step BOOL bDocBasic; + BOOL bVBAEnabled; BasicLibInfo* pLibInfo; // Info block for basic manager SbLanguageMode eLanguageMode; // LanguageMode of the basic object BOOL bQuit; @@ -117,6 +119,7 @@ public: // Compiler-Interface SbModule* MakeModule( const String& rName, const String& rSrc ); SbModule* MakeModule32( const String& rName, const ::rtl::OUString& rSrc ); + SbModule* MakeModule32( const String& rName, const com::sun::star::script::ModuleInfo& mInfo, const ::rtl::OUString& rSrc ); BOOL Compile( SbModule* ); BOOL Disassemble( SbModule*, String& rText ); static void Stop(); @@ -189,6 +192,8 @@ public: ( const String& rName, USHORT& rStatus ); static SbMethod* GetActiveMethod( USHORT nLevel = 0 ); static SbModule* GetActiveModule(); + void SetVBAEnabled( BOOL bEnabled ); + BOOL isVBAEnabled(); // #60175 TRUE: SFX-Resource is not displayed on basic errors static void StaticSuppressSfxResource( BOOL bSuppress ); diff --git a/basic/inc/basic/sbuno.hxx b/basic/inc/basic/sbuno.hxx index 68e2c6ab8778..d816d424313b 100644 --- a/basic/inc/basic/sbuno.hxx +++ b/basic/inc/basic/sbuno.hxx @@ -41,5 +41,7 @@ void createAllObjectProperties( SbxObject* pObj ); ::com::sun::star::uno::Any sbxToUnoValue( SbxVariable* pVar ); +void unoToSbxValue( SbxVariable* pVar, const ::com::sun::star::uno::Any& aValue ); + #endif diff --git a/basic/prj/build.lst b/basic/prj/build.lst index 994901580c86..2cd1d3dc0466 100644..100755 --- a/basic/prj/build.lst +++ b/basic/prj/build.lst @@ -1,4 +1,4 @@ -sb basic : l10n offuh svtools xmlscript framework NULL +sb basic : l10n offuh oovbaapi svtools xmlscript framework NULL sb basic usr1 - all sb_mkout NULL sb basic\inc nmake - all sb_inc NULL sb basic\source\app nmake - all sb_app sb_class sb_inc NULL diff --git a/basic/source/basmgr/basmgr.cxx b/basic/source/basmgr/basmgr.cxx index 7646667bc277..c242165df825 100644 --- a/basic/source/basmgr/basmgr.cxx +++ b/basic/source/basmgr/basmgr.cxx @@ -41,6 +41,7 @@ #include <tools/debug.hxx> #include <tools/diagnose_ex.h> #include <basic/sbmod.hxx> +#include <basic/sbobjmod.hxx> #include <basic/sbuno.hxx> #include <basic/basmgr.hxx> @@ -65,6 +66,9 @@ #include <com/sun/star/script/XStarBasicDialogInfo.hpp> #include <com/sun/star/script/XStarBasicLibraryInfo.hpp> #include <com/sun/star/script/XLibraryContainerPassword.hpp> +#include <com/sun/star/script/ModuleInfo.hpp> +#include <com/sun/star/script/XVBAModuleInfo.hpp> +#include <com/sun/star/script/XVBACompat.hpp> #include <cppuhelper/implbase1.hxx> @@ -236,7 +240,15 @@ void BasMgrContainerListenerImpl::addLibraryModulesImpl( BasicManager* pMgr, Any aElement = xLibNameAccess->getByName( aModuleName ); ::rtl::OUString aMod; aElement >>= aMod; - pLib->MakeModule32( aModuleName, aMod ); + Reference< XVBAModuleInfo > xVBAModuleInfo( xLibNameAccess, UNO_QUERY ); + if ( xVBAModuleInfo.is() && xVBAModuleInfo->hasModuleInfo( aModuleName ) ) + { + ModuleInfo mInfo = xVBAModuleInfo->getModuleInfo( aModuleName ); + OSL_TRACE("#addLibraryModulesImpl - aMod"); + pLib->MakeModule32( aModuleName, mInfo, aMod ); + } + else + pLib->MakeModule32( aModuleName, aMod ); } } @@ -270,11 +282,16 @@ void SAL_CALL BasMgrContainerListenerImpl::elementInserted( const ContainerEvent { Reference< XLibraryContainer > xScriptCont( Event.Source, UNO_QUERY ); insertLibraryImpl( xScriptCont, mpMgr, Event.Element, aName ); + StarBASIC* pLib = mpMgr->GetLib( aName ); + if ( pLib ) + { + Reference<XVBACompat> xVBACompat( xScriptCont, UNO_QUERY ); + if ( xVBACompat.is() ) + pLib->SetVBAEnabled( xVBACompat->getVBACompatModeOn() ); + } } else { - ::rtl::OUString aMod; - Event.Element >>= aMod; StarBASIC* pLib = mpMgr->GetLib( maLibName ); DBG_ASSERT( pLib, "BasMgrContainerListenerImpl::elementInserted: Unknown lib!"); @@ -283,7 +300,16 @@ void SAL_CALL BasMgrContainerListenerImpl::elementInserted( const ContainerEvent SbModule* pMod = pLib->FindModule( aName ); if( !pMod ) { - pLib->MakeModule32( aName, aMod ); + ::rtl::OUString aMod; + Event.Element >>= aMod; + Reference< XVBAModuleInfo > xVBAModuleInfo( Event.Source, UNO_QUERY ); + if ( xVBAModuleInfo.is() && xVBAModuleInfo->hasModuleInfo( aName ) ) + { + ModuleInfo mInfo = xVBAModuleInfo->getModuleInfo( aName ); + pLib->MakeModule32( aName, mInfo, aMod ); + } + else + pLib->MakeModule32( aName, aMod ); pLib->SetModified( FALSE ); } } @@ -312,10 +338,11 @@ void SAL_CALL BasMgrContainerListenerImpl::elementReplaced( const ContainerEvent SbModule* pMod = pLib->FindModule( aName ); ::rtl::OUString aMod; Event.Element >>= aMod; + if( pMod ) - pMod->SetSource32( aMod ); + pMod->SetSource32( aMod ); else - pLib->MakeModule32( aName, aMod ); + pLib->MakeModule32( aName, aMod ); pLib->SetModified( FALSE ); } diff --git a/basic/source/classes/errobject.cxx b/basic/source/classes/errobject.cxx new file mode 100644 index 000000000000..0ec0454e2bb5 --- /dev/null +++ b/basic/source/classes/errobject.cxx @@ -0,0 +1,225 @@ +/************************************************************************* +* +* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +* +* Copyright 2000, 2010 Oracle and/or its affiliates. +* +* OpenOffice.org - a multi-platform office productivity suite +* +* This file is part of OpenOffice.org. +* +* OpenOffice.org is free software: you can redistribute it and/or modify +* it under the terms of the GNU Lesser General Public License version 3 +* only, as published by the Free Software Foundation. +* +* OpenOffice.org is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU Lesser General Public License version 3 for more details +* (a copy is included in the LICENSE file that accompanied this code). +* +* You should have received a copy of the GNU Lesser General Public License +* version 3 along with OpenOffice.org. If not, see +* <http://www.openoffice.org/license.html> +* for a copy of the LGPLv3 License. +* +************************************************************************/ + +// MARKER(update_precomp.py): autogen include statement, do not remove +#include "precompiled_basic.hxx" +#include "errobject.hxx" + +#include <cppuhelper/implbase2.hxx> +#include <com/sun/star/script/XDefaultProperty.hpp> +#include "sbintern.hxx" +#include "runtime.hxx" + +using namespace ::com::sun::star; +using namespace ::ooo; + +typedef ::cppu::WeakImplHelper2< vba::XErrObject, script::XDefaultProperty > ErrObjectImpl_BASE; + +class ErrObject : public ErrObjectImpl_BASE +{ + rtl::OUString m_sHelpFile; + rtl::OUString m_sSource; + rtl::OUString m_sDescription; + sal_Int32 m_nNumber; + sal_Int32 m_nHelpContext; + +public: + ErrObject(); + ~ErrObject(); + // Attributes + virtual ::sal_Int32 SAL_CALL getNumber() throw (uno::RuntimeException); + virtual void SAL_CALL setNumber( ::sal_Int32 _number ) throw (uno::RuntimeException); + virtual ::sal_Int32 SAL_CALL getHelpContext() throw (uno::RuntimeException); + virtual void SAL_CALL setHelpContext( ::sal_Int32 _helpcontext ) throw (uno::RuntimeException); + virtual ::rtl::OUString SAL_CALL getHelpFile() throw (uno::RuntimeException); + virtual void SAL_CALL setHelpFile( const ::rtl::OUString& _helpfile ) throw (uno::RuntimeException); + virtual ::rtl::OUString SAL_CALL getDescription() throw (uno::RuntimeException); + virtual void SAL_CALL setDescription( const ::rtl::OUString& _description ) throw (uno::RuntimeException); + virtual ::rtl::OUString SAL_CALL getSource() throw (uno::RuntimeException); + virtual void SAL_CALL setSource( const ::rtl::OUString& _source ) throw (uno::RuntimeException); + + // Methods + virtual void SAL_CALL Clear( ) throw (uno::RuntimeException); + virtual void SAL_CALL Raise( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext ) throw (uno::RuntimeException); + // XDefaultProperty + virtual ::rtl::OUString SAL_CALL getDefaultPropertyName( ) throw (uno::RuntimeException); + + // Helper method + void setData( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, + const uno::Any& HelpFile, const uno::Any& HelpContext ) throw (uno::RuntimeException); +}; + + +ErrObject::~ErrObject() +{ +} + +ErrObject::ErrObject() : m_nNumber(0), m_nHelpContext(0) +{ +} + +sal_Int32 SAL_CALL +ErrObject::getNumber() throw (uno::RuntimeException) +{ + return m_nNumber; +} + +void SAL_CALL +ErrObject::setNumber( ::sal_Int32 _number ) throw (uno::RuntimeException) +{ + pINST->setErrorVB( _number, String() ); + ::rtl::OUString _description = pINST->GetErrorMsg(); + setData( uno::makeAny( _number ), uno::Any(), uno::makeAny( _description ), uno::Any(), uno::Any() ); +} + +::sal_Int32 SAL_CALL +ErrObject::getHelpContext() throw (uno::RuntimeException) +{ + return m_nHelpContext; +} +void SAL_CALL +ErrObject::setHelpContext( ::sal_Int32 _helpcontext ) throw (uno::RuntimeException) +{ + m_nHelpContext = _helpcontext; +} + +::rtl::OUString SAL_CALL +ErrObject::getHelpFile() throw (uno::RuntimeException) +{ + return m_sHelpFile; +} + +void SAL_CALL +ErrObject::setHelpFile( const ::rtl::OUString& _helpfile ) throw (uno::RuntimeException) +{ + m_sHelpFile = _helpfile; +} + +::rtl::OUString SAL_CALL +ErrObject::getDescription() throw (uno::RuntimeException) +{ + return m_sDescription; +} + +void SAL_CALL +ErrObject::setDescription( const ::rtl::OUString& _description ) throw (uno::RuntimeException) +{ + m_sDescription = _description; +} + +::rtl::OUString SAL_CALL +ErrObject::getSource() throw (uno::RuntimeException) +{ + return m_sSource; +} + +void SAL_CALL +ErrObject::setSource( const ::rtl::OUString& _source ) throw (uno::RuntimeException) +{ + m_sSource = _source; +} + +// Methods +void SAL_CALL +ErrObject::Clear( ) throw (uno::RuntimeException) +{ + m_sHelpFile = rtl::OUString(); + m_sSource = m_sHelpFile; + m_sDescription = m_sSource; + m_nNumber = 0; + m_nHelpContext = 0; +} + +void SAL_CALL +ErrObject::Raise( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext ) throw (uno::RuntimeException) +{ + setData( Number, Source, Description, HelpFile, HelpContext ); + if ( m_nNumber ) + pINST->ErrorVB( m_nNumber, m_sDescription ); +} + +// XDefaultProperty +::rtl::OUString SAL_CALL +ErrObject::getDefaultPropertyName( ) throw (uno::RuntimeException) +{ + static rtl::OUString sDfltPropName( RTL_CONSTASCII_USTRINGPARAM("Number") ); + return sDfltPropName; +} + +void ErrObject::setData( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext ) + throw (uno::RuntimeException) +{ + if ( !Number.hasValue() ) + throw uno::RuntimeException( rtl::OUString::createFromAscii("Missing Required Paramater"), uno::Reference< uno::XInterface >() ); + Number >>= m_nNumber; + Description >>= m_sDescription; + Source >>= m_sSource; + HelpFile >>= m_sHelpFile; + HelpContext >>= m_nHelpContext; +} + +// SbxErrObject +SbxErrObject::SbxErrObject( const String& rName, const Any& rUnoObj ) + : SbUnoObject( rName, rUnoObj ) + , m_pErrObject( NULL ) +{ + OSL_TRACE("SbxErrObject::SbxErrObject ctor"); + rUnoObj >>= m_xErr; + if ( m_xErr.is() ) + { + SetDfltProperty( uno::Reference< script::XDefaultProperty >( m_xErr, uno::UNO_QUERY_THROW )->getDefaultPropertyName() ) ; + m_pErrObject = static_cast< ErrObject* >( m_xErr.get() ); + } +} + +SbxErrObject::~SbxErrObject() +{ + OSL_TRACE("SbxErrObject::~SbxErrObject dtor"); +} + +uno::Reference< vba::XErrObject > +SbxErrObject::getUnoErrObject() +{ + SbxVariable* pVar = getErrObject(); + SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pVar ); + return pGlobErr->m_xErr; +} + +SbxVariableRef +SbxErrObject::getErrObject() +{ + static SbxVariableRef pGlobErr = new SbxErrObject( String( RTL_CONSTASCII_USTRINGPARAM("Err")), uno::makeAny( uno::Reference< vba::XErrObject >( new ErrObject() ) ) ); + return pGlobErr; +} + +void SbxErrObject::setNumberAndDescription( ::sal_Int32 _number, const ::rtl::OUString& _description ) + throw (uno::RuntimeException) +{ + if( m_pErrObject != NULL ) + m_pErrObject->setData( uno::makeAny( _number ), uno::Any(), uno::makeAny( _description ), uno::Any(), uno::Any() ); +} + diff --git a/basic/source/classes/eventatt.cxx b/basic/source/classes/eventatt.cxx index 5c57af5b6ce8..791e9fe5a8c1 100644 --- a/basic/source/classes/eventatt.cxx +++ b/basic/source/classes/eventatt.cxx @@ -55,13 +55,17 @@ #include <com/sun/star/awt/XDialogProvider.hpp> #include <com/sun/star/frame/XModel.hpp> - +#include <com/sun/star/frame/XDesktop.hpp> +#include <com/sun/star/container/XEnumerationAccess.hpp> +#include <basic/basicmanagerrepository.hxx> +#include <basic/basmgr.hxx> //================================================================================================== #include <xmlscript/xmldlg_imexp.hxx> #include <sbunoobj.hxx> #include <basic/sbstar.hxx> #include <basic/sbmeth.hxx> +#include <basic/sbuno.hxx> #include <runtime.hxx> #include <sbintern.hxx> @@ -85,11 +89,6 @@ using namespace ::osl; -//=================================================================== -void unoToSbxValue( SbxVariable* pVar, const Any& aValue ); -Any sbxToUnoValue( SbxVariable* pVar ); - - Reference< frame::XModel > getModelFromBasic( SbxObject* pBasic ) { OSL_PRECOND( pBasic != NULL, "getModelFromBasic: illegal call!" ); @@ -450,6 +449,43 @@ Any implFindDialogLibForDialog( const Any& rDlgAny, SbxObject* pBasic ) return aRetDlgLibAny; } +Any implFindDialogLibForDialogBasic( const Any& aAnyISP, SbxObject* pBasic, StarBASIC*& pFoundBasic ) +{ + Any aDlgLibAny; + // Find dialog library for dialog, direct access is not possible here + StarBASIC* pStartedBasic = (StarBASIC*)pBasic; + SbxObject* pParentBasic = pStartedBasic ? pStartedBasic->GetParent() : NULL; + SbxObject* pParentParentBasic = pParentBasic ? pParentBasic->GetParent() : NULL; + + SbxObject* pSearchBasic1 = NULL; + SbxObject* pSearchBasic2 = NULL; + if( pParentParentBasic ) + { + pSearchBasic1 = pParentBasic; + pSearchBasic2 = pParentParentBasic; + } + else + { + pSearchBasic1 = pStartedBasic; + pSearchBasic2 = pParentBasic; + } + if( pSearchBasic1 ) + { + aDlgLibAny = implFindDialogLibForDialog( aAnyISP, pSearchBasic1 ); + + if ( aDlgLibAny.hasValue() ) + pFoundBasic = (StarBASIC*)pSearchBasic1; + + else if( pSearchBasic2 ) + { + aDlgLibAny = implFindDialogLibForDialog( aAnyISP, pSearchBasic2 ); + if ( aDlgLibAny.hasValue() ) + pFoundBasic = (StarBASIC*)pSearchBasic2; + } + } + return aDlgLibAny; +} + static ::rtl::OUString aDecorationPropName = ::rtl::OUString::createFromAscii( "Decoration" ); static ::rtl::OUString aTitlePropName = @@ -529,39 +565,54 @@ void RTL_Impl_CreateUnoDialog( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite ) {} } - // Find dialog library for dialog, direct access is not possible here - StarBASIC* pStartedBasic = pINST->GetBasic(); - SbxObject* pParentBasic = pStartedBasic ? pStartedBasic->GetParent() : NULL; - SbxObject* pParentParentBasic = pParentBasic ? pParentBasic->GetParent() : NULL; - - SbxObject* pSearchBasic1 = NULL; - SbxObject* pSearchBasic2 = NULL; - if( pParentParentBasic ) + Any aDlgLibAny; + bool bDocDialog = false; + StarBASIC* pFoundBasic = NULL; + OSL_TRACE("About to try get a hold of ThisComponent"); + Reference< frame::XModel > xModel = getModelFromBasic( pINST->GetBasic() ) ; + aDlgLibAny = implFindDialogLibForDialogBasic( aAnyISP, pINST->GetBasic(), pFoundBasic ); + // If we found the dialog then it belongs to the Search basic + if ( !pFoundBasic ) { - pSearchBasic1 = pParentBasic; - pSearchBasic2 = pParentParentBasic; - } - else + Reference< frame::XDesktop > xDesktop( xMSF->createInstance + ( ::rtl::OUString(RTL_CONSTASCII_USTRINGPARAM( "com.sun.star.frame.Desktop" ) ) ), + UNO_QUERY ); + Reference< container::XEnumeration > xModels; + if ( xDesktop.is() ) { - pSearchBasic1 = pStartedBasic; - pSearchBasic2 = pParentBasic; - } - - Any aDlgLibAny; - if( pSearchBasic1 ) + Reference< container::XEnumerationAccess > xComponents( xDesktop->getComponents(), UNO_QUERY ); + if ( xComponents.is() ) + xModels.set( xComponents->createEnumeration(), UNO_QUERY ); + if ( xModels.is() ) + { + while ( xModels->hasMoreElements() ) + { + Reference< frame::XModel > xNextModel( xModels->nextElement(), UNO_QUERY ); + if ( xNextModel.is() ) + { + BasicManager* pMgr = basic::BasicManagerRepository::getDocumentBasicManager( xNextModel ); + if ( pMgr ) + aDlgLibAny = implFindDialogLibForDialogBasic( aAnyISP, pMgr->GetLib(0), pFoundBasic ); + if ( aDlgLibAny.hasValue() ) { - aDlgLibAny = implFindDialogLibForDialog( aAnyISP, pSearchBasic1 ); - if( pSearchBasic2 && aDlgLibAny.getValueType().getTypeClass() == TypeClass_VOID ) - aDlgLibAny = implFindDialogLibForDialog( aAnyISP, pSearchBasic2 ); + bDocDialog = true; + xModel = xNextModel; + break; } - - - OSL_TRACE("About to try get a hold of ThisComponent"); - Reference< frame::XModel > xModel = getModelFromBasic( pStartedBasic ) ; - Reference< XScriptListener > xScriptListener = new BasicScriptListener_Impl( pStartedBasic, xModel ); + } + } + } + } + } + if ( pFoundBasic ) + bDocDialog = pFoundBasic->IsDocBasic(); + Reference< XScriptListener > xScriptListener = new BasicScriptListener_Impl( pINST->GetBasic(), xModel ); Sequence< Any > aArgs( 4 ); - aArgs[ 0 ] <<= xModel; + if( bDocDialog ) + aArgs[ 0 ] <<= xModel; + else + aArgs[ 0 ] <<= uno::Reference< uno::XInterface >(); aArgs[ 1 ] <<= xInput; aArgs[ 2 ] = aDlgLibAny; aArgs[ 3 ] <<= xScriptListener; diff --git a/basic/source/classes/makefile.mk b/basic/source/classes/makefile.mk index eb5486f02abf..e00ed4674cc1 100644 --- a/basic/source/classes/makefile.mk +++ b/basic/source/classes/makefile.mk @@ -37,18 +37,28 @@ ENABLE_EXCEPTIONS=TRUE .INCLUDE : settings.mk +ALLTAR .SEQUENTIAL : \ + $(MISC)$/$(TARGET).don \ + $(MISC)$/$(TARGET).slo + +$(MISC)$/$(TARGET).don : $(SOLARBINDIR)$/oovbaapi.rdb + +$(CPPUMAKER) -O$(OUT)$/inc -BUCR $(SOLARBINDIR)$/oovbaapi.rdb -X$(SOLARBINDIR)$/types.rdb && echo > $@ + echo $@ + +$(MISC)$/$(TARGET).slo : $(SLOTARGET) + echo $@ + # --- Allgemein ----------------------------------------------------------- -COMMON_SLOFILES= \ +SLOFILES= \ $(SLO)$/sb.obj \ $(SLO)$/sbxmod.obj \ $(SLO)$/image.obj \ $(SLO)$/sbintern.obj \ $(SLO)$/sbunoobj.obj \ $(SLO)$/propacc.obj \ - $(SLO)$/disas.obj - -SLOFILES= $(COMMON_SLOFILES) \ + $(SLO)$/disas.obj \ + $(SLO)$/errobject.obj \ $(SLO)$/eventatt.obj OBJFILES= \ diff --git a/basic/source/classes/sb.cxx b/basic/source/classes/sb.cxx index 3373442e5eb2..4f2f90d5da1f 100755 --- a/basic/source/classes/sb.cxx +++ b/basic/source/classes/sb.cxx @@ -49,12 +49,18 @@ #include "disas.hxx" #include "runtime.hxx" #include <basic/sbuno.hxx> +#include <basic/sbobjmod.hxx> #include "stdobj.hxx" #include "filefmt.hxx" #include "sb.hrc" #include <basrid.hxx> #include <vos/mutex.hxx> #include <com/sun/star/lang/XMultiServiceFactory.hpp> +#include "errobject.hxx" + +#include <com/sun/star/script/ModuleType.hpp> +#include <com/sun/star/script/ModuleInfo.hpp> +using namespace ::com::sun::star::script; // #pragma SW_SEGMENT_CLASS( SBASIC, SBASIC_CODE ) @@ -238,6 +244,7 @@ const SFX_VB_ErrorItem __FAR_DATA SFX_VB_ErrorTab[] = { 1004, SbERR_METHOD_FAILED }, { 1005, SbERR_SETPROP_FAILED }, { 1006, SbERR_GETPROP_FAILED }, + { 1007, SbERR_BASIC_COMPAT }, { 0xFFFF, 0xFFFFFFFFL } // End mark }; @@ -508,6 +515,7 @@ SbClassModuleObject::SbClassModuleObject( SbModule* pClassModule ) } } } + SetModuleType( ModuleType::CLASS ); } SbClassModuleObject::~SbClassModuleObject() @@ -705,6 +713,7 @@ StarBASIC::StarBASIC( StarBASIC* p, BOOL bIsDocBasic ) SetParent( p ); pLibInfo = NULL; bNoRtl = bBreak = FALSE; + bVBAEnabled = FALSE; pModules = new SbxArray; if( !GetSbData()->nInst++ ) @@ -805,7 +814,34 @@ SbModule* StarBASIC::MakeModule( const String& rName, const String& rSrc ) SbModule* StarBASIC::MakeModule32( const String& rName, const ::rtl::OUString& rSrc ) { - SbModule* p = new SbModule( rName ); + ModuleInfo mInfo; + mInfo.ModuleType = ModuleType::NORMAL; + return MakeModule32( rName, mInfo, rSrc ); +} +SbModule* StarBASIC::MakeModule32( const String& rName, const ModuleInfo& mInfo, const rtl::OUString& rSrc ) +{ + + OSL_TRACE("create module %s type mInfo %d", rtl::OUStringToOString( rName, RTL_TEXTENCODING_UTF8 ).getStr(), mInfo.ModuleType ); + SbModule* p = NULL; + switch ( mInfo.ModuleType ) + { + case ModuleType::DOCUMENT: + // In theory we should be able to create Object modules + // in ordinary basic ( in vba mode thought these are create + // by the application/basic and not by the user ) + p = new SbObjModule( rName, mInfo, isVBAEnabled() ); + break; + case ModuleType::CLASS: + p = new SbModule( rName, isVBAEnabled() ); + p->SetModuleType( ModuleType::CLASS ); + break; + case ModuleType::FORM: + p = new SbUserFormModule( rName, mInfo, isVBAEnabled() ); + break; + default: + p = new SbModule( rName, isVBAEnabled() ); + + } p->SetSource32( rSrc ); p->SetParent( this ); pModules->Insert( p, pModules->Count() ); @@ -981,6 +1017,12 @@ SbxVariable* StarBASIC::Find( const String& rName, SbxClassType t ) } pNamed = p; } + // Only variables qualified by the Module Name e.g. Sheet1.foo + // should work for Documant && Class type Modules + INT32 nType = p->GetModuleType(); + if ( nType == ModuleType::DOCUMENT || nType == ModuleType::FORM ) + continue; + // otherwise check if the element is available // unset GBLSEARCH-Flag (due to Rekursion) USHORT nGblFlag = p->GetFlags() & SBX_GBLSEARCH; @@ -1352,6 +1394,7 @@ void StarBASIC::MakeErrorText( SbError nId, const String& aMsg ) } else GetSbData()->aErrMsg = String::EmptyString(); + } BOOL StarBASIC::CError @@ -1408,7 +1451,22 @@ BOOL StarBASIC::RTError( SbError code, const String& rMsg, USHORT l, USHORT c1, // Umsetzung des Codes fuer String-Transport in SFX-Error if( rMsg.Len() ) - code = (ULONG)*new StringErrorInfo( code, String(rMsg) ); + { + // very confusing, even though MakeErrorText sets up the error text + // seems that this is not used ( if rMsg already has content ) + // In the case of VBA MakeErrorText also formats the error to be alittle more + // like vba ( adds an error number etc ) + if ( SbiRuntime::isVBAEnabled() && ( code == SbERR_BASIC_COMPAT ) ) + { + String aTmp = '\''; + aTmp += String::CreateFromInt32( SbxErrObject::getUnoErrObject()->getNumber() ); + aTmp += String( RTL_CONSTASCII_USTRINGPARAM("\'\n") ); + aTmp += GetSbData()->aErrMsg.Len() ? GetSbData()->aErrMsg : rMsg; + code = (ULONG)*new StringErrorInfo( code, aTmp ); + } + else + code = (ULONG)*new StringErrorInfo( code, String(rMsg) ); + } SetErrorData( code, l, c1, c2 ); if( GetSbData()->aErrHdl.IsSet() ) diff --git a/basic/source/classes/sb.src b/basic/source/classes/sb.src index 926da0359d7e..73cc1c3a0b2c 100644 --- a/basic/source/classes/sb.src +++ b/basic/source/classes/sb.src @@ -588,6 +588,10 @@ Resource RID_BASIC_START { Text [ en-US ] = "For loop not initialized." ; }; + String ERRCODE_BASIC_COMPAT & ERRCODE_RES_MASK + { + Text [ en-US ] = "$(ARG1)" ; + }; }; // Hinweis: IDS_SBERR_TERMINATED = IDS_SBERR_START+2000. String IDS_SBERR_TERMINATED diff --git a/basic/source/classes/sbunoobj.cxx b/basic/source/classes/sbunoobj.cxx index 1c95b4f30de6..849fd839bfd1 100644 --- a/basic/source/classes/sbunoobj.cxx +++ b/basic/source/classes/sbunoobj.cxx @@ -567,7 +567,7 @@ SbxDataType unoToSbxType( const Reference< XIdlClass >& xIdlClass ) } return eRetType; } -void unoToSbxValue( SbxVariable* pVar, const Any& aValue ); + static void implSequenceToMultiDimArray( SbxDimArray*& pArray, Sequence< sal_Int32 >& indices, Sequence< sal_Int32 >& sizes, const Any& aValue, sal_Int32& dimension, sal_Bool bIsZeroIndex, Type* pType = NULL ) { Type aType = aValue.getValueType(); diff --git a/basic/source/classes/sbxmod.cxx b/basic/source/classes/sbxmod.cxx index 092ef458041e..83c0ae9e65f4 100644 --- a/basic/source/classes/sbxmod.cxx +++ b/basic/source/classes/sbxmod.cxx @@ -52,7 +52,13 @@ #include <basic/basrdll.hxx> #include <vos/mutex.hxx> +#include <basic/sbobjmod.hxx> +#include <com/sun/star/lang/XServiceInfo.hpp> +#include <com/sun/star/script/ModuleType.hpp> +#include <com/sun/star/script/XVBACompat.hpp> +#include <com/sun/star/beans/XPropertySet.hpp> +using namespace com::sun::star; // for the bsearch #ifdef WNT @@ -72,6 +78,13 @@ #include <vcl/svapp.hxx> using namespace ::com::sun::star; +#include <com/sun/star/script/XLibraryContainer.hpp> +#include <com/sun/star/lang/XMultiServiceFactory.hpp> +#include <com/sun/star/awt/XDialogProvider.hpp> +#include <com/sun/star/awt/XTopWindow.hpp> +#include <com/sun/star/awt/XControl.hpp> +#include <cppuhelper/implbase1.hxx> +#include <comphelper/anytostring.hxx> TYPEINIT1(SbModule,SbxObject) TYPEINIT1(SbMethod,SbxMethod) @@ -79,6 +92,8 @@ TYPEINIT1(SbProperty,SbxProperty) TYPEINIT1(SbProcedureProperty,SbxProperty) TYPEINIT1(SbJScriptModule,SbModule) TYPEINIT1(SbJScriptMethod,SbMethod) +TYPEINIT1(SbObjModule,SbModule) +TYPEINIT1(SbUserFormModule,SbObjModule) SV_DECL_VARARR(SbiBreakpoints,USHORT,4,4) SV_IMPL_VARARR(SbiBreakpoints,USHORT) @@ -86,6 +101,26 @@ SV_IMPL_VARARR(SbiBreakpoints,USHORT) SV_IMPL_VARARR(HighlightPortions, HighlightPortion) +bool getDefaultVBAMode( StarBASIC* pb ) +{ + bool bResult = false; + if ( pb && pb->IsDocBasic() ) + { + uno::Any aDoc; + if ( pb->GetUNOConstant( "ThisComponent", aDoc ) ) + { + uno::Reference< beans::XPropertySet > xProp( aDoc, uno::UNO_QUERY ); + if ( xProp.is() ) + { + uno::Reference< script::XVBACompat > xVBAMode( xProp->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("BasicLibraries") ) ), uno::UNO_QUERY ); + if ( xVBAMode.is() ) + bResult = ( xVBAMode->getVBACompatModeOn() == sal_True ); + } + } + } + return bResult; +} + class AsyncQuitHandler { AsyncQuitHandler() {} @@ -148,12 +183,13 @@ bool UnlockControllerHack( StarBASIC* pBasic ) // Ein BASIC-Modul hat EXTSEARCH gesetzt, damit die im Modul enthaltenen // Elemente von anderen Modulen aus gefunden werden koennen. -SbModule::SbModule( const String& rName ) +SbModule::SbModule( const String& rName, BOOL bVBACompat ) : SbxObject( String( RTL_CONSTASCII_USTRINGPARAM("StarBASICModule") ) ), - pImage( NULL ), pBreaks( NULL ), pClassData( NULL ) + pImage( NULL ), pBreaks( NULL ), pClassData( NULL ), mbVBACompat( bVBACompat ), pDocObject( NULL ), bIsProxyModule( false ) { SetName( rName ); SetFlag( SBX_EXTSEARCH | SBX_GBLSEARCH ); + SetModuleType( script::ModuleType::NORMAL ); } SbModule::~SbModule() @@ -328,7 +364,10 @@ void SbModule::Clear() 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 ) + return NULL; if( !pRes && pImage ) { SbiInstance* pInst = pINST; @@ -427,6 +466,8 @@ void SbModule::SetSource( const String& r ) void SbModule::SetSource32( const ::rtl::OUString& r ) { + // Default basic mode to library container mode, but.. allow Option VBASupport 0/1 override + SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) ); aOUSource = r; StartDefinitions(); SbiTokenizer aTok( r ); @@ -457,9 +498,14 @@ void SbModule::SetSource32( const ::rtl::OUString& r ) if( eCurTok == OPTION ) { eCurTok = aTok.Next(); - if( eCurTok == COMPATIBLE - || ( ( eCurTok == VBASUPPORT ) && ( aTok.Next() == NUMBER ) && ( aTok.GetDbl()== 1 ) ) ) + if( eCurTok == COMPATIBLE ) aTok.SetCompatible( true ); + else if ( ( eCurTok == VBASUPPORT ) && ( aTok.Next() == NUMBER ) ) + { + BOOL bIsVBA = ( aTok.GetDbl()== 1 ); + SetVBACompat( bIsVBA ); + aTok.SetCompatible( bIsVBA ); + } } } eLastTok = eCurTok; @@ -600,7 +646,15 @@ void ClearUnoObjectsInRTL_Impl( StarBASIC* pBasic ) if( ((StarBASIC*)p) != pBasic ) ClearUnoObjectsInRTL_Impl_Rek( (StarBASIC*)p ); } +BOOL SbModule::IsVBACompat() +{ + return mbVBACompat; +} +void SbModule::SetVBACompat( BOOL bCompat ) +{ + mbVBACompat = bCompat; +} // Ausfuehren eines BASIC-Unterprogramms USHORT SbModule::Run( SbMethod* pMeth ) { @@ -695,10 +749,9 @@ USHORT SbModule::Run( SbMethod* pMeth ) if( pRt->pNext ) pRt->pNext->block(); pINST->pRun = pRt; - if ( SbiRuntime ::isVBAEnabled() ) + if ( mbVBACompat ) { pINST->EnableCompatibility( TRUE ); - pRt->SetVBAEnabled( true ); } while( pRt->Step() ) {} if( pRt->pNext ) @@ -1483,6 +1536,389 @@ SbJScriptMethod::~SbJScriptMethod() ///////////////////////////////////////////////////////////////////////// +SbObjModule::SbObjModule( const String& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVbaCompatible ) + : SbModule( rName, bIsVbaCompatible ) +{ + SetModuleType( mInfo.ModuleType ); + if ( mInfo.ModuleType == script::ModuleType::FORM ) + { + SetClassName( rtl::OUString::createFromAscii( "Form" ) ); + } + else if ( mInfo.ModuleObject.is() ) + SetUnoObject( uno::makeAny( mInfo.ModuleObject ) ); +} +void +SbObjModule::SetUnoObject( const uno::Any& aObj ) throw ( uno::RuntimeException ) +{ + SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxVariable*)pDocObject); + if ( pUnoObj && pUnoObj->getUnoAny() == aObj ) // object is equal, nothing to do + return; + pDocObject = new SbUnoObject( GetName(), uno::makeAny( aObj ) ); + + com::sun::star::uno::Reference< com::sun::star::lang::XServiceInfo > xServiceInfo( aObj, com::sun::star::uno::UNO_QUERY_THROW ); + if( xServiceInfo->supportsService( rtl::OUString::createFromAscii( "ooo.vba.excel.Worksheet" ) ) ) + { + SetClassName( rtl::OUString::createFromAscii( "Worksheet" ) ); + } + else if( xServiceInfo->supportsService( rtl::OUString::createFromAscii( "ooo.vba.excel.Workbook" ) ) ) + { + SetClassName( rtl::OUString::createFromAscii( "Workbook" ) ); + } +} + +SbxVariable* +SbObjModule::GetObject() +{ + return pDocObject; +} +SbxVariable* +SbObjModule::Find( const XubString& rName, SbxClassType t ) +{ + //OSL_TRACE("SbObjectModule find for %s", rtl::OUStringToOString( rName, RTL_TEXTENCODING_UTF8 ).getStr() ); + SbxVariable* pVar = NULL; + if ( pDocObject) + pVar = pDocObject->Find( rName, t ); + if ( !pVar ) + pVar = SbModule::Find( rName, t ); + return pVar; +} + +typedef ::cppu::WeakImplHelper1< awt::XTopWindowListener > EventListener_BASE; + +class FormObjEventListenerImpl : public EventListener_BASE +{ + SbUserFormModule* mpUserForm; + uno::Reference< lang::XComponent > mxComponent; + bool mbDisposed; + sal_Bool mbOpened; + sal_Bool mbActivated; + sal_Bool mbShowing; + FormObjEventListenerImpl(); // not defined + FormObjEventListenerImpl(const FormObjEventListenerImpl&); // not defined +public: + FormObjEventListenerImpl( SbUserFormModule* pUserForm, const uno::Reference< lang::XComponent >& xComponent ) : mpUserForm( pUserForm ), mxComponent( xComponent) , mbDisposed( false ), mbOpened( sal_False ), mbActivated( sal_False ), mbShowing( sal_False ) + { + if ( mxComponent.is() ) + { + uno::Reference< awt::XTopWindow > xList( mxComponent, uno::UNO_QUERY_THROW );; + OSL_TRACE("*********** Registering the listener"); + xList->addTopWindowListener( this ); + } + } + + ~FormObjEventListenerImpl() + { + removeListener(); + } + sal_Bool isShowing() { return mbShowing; } + void removeListener() + { + try + { + if ( mxComponent.is() && !mbDisposed ) + { + uno::Reference< awt::XTopWindow > xList( mxComponent, uno::UNO_QUERY_THROW );; + OSL_TRACE("*********** Removing the listener"); + xList->removeTopWindowListener( this ); + mxComponent = NULL; + } + } + catch( uno::Exception& ) {} + } + virtual void SAL_CALL windowOpened( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException) + { + if ( mpUserForm ) + { + mbOpened = sal_True; + mbShowing = sal_True; + if ( mbActivated ) + { + mbOpened = mbActivated = sal_False; + mpUserForm->triggerActivateEvent(); + } + } + } + + //liuchen 2009-7-21, support Excel VBA Form_QueryClose event + 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() ) + { + uno::Reference< awt::XControl > xControl( xDialog, uno::UNO_QUERY ); + if ( xControl->getPeer().is() ) + { + uno::Reference< document::XVbaMethodParameter > xVbaMethodParameter( xControl->getPeer(), uno::UNO_QUERY ); + if ( xVbaMethodParameter.is() ) + { + sal_Int8 nCancel = 0; + sal_Int8 nCloseMode = 0; + + Sequence< Any > aParams; + aParams.realloc(2); + aParams[0] <<= nCancel; + aParams[1] <<= nCloseMode; + + mpUserForm->triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_QueryClose") ), + aParams); + xVbaMethodParameter->setVbaMethodParameter( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Cancel")), aParams[0]); + return; + + } + } + } + + mpUserForm->triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_QueryClose") ) ); +#endif + } + //liuchen 2009-7-21 + + virtual void SAL_CALL windowClosed( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException) { mbOpened = sal_False; mbShowing = sal_False; } + virtual void SAL_CALL windowMinimized( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException) {} + virtual void SAL_CALL windowNormalized( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException){} + virtual void SAL_CALL windowActivated( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException) + { + if ( mpUserForm ) + { + mbActivated = sal_True; + if ( mbOpened ) + { + mbOpened = mbActivated = sal_False; + mpUserForm->triggerActivateEvent(); + } + } + } + + virtual void SAL_CALL windowDeactivated( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException) + { + if ( mpUserForm ) + mpUserForm->triggerDeActivateEvent(); + } + + + virtual void SAL_CALL disposing( const lang::EventObject& Source ) throw (uno::RuntimeException) + { + OSL_TRACE("** Userform/Dialog disposing"); + mbDisposed = true; + uno::Any aSource; + aSource <<= Source; + mxComponent = NULL; + if ( mpUserForm ) + mpUserForm->ResetApiObj(); + } +}; + +SbUserFormModule::SbUserFormModule( const String& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsCompat ) + :SbObjModule( rName, mInfo, bIsCompat ), mbInit( false ) +{ + m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW ); +} + +void SbUserFormModule::ResetApiObj() +{ + if ( m_xDialog.is() ) // probably someone close the dialog window + { + triggerTerminateEvent(); + } + pDocObject = NULL; + m_xDialog = NULL; +} + +void SbUserFormModule::triggerMethod( const String& aMethodToRun ) +{ + Sequence< Any > aArguments; + triggerMethod( aMethodToRun, 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 + { + SbxArrayRef xArray = new SbxArray; + xArray->Put( pMeth, 0 ); // Method as parameter 0 + + for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i ) + { + SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT ); + unoToSbxValue( static_cast< SbxVariable* >( xSbxVar ), aArguments[i] ); + xArray->Put( xSbxVar, static_cast< USHORT >( i ) + 1 ); + + // Enable passing by ref + if ( xSbxVar->GetType() != SbxVARIANT ) + xSbxVar->SetFlag( SBX_FIXED ); + } + pMeth->SetParameters( xArray ); + + SbxValues aVals; + pMeth->Get( aVals ); + + for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i ) + { + aArguments[i] = sbxToUnoValue( xArray->Get( static_cast< USHORT >(i) + 1) ); + } + pMeth->SetParameters( NULL ); + } + else +//liuchen 2009-7-21 +#endif + { + SbxValues aVals; + pMeth->Get( aVals ); + } + } +} + +void SbUserFormModule::triggerActivateEvent( void ) +{ + OSL_TRACE("**** entering SbUserFormModule::triggerActivate"); + triggerMethod( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("UserForm_activate") ) ); + OSL_TRACE("**** leaving SbUserFormModule::triggerActivate"); +} + +void SbUserFormModule::triggerDeActivateEvent( void ) +{ + OSL_TRACE("**** SbUserFormModule::triggerDeActivate"); + triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_DeActivate") ) ); +} + +void SbUserFormModule::triggerInitializeEvent( void ) + +{ + if ( mbInit ) + return; + OSL_TRACE("**** SbUserFormModule::triggerInitializeEvent"); + static String aInitMethodName( RTL_CONSTASCII_USTRINGPARAM("Userform_Initialize") ); + triggerMethod( aInitMethodName ); + mbInit = true; +} + +void SbUserFormModule::triggerTerminateEvent( void ) +{ + OSL_TRACE("**** SbUserFormModule::triggerTerminateEvent"); + static String aTermMethodName( RTL_CONSTASCII_USTRINGPARAM("Userform_Terminate") ); + triggerMethod( aTermMethodName ); + mbInit=false; +} + +void SbUserFormModule::load() +{ + OSL_TRACE("** load() "); + // forces a load + if ( !pDocObject ) + InitObject(); +} + +//liuchen 2009-7-21 change to accmordate VBA's beheavior +void SbUserFormModule::Unload() +{ + OSL_TRACE("** Unload() "); + + sal_Int8 nCancel = 0; + sal_Int8 nCloseMode = 1; + + Sequence< Any > aParams; + aParams.realloc(2); + aParams[0] <<= nCancel; + aParams[1] <<= nCloseMode; + + triggerMethod( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Userform_QueryClose") ), aParams); + + aParams[0] >>= nCancel; + if (nCancel == 1) + { + return; + } + + if ( m_xDialog.is() ) + { + triggerTerminateEvent(); + } + // Search method + SbxVariable* pMeth = SbObjModule::Find( String( RTL_CONSTASCII_USTRINGPARAM( "UnloadObject" ) ), SbxCLASS_METHOD ); + if( pMeth ) + { + OSL_TRACE("Attempting too run the UnloadObjectMethod"); + m_xDialog = NULL; //release ref to the uno object + SbxValues aVals; + FormObjEventListenerImpl* pFormListener = dynamic_cast< FormObjEventListenerImpl* >( m_DialogListener.get() ); + bool bWaitForDispose = true; // assume dialog is showing + if ( pFormListener ) + { + bWaitForDispose = pFormListener->isShowing(); + OSL_TRACE("Showing %d", bWaitForDispose ); + } + pMeth->Get( aVals); + if ( !bWaitForDispose ) + { + // we've either already got a dispose or we'er never going to get one + ResetApiObj(); + } // else wait for dispose + OSL_TRACE("UnloadObject completed ( we hope )"); + } +} +//liuchen + +void SbUserFormModule::InitObject() +{ + try + { + + String aHook( RTL_CONSTASCII_USTRINGPARAM( "VBAGlobals" ) ); + SbUnoObject* pGlobs = (SbUnoObject*)GetParent()->Find( aHook, SbxCLASS_DONTCARE ); + if ( m_xModel.is() && pGlobs ) + { + + uno::Reference< lang::XMultiServiceFactory > xVBAFactory( pGlobs->getUnoAny(), uno::UNO_QUERY_THROW ); + uno::Reference< lang::XMultiServiceFactory > xFactory = comphelper::getProcessServiceFactory(); + uno::Sequence< uno::Any > aArgs(1); + aArgs[ 0 ] <<= m_xModel; + rtl::OUString sDialogUrl( RTL_CONSTASCII_USTRINGPARAM("vnd.sun.star.script:" ) ); + rtl::OUString sProjectName( RTL_CONSTASCII_USTRINGPARAM("Standard") ); + if ( this->GetParent()->GetName().Len() ) + sProjectName = this->GetParent()->GetName(); + sDialogUrl = sDialogUrl.concat( sProjectName ).concat( rtl::OUString( '.') ).concat( GetName() ).concat( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("?location=document") ) ); + + uno::Reference< awt::XDialogProvider > xProvider( xFactory->createInstanceWithArguments( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.awt.DialogProvider")), aArgs ), uno::UNO_QUERY_THROW ); + m_xDialog = xProvider->createDialog( sDialogUrl ); + + // create vba api object + aArgs.realloc( 4 ); + aArgs[ 0 ] = uno::Any(); + aArgs[ 1 ] <<= m_xDialog; + aArgs[ 2 ] <<= m_xModel; + aArgs[ 3 ] <<= rtl::OUString( GetParent()->GetName() ); + 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 + FormObjEventListenerImpl* pFormListener = dynamic_cast< FormObjEventListenerImpl* >( m_DialogListener.get() ); + if ( pFormListener ) + pFormListener->removeListener(); + m_DialogListener = new FormObjEventListenerImpl( this, xComponent ); + + triggerInitializeEvent(); + } + } + catch( uno::Exception& e ) + { + } + +} + +SbxVariable* +SbUserFormModule::Find( const XubString& rName, SbxClassType t ) +{ + if ( !pDocObject && !GetSbData()->bRunInit && pINST ) + InitObject(); + return SbObjModule::Find( rName, t ); +} +///////////////////////////////////////////////////////////////////////// SbProperty::SbProperty( const String& r, SbxDataType t, SbModule* p ) : SbxProperty( r, t ), pMod( p ) diff --git a/basic/source/comp/codegen.cxx b/basic/source/comp/codegen.cxx index c7a63b6d7fbb..46f829b382e8 100644 --- a/basic/source/comp/codegen.cxx +++ b/basic/source/comp/codegen.cxx @@ -32,6 +32,7 @@ #include "sbcomp.hxx" #include "image.hxx" #include <limits> +#include <com/sun/star/script/ModuleType.hpp> // nInc ist die Inkrementgroesse der Puffer @@ -127,12 +128,12 @@ void SbiCodeGen::Save() // OPTION EXPLICIT-Flag uebernehmen if( pParser->bExplicit ) p->SetFlag( SBIMG_EXPLICIT ); - if( pParser->IsVBASupportOn() ) - p->SetFlag( SBIMG_VBASUPPORT ); int nIfaceCount = 0; - if( pParser->bClassModule ) + if( rMod.mnType == com::sun::star::script::ModuleType::CLASS ) { + OSL_TRACE("COdeGen::save() classmodule processing"); + rMod.bIsProxyModule = true; p->SetFlag( SBIMG_CLASSMODULE ); pCLASSFAC->AddClassModule( &rMod ); @@ -155,6 +156,10 @@ void SbiCodeGen::Save() else { pCLASSFAC->RemoveClassModule( &rMod ); + // Only a ClassModule can revert to Normal + if ( rMod.mnType == com::sun::star::script::ModuleType::CLASS ) + rMod.mnType = com::sun::star::script::ModuleType::NORMAL; + rMod.bIsProxyModule = false; } if( pParser->bText ) p->SetFlag( SBIMG_COMPARETEXT ); diff --git a/basic/source/comp/parser.cxx b/basic/source/comp/parser.cxx index 400e77a94b16..8770dc8539f0 100644 --- a/basic/source/comp/parser.cxx +++ b/basic/source/comp/parser.cxx @@ -29,6 +29,7 @@ #include "precompiled_basic.hxx" #include <basic/sbx.hxx> #include "sbcomp.hxx" +#include <com/sun/star/script/ModuleType.hpp> struct SbiParseStack { // "Stack" fuer Statement-Blocks SbiParseStack* pNext; // Chain @@ -140,7 +141,8 @@ SbiParser::SbiParser( StarBASIC* pb, SbModule* pm ) bNewGblDefs = bSingleLineIf = bExplicit = FALSE; - bClassModule = FALSE; + bClassModule = ( pm->GetModuleType() == com::sun::star::script::ModuleType::CLASS ); + OSL_TRACE("Parser - %s, bClassModule %d", rtl::OUStringToOString( pm->GetName(), RTL_TEXTENCODING_UTF8 ).getStr(), bClassModule ); pPool = &aPublics; for( short i = 0; i < 26; i++ ) eDefTypes[ i ] = SbxVARIANT; // Kein expliziter Defaulttyp @@ -153,6 +155,10 @@ SbiParser::SbiParser( StarBASIC* pb, SbModule* pm ) rTypeArray = new SbxArray; // Array fuer Benutzerdefinierte Typen rEnumArray = new SbxArray; // Array for Enum types + bVBASupportOn = pm->IsVBACompat(); + if ( bVBASupportOn ) + EnableCompatibility(); + } @@ -751,6 +757,7 @@ void SbiParser::Option() case CLASSMODULE: bClassModule = TRUE; + aGen.GetModule().SetModuleType( com::sun::star::script::ModuleType::CLASS ); break; case VBASUPPORT: if( Next() == NUMBER ) @@ -760,6 +767,10 @@ void SbiParser::Option() bVBASupportOn = ( nVal == 1 ); if ( bVBASupportOn ) EnableCompatibility(); + // if the module setting is different + // reset it to what the Option tells us + if ( bVBASupportOn != aGen.GetModule().IsVBACompat() ) + aGen.GetModule().SetVBACompat( bVBASupportOn ); break; } } diff --git a/basic/source/inc/codegen.hxx b/basic/source/inc/codegen.hxx index d0a613eabebc..3d90d16bdcbe 100644 --- a/basic/source/inc/codegen.hxx +++ b/basic/source/inc/codegen.hxx @@ -53,6 +53,7 @@ public: void GenStmnt(); // evtl. Statement-Opcode erzeugen UINT32 GetPC(); UINT32 GetOffset() { return GetPC() + 1; } + SbModule& GetModule() { return rMod; } void Save(); // #29955 for-Schleifen-Ebene pflegen diff --git a/basic/source/inc/errobject.hxx b/basic/source/inc/errobject.hxx new file mode 100644 index 000000000000..39e6e319caae --- /dev/null +++ b/basic/source/inc/errobject.hxx @@ -0,0 +1,52 @@ +/************************************************************************* +* +* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +* +* Copyright 2000, 2010 Oracle and/or its affiliates. +* +* OpenOffice.org - a multi-platform office productivity suite +* +* This file is part of OpenOffice.org. +* +* OpenOffice.org is free software: you can redistribute it and/or modify +* it under the terms of the GNU Lesser General Public License version 3 +* only, as published by the Free Software Foundation. +* +* OpenOffice.org is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU Lesser General Public License version 3 for more details +* (a copy is included in the LICENSE file that accompanied this code). +* +* You should have received a copy of the GNU Lesser General Public License +* version 3 along with OpenOffice.org. If not, see +* <http://www.openoffice.org/license.html> +* for a copy of the LGPLv3 License. +* +************************************************************************/ + +#ifndef ERROBJECT_HXX +#define ERROBJECT_HXX +#include "sbunoobj.hxx" +#include <ooo/vba/XErrObject.hpp> + + +class SbxErrObject : public SbUnoObject +{ + class ErrObject* m_pErrObject; + com::sun::star::uno::Reference< ooo::vba::XErrObject > m_xErr; + + SbxErrObject( const String& aName_, const com::sun::star::uno::Any& aUnoObj_ ); + ~SbxErrObject(); + + class ErrObject* getImplErrObject( void ) + { return m_pErrObject; } + +public: + static SbxVariableRef getErrObject(); + static com::sun::star::uno::Reference< ooo::vba::XErrObject > getUnoErrObject(); + + void setNumberAndDescription( ::sal_Int32 _number, const ::rtl::OUString& _description ) + throw (com::sun::star::uno::RuntimeException); +}; +#endif diff --git a/basic/source/inc/image.hxx b/basic/source/inc/image.hxx index 7347efe288f3..d674b91faf71 100644 --- a/basic/source/inc/image.hxx +++ b/basic/source/inc/image.hxx @@ -106,6 +106,5 @@ public: #define SBIMG_COMPARETEXT 0x0002 // OPTION COMPARE TEXT ist aktiv #define SBIMG_INITCODE 0x0004 // Init-Code vorhanden #define SBIMG_CLASSMODULE 0x0008 // OPTION ClassModule is active -#define SBIMG_VBASUPPORT 0x0020 // OPTION VBASupport is 1 #endif diff --git a/basic/source/inc/namecont.hxx b/basic/source/inc/namecont.hxx index 1f7e77170d44..1f4084db1d0d 100644 --- a/basic/source/inc/namecont.hxx +++ b/basic/source/inc/namecont.hxx @@ -58,19 +58,22 @@ #include <cppuhelper/implbase2.hxx> #include <cppuhelper/compbase6.hxx> +#include <cppuhelper/compbase7.hxx> #include <cppuhelper/interfacecontainer.hxx> +#include <com/sun/star/script/XVBACompat.hpp> class BasicManager; namespace basic { -typedef ::cppu::WeakComponentImplHelper6< +typedef ::cppu::WeakComponentImplHelper7< ::com::sun::star::lang::XInitialization, ::com::sun::star::script::XStorageBasedLibraryContainer, ::com::sun::star::script::XLibraryContainerPassword, ::com::sun::star::script::XLibraryContainerExport, ::com::sun::star::container::XContainer, + ::com::sun::star::script::XVBACompat, ::com::sun::star::lang::XServiceInfo > LibraryContainerHelper; typedef ::cppu::WeakImplHelper2< ::com::sun::star::container::XNameContainer, @@ -216,6 +219,7 @@ public: class SfxLibraryContainer :public LibraryContainerHelper ,public ::utl::OEventListenerAdapter { + sal_Bool mbVBACompat; protected: ::com::sun::star::uno::Reference< ::com::sun::star::lang::XMultiServiceFactory > mxMSF; ::com::sun::star::uno::Reference< ::com::sun::star::ucb::XSimpleFileAccess > mxSFI; @@ -493,6 +497,9 @@ public: throw (::com::sun::star::uno::RuntimeException); virtual ::com::sun::star::uno::Sequence< ::rtl::OUString > SAL_CALL getSupportedServiceNames( ) throw (::com::sun::star::uno::RuntimeException) = 0; + // Methods XVBACompat + virtual ::sal_Bool SAL_CALL getVBACompatModeOn() throw (::com::sun::star::uno::RuntimeException); + virtual void SAL_CALL setVBACompatModeOn( ::sal_Bool _vbacompatmodeon ) throw (::com::sun::star::uno::RuntimeException); }; class LibraryContainerMethodGuard diff --git a/basic/source/inc/runtime.hxx b/basic/source/inc/runtime.hxx index 4a3f38c51027..c9a41110ad46 100644 --- a/basic/source/inc/runtime.hxx +++ b/basic/source/inc/runtime.hxx @@ -219,6 +219,8 @@ public: void Error( SbError ); // trappable Error void Error( SbError, const String& rMsg ); // trappable Error mit Message + void ErrorVB( sal_Int32 nVBNumber, const String& rMsg ); + void setErrorVB( sal_Int32 nVBNumber, const String& rMsg ); void FatalError( SbError ); // non-trappable Error void FatalError( SbError, const String& ); // non-trappable Error void Abort(); // Abbruch mit aktuellem Fehlercode @@ -433,7 +435,7 @@ class SbiRuntime void StepFIND_CM( UINT32, UINT32 ); void StepFIND_STATIC( UINT32, UINT32 ); public: - void SetVBAEnabled( bool bEnabled ) { bVBAEnabled = bEnabled; }; + void SetVBAEnabled( bool bEnabled ); USHORT GetImageFlag( USHORT n ) const; USHORT GetBase(); xub_StrLen nLine,nCol1,nCol2; // aktuelle Zeile, Spaltenbereich @@ -441,10 +443,11 @@ public: SbiRuntime( SbModule*, SbMethod*, UINT32 ); ~SbiRuntime(); - void Error( SbError ); // Fehler setzen, falls != 0 + void Error( SbError, bool bVBATranslationAlreadyDone = false ); // Fehler setzen, falls != 0 void Error( SbError, const String& ); // Fehler setzen, falls != 0 void FatalError( SbError ); // Fehlerbehandlung=Standard, Fehler setzen void FatalError( SbError, const String& ); // Fehlerbehandlung=Standard, Fehler setzen + static sal_Int32 translateErrorToVba( SbError nError, String& rMsg ); void DumpPCode(); BOOL Step(); // Einzelschritt (ein Opcode) void Stop() { bRun = FALSE; } diff --git a/basic/source/inc/scriptcont.hxx b/basic/source/inc/scriptcont.hxx index 19b0698d22a9..31025c48c4a4 100644 --- a/basic/source/inc/scriptcont.hxx +++ b/basic/source/inc/scriptcont.hxx @@ -30,6 +30,8 @@ #include "namecont.hxx" #include <basic/basmgr.hxx> +#include <com/sun/star/script/XVBAModuleInfo.hpp> +#include <comphelper/uno3.hxx> class BasicManager; @@ -134,13 +136,19 @@ public: }; //============================================================================ +typedef std::hash_map< ::rtl::OUString, ::com::sun::star::script::ModuleInfo, ::rtl::OUStringHash, ::std::equal_to< ::rtl::OUString > > ModuleInfoMap; + +typedef ::cppu::ImplHelper1 < ::com::sun::star::script::XVBAModuleInfo + > SfxScriptLibrary_BASE; class SfxScriptLibrary : public SfxLibrary + , public SfxScriptLibrary_BASE { friend class SfxScriptLibraryContainer; sal_Bool mbLoadedSource; sal_Bool mbLoadedBinary; + ModuleInfoMap mModuleInfos; // Provide modify state including resources virtual sal_Bool isModified( void ); @@ -167,6 +175,15 @@ public: const ::rtl::OUString& aLibInfoFileURL, const ::rtl::OUString& aStorageURL, sal_Bool ReadOnly ); + DECLARE_XINTERFACE() + DECLARE_XTYPEPROVIDER() + + // XVBAModuleInfo + virtual ::com::sun::star::script::ModuleInfo SAL_CALL getModuleInfo( const ::rtl::OUString& ModuleName ) throw (::com::sun::star::container::NoSuchElementException, ::com::sun::star::lang::WrappedTargetException, ::com::sun::star::uno::RuntimeException); + virtual sal_Bool SAL_CALL hasModuleInfo( const ::rtl::OUString& ModuleName ) throw (::com::sun::star::uno::RuntimeException); + virtual void SAL_CALL insertModuleInfo( const ::rtl::OUString& ModuleName, const ::com::sun::star::script::ModuleInfo& ModuleInfo ) throw (::com::sun::star::lang::IllegalArgumentException, ::com::sun::star::container::ElementExistException, ::com::sun::star::lang::WrappedTargetException, ::com::sun::star::uno::RuntimeException); + virtual void SAL_CALL removeModuleInfo( const ::rtl::OUString& ModuleName ) throw (::com::sun::star::container::NoSuchElementException, ::com::sun::star::lang::WrappedTargetException, ::com::sun::star::uno::RuntimeException); + static bool containsValidModule( const ::com::sun::star::uno::Any& _rElement ); protected: diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx index 9a21e488d4aa..e963de871c32 100644 --- a/basic/source/runtime/methods.cxx +++ b/basic/source/runtime/methods.cxx @@ -61,6 +61,7 @@ #else #include <osl/file.hxx> #endif +#include "errobject.hxx" #ifdef _USE_UNO #include <comphelper/processfactory.hxx> @@ -120,6 +121,10 @@ using namespace com::sun::star::io; #include <io.h> #endif +using namespace rtl; + +#include <basic/sbobjmod.hxx> + static void FilterWhiteSpace( String& rStr ) { rStr.EraseAllChars( ' ' ); @@ -256,6 +261,7 @@ RTLFUNC(Error) { String aErrorMsg; SbError nErr = 0L; + INT32 nCode = 0; if( rPar.Count() == 1 ) { nErr = StarBASIC::GetErrBasic(); @@ -263,14 +269,34 @@ RTLFUNC(Error) } else { - INT32 nCode = rPar.Get( 1 )->GetLong(); + nCode = rPar.Get( 1 )->GetLong(); if( nCode > 65535L ) StarBASIC::Error( SbERR_CONVERSION ); else nErr = StarBASIC::GetSfxFromVBError( (USHORT)nCode ); } - pBasic->MakeErrorText( nErr, aErrorMsg ); - rPar.Get( 0 )->PutString( pBasic->GetErrorText() ); + + bool bVBA = SbiRuntime::isVBAEnabled(); + String tmpErrMsg; + if( bVBA && aErrorMsg.Len() > 0 ) + { + tmpErrMsg = aErrorMsg; + } + else + { + pBasic->MakeErrorText( nErr, aErrorMsg ); + tmpErrMsg = pBasic->GetErrorText(); + } + // If this rtlfunc 'Error' passed a errcode the same as the active Err Objects's + // current err then return the description for the error message if it is set + // ( complicated isn't it ? ) + if ( bVBA && rPar.Count() > 1 ) + { + com::sun::star::uno::Reference< ooo::vba::XErrObject > xErrObj( SbxErrObject::getUnoErrObject() ); + if ( xErrObj.is() && xErrObj->getNumber() == nCode && xErrObj->getDescription().getLength() ) + tmpErrMsg = xErrObj->getDescription(); + } + rPar.Get( 0 )->PutString( tmpErrMsg ); } } @@ -4106,12 +4132,20 @@ RTLFUNC(Load) // Diesen Call einfach an das Object weiterreichen SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject(); - if( pObj && pObj->IsA( TYPE( SbxObject ) ) ) + if ( pObj ) { - SbxVariable* pVar = ((SbxObject*)pObj)-> - Find( String( RTL_CONSTASCII_USTRINGPARAM("Load") ), SbxCLASS_METHOD ); - if( pVar ) - pVar->GetInteger(); + if( pObj->IsA( TYPE( SbUserFormModule ) ) ) + { + SbUserFormModule* pFormModule = ( SbUserFormModule* )pObj; + pFormModule->load(); + } + else if( pObj->IsA( TYPE( SbxObject ) ) ) + { + SbxVariable* pVar = ((SbxObject*)pObj)-> + Find( String( RTL_CONSTASCII_USTRINGPARAM("Load") ), SbxCLASS_METHOD ); + if( pVar ) + pVar->GetInteger(); + } } } @@ -4129,12 +4163,20 @@ RTLFUNC(Unload) // Diesen Call einfach an das Object weitereichen SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject(); - if( pObj && pObj->IsA( TYPE( SbxObject ) ) ) + if ( pObj ) { - SbxVariable* pVar = ((SbxObject*)pObj)-> - Find( String( RTL_CONSTASCII_USTRINGPARAM("Unload") ), SbxCLASS_METHOD ); - if( pVar ) - pVar->GetInteger(); + if( pObj->IsA( TYPE( SbUserFormModule ) ) ) + { + SbUserFormModule* pFormModule = ( SbUserFormModule* )pObj; + pFormModule->Unload(); + } + else if( pObj->IsA( TYPE( SbxObject ) ) ) + { + SbxVariable* pVar = ((SbxObject*)pObj)-> + Find( String( RTL_CONSTASCII_USTRINGPARAM("Unload") ), SbxCLASS_METHOD ); + if( pVar ) + pVar->GetInteger(); + } } } diff --git a/basic/source/runtime/methods1.cxx b/basic/source/runtime/methods1.cxx index e0501e5c0d94..b25c213a493d 100644 --- a/basic/source/runtime/methods1.cxx +++ b/basic/source/runtime/methods1.cxx @@ -61,6 +61,7 @@ #endif #include <vcl/jobset.hxx> +#include <basic/sbobjmod.hxx> #include "sbintern.hxx" #include "runtime.hxx" @@ -2594,14 +2595,16 @@ RTLFUNC(Me) SbModule* pActiveModule = pINST->GetActiveModule(); SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pActiveModule); + SbxVariableRef refVar = rPar.Get(0); if( pClassModuleObject == NULL ) { - StarBASIC::Error( SbERR_INVALID_USAGE_OBJECT ); + SbObjModule* pMod = PTR_CAST(SbObjModule,pActiveModule); + if ( pMod ) + refVar->PutObject( pMod ); + else + StarBASIC::Error( SbERR_INVALID_USAGE_OBJECT ); } else - { - SbxVariableRef refVar = rPar.Get(0); refVar->PutObject( pClassModuleObject ); - } } diff --git a/basic/source/runtime/props.cxx b/basic/source/runtime/props.cxx index 9b4b35f551e2..cec74444e7a2 100644 --- a/basic/source/runtime/props.cxx +++ b/basic/source/runtime/props.cxx @@ -31,6 +31,7 @@ #include "runtime.hxx" #include "stdobj.hxx" #include "rtlproto.hxx" +#include "errobject.hxx" // Properties und Methoden legen beim Get (bWrite = FALSE) den Returnwert @@ -50,14 +51,21 @@ RTLFUNC(Err) (void)pBasic; (void)bWrite; - if( bWrite ) + if( SbiRuntime::isVBAEnabled() ) { - INT32 nVal = rPar.Get( 0 )->GetLong(); - if( nVal <= 65535L ) - StarBASIC::Error( StarBASIC::GetSfxFromVBError( (USHORT) nVal ) ); + rPar.Get( 0 )->PutObject( SbxErrObject::getErrObject() ); } else - rPar.Get( 0 )->PutLong( StarBASIC::GetVBErrorCode( StarBASIC::GetErrBasic() ) ); + { + if( bWrite ) + { + INT32 nVal = rPar.Get( 0 )->GetLong(); + if( nVal <= 65535L ) + StarBASIC::Error( StarBASIC::GetSfxFromVBError( (USHORT) nVal ) ); + } + else + rPar.Get( 0 )->PutLong( StarBASIC::GetVBErrorCode( StarBASIC::GetErrBasic() ) ); + } } RTLFUNC(False) diff --git a/basic/source/runtime/runtime.cxx b/basic/source/runtime/runtime.cxx index 52aa76e2f2df..29e49b0ffde8 100644..100755 --- a/basic/source/runtime/runtime.cxx +++ b/basic/source/runtime/runtime.cxx @@ -43,13 +43,16 @@ #include <comphelper/processfactory.hxx> #include <com/sun/star/container/XEnumerationAccess.hpp> #include "sbunoobj.hxx" +#include "errobject.hxx" + +using namespace ::com::sun::star; bool SbiRuntime::isVBAEnabled() { bool result = false; SbiInstance* pInst = pINST; if ( pInst && pINST->pRun ) - result = pInst->pRun->GetImageFlag( SBIMG_VBASUPPORT ); + result = pInst->pRun->bVBAEnabled; return result; } @@ -60,6 +63,24 @@ void StarBASIC::StaticEnableReschedule( BOOL bReschedule ) { bStaticGlobalEnableReschedule = bReschedule; } +void StarBASIC::SetVBAEnabled( BOOL bEnabled ) +{ + if ( bDocBasic ) + { + bVBAEnabled = bEnabled; + } +} + +BOOL StarBASIC::isVBAEnabled() +{ + if ( bDocBasic ) + { + if( SbiRuntime::isVBAEnabled() ) + return TRUE; + return bVBAEnabled; + } + return FALSE; +} struct SbiArgvStack { // Argv stack: @@ -422,6 +443,35 @@ void SbiInstance::Error( SbError n, const String& rMsg ) } } +void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const String& rMsg ) +{ + if( !bWatchMode ) + { + SbError n = StarBASIC::GetSfxFromVBError( static_cast< USHORT >( nVBNumber ) ); + if ( !n ) + n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors + + aErrorMsg = rMsg; + SbiRuntime::translateErrorToVba( n, aErrorMsg ); + + bool bVBATranslationAlreadyDone = true; + pRun->Error( SbERR_BASIC_COMPAT, bVBATranslationAlreadyDone ); + } +} + +void SbiInstance::setErrorVB( sal_Int32 nVBNumber, const String& rMsg ) +{ + SbError n = StarBASIC::GetSfxFromVBError( static_cast< USHORT >( nVBNumber ) ); + if( !n ) + n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors + + aErrorMsg = rMsg; + SbiRuntime::translateErrorToVba( n, aErrorMsg ); + + nErr = n; +} + + void SbiInstance::FatalError( SbError n ) { pRun->FatalError( n ); @@ -520,6 +570,7 @@ SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, UINT32 nStart ) nForLvl = 0; nOps = 0; refExprStk = new SbxArray; + SetVBAEnabled( pMod->IsVBACompat() ); #if defined GCC SetParameters( pe ? pe->GetParameters() : (class SbxArray *)NULL ); #else @@ -527,7 +578,6 @@ SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, UINT32 nStart ) #endif pRefSaveList = NULL; pItemStoreList = NULL; - bVBAEnabled = isVBAEnabled(); } SbiRuntime::~SbiRuntime() @@ -546,6 +596,11 @@ SbiRuntime::~SbiRuntime() } } +void SbiRuntime::SetVBAEnabled(bool bEnabled ) +{ + bVBAEnabled = bEnabled; +} + // Aufbau der Parameterliste. Alle ByRef-Parameter werden direkt // uebernommen; von ByVal-Parametern werden Kopien angelegt. Falls // ein bestimmter Datentyp verlangt wird, wird konvertiert. @@ -791,10 +846,24 @@ BOOL SbiRuntime::Step() return bRun; } -void SbiRuntime::Error( SbError n ) +void SbiRuntime::Error( SbError n, bool bVBATranslationAlreadyDone ) { if( n ) + { nError = n; + if( isVBAEnabled() && !bVBATranslationAlreadyDone ) + { + String aMsg = pInst->GetErrorMsg(); + sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg ); + SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject(); + SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar ); + if( pGlobErr != NULL ) + pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg ); + + pInst->aErrorMsg = aMsg; + nError = SbERR_BASIC_COMPAT; + } + } } void SbiRuntime::Error( SbError _errCode, const String& _details ) @@ -826,6 +895,32 @@ void SbiRuntime::FatalError( SbError _errCode, const String& _details ) Error( _errCode, _details ); } +sal_Int32 SbiRuntime::translateErrorToVba( SbError nError, String& rMsg ) +{ + // If a message is defined use that ( in preference to + // the defined one for the error ) NB #TODO + // if there is an error defined it more than likely + // is not the one you want ( some are the same though ) + // we really need a new vba compatible error list + if ( !rMsg.Len() ) + { + // TEST, has to be vb here always +#ifdef DBG_UTIL + SbError nTmp = StarBASIC::GetSfxFromVBError( nError ); + DBG_ASSERT( nTmp, "No VB error!" ); +#endif + + StarBASIC::MakeErrorText( nError, rMsg ); + rMsg = StarBASIC::GetErrorText(); + if ( !rMsg.Len() ) // no message for err no, need localized resource here + rMsg = String( RTL_CONSTASCII_USTRINGPARAM("Internal Object Error:") ); + } + // no num? most likely then it *is* really a vba err + USHORT nVBErrorCode = StarBASIC::GetVBErrorCode( nError ); + sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? nError : nVBErrorCode; + return nVBAErrorNumber; +} + ////////////////////////////////////////////////////////////////////////// // // Parameter, Locals, Caller diff --git a/basic/source/runtime/stdobj.cxx b/basic/source/runtime/stdobj.cxx index c0b4ffa3cd59..13bc8810144a 100644 --- a/basic/source/runtime/stdobj.cxx +++ b/basic/source/runtime/stdobj.cxx @@ -230,7 +230,7 @@ static Methods aMethods[] = { { "EOF", SbxBOOL, 1 | _FUNCTION, RTLNAME(EOF),0 }, { "Channel", SbxINTEGER, 0,NULL,0 }, { "Erl", SbxLONG, _ROPROP, RTLNAME( Erl ),0 }, -{ "Err", SbxLONG, _RWPROP, RTLNAME( Err ),0 }, +{ "Err", SbxVARIANT, _RWPROP, RTLNAME( Err ),0 }, { "Error", SbxSTRING, 1 | _FUNCTION, RTLNAME( Error ),0 }, { "code", SbxLONG, 0,NULL,0 }, { "Exp", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Exp),0 }, diff --git a/basic/source/runtime/step0.cxx b/basic/source/runtime/step0.cxx index 33df854a4499..39af5ea4adc3 100644 --- a/basic/source/runtime/step0.cxx +++ b/basic/source/runtime/step0.cxx @@ -30,6 +30,7 @@ #include <vcl/msgbox.hxx> #include <tools/fsys.hxx> +#include "errobject.hxx" #include "runtime.hxx" #include "sbintern.hxx" #include "iosys.hxx" @@ -1116,6 +1117,7 @@ void SbiRuntime::StepSTDERROR() pInst->nErr = 0L; pInst->nErl = 0; nError = 0L; + SbxErrObject::getUnoErrObject()->Clear(); } void SbiRuntime::StepNOERROR() @@ -1124,6 +1126,7 @@ void SbiRuntime::StepNOERROR() pInst->nErr = 0L; pInst->nErl = 0; nError = 0L; + SbxErrObject::getUnoErrObject()->Clear(); bError = FALSE; } @@ -1132,6 +1135,9 @@ void SbiRuntime::StepNOERROR() void SbiRuntime::StepLEAVE() { bRun = FALSE; + // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed ) + if ( bInError && pError ) + SbxErrObject::getUnoErrObject()->Clear(); } void SbiRuntime::StepCHANNEL() // TOS = Kanalnummer @@ -1265,6 +1271,9 @@ void SbiRuntime::StepERROR() SbxVariableRef refCode = PopVar(); USHORT n = refCode->GetUShort(); SbError error = StarBASIC::GetSfxFromVBError( n ); - Error( error ); + if ( bVBAEnabled ) + pInst->Error( error ); + else + Error( error ); } diff --git a/basic/source/runtime/step1.cxx b/basic/source/runtime/step1.cxx index 399257cf6ad3..c6f090048bf2 100644 --- a/basic/source/runtime/step1.cxx +++ b/basic/source/runtime/step1.cxx @@ -30,11 +30,13 @@ #include <stdlib.h> #include <rtl/math.hxx> +#include <basic/sbuno.hxx> #include "runtime.hxx" #include "sbintern.hxx" #include "iosys.hxx" #include "image.hxx" #include "sbunoobj.hxx" +#include "errobject.hxx" bool checkUnoObjectType( SbUnoObject* refVal, const String& aClass ); @@ -230,8 +232,6 @@ void SbiRuntime::StepRETURN( UINT32 nOp1 ) // FOR-Variable testen (+Endlabel) -void unoToSbxValue( SbxVariable* pVar, const Any& aValue ); - void SbiRuntime::StepTESTFOR( UINT32 nOp1 ) { if( !pForStk ) @@ -360,6 +360,7 @@ void SbiRuntime::StepERRHDL( UINT32 nOp1 ) pInst->nErr = 0; pInst->nErl = 0; nError = 0; + SbxErrObject::getUnoErrObject()->Clear(); } // Resume nach Fehlern (+0=statement, 1=next or Label) @@ -380,6 +381,8 @@ void SbiRuntime::StepRESUME( UINT32 nOp1 ) } else pCode = pErrStmnt; + if ( pError ) // current in error handler ( and got a Resume Next statment ) + SbxErrObject::getUnoErrObject()->Clear(); if( nOp1 > 1 ) StepJUMP( nOp1 ); diff --git a/basic/source/uno/namecont.cxx b/basic/source/uno/namecont.cxx index 14c84420dad6..90e7cb4cb4d5 100644 --- a/basic/source/uno/namecont.cxx +++ b/basic/source/uno/namecont.cxx @@ -73,7 +73,6 @@ #include <cppuhelper/exc_hlp.hxx> #include <basic/sbmod.hxx> - namespace basic { @@ -327,6 +326,7 @@ DBG_NAME( SfxLibraryContainer ) // Ctor SfxLibraryContainer::SfxLibraryContainer( void ) : LibraryContainerHelper( maMutex ) + , mbVBACompat( sal_False ) , maModifiable( *this, maMutex ) , maNameContainer( getCppuType( (Reference< XNameAccess >*) NULL ) ) , mbOldInfoFormat( sal_False ) @@ -2785,6 +2785,28 @@ OUString SfxLibraryContainer::expand_url( const OUString& url ) } } +::sal_Bool SAL_CALL SfxLibraryContainer::getVBACompatModeOn() throw (RuntimeException) +{ + return mbVBACompat; +} + +void SAL_CALL SfxLibraryContainer::setVBACompatModeOn( ::sal_Bool _vbacompatmodeon ) throw (RuntimeException) +{ + BasicManager* pBasMgr = getBasicManager(); + if( pBasMgr ) + { + // get the standard library + String aLibName( RTL_CONSTASCII_USTRINGPARAM( "Standard" ) ); + if ( pBasMgr->GetName().Len() ) + aLibName = pBasMgr->GetName(); + + StarBASIC* pBasic = pBasMgr->GetLib( aLibName ); + if( pBasic ) + pBasic->SetVBAEnabled( _vbacompatmodeon ); + } + mbVBACompat = _vbacompatmodeon; +} + // Methods XServiceInfo ::sal_Bool SAL_CALL SfxLibraryContainer::supportsService( const ::rtl::OUString& _rServiceName ) throw (RuntimeException) diff --git a/basic/source/uno/scriptcont.cxx b/basic/source/uno/scriptcont.cxx index 096d497a4c50..4185b6f9579c 100644 --- a/basic/source/uno/scriptcont.cxx +++ b/basic/source/uno/scriptcont.cxx @@ -942,7 +942,7 @@ sal_Bool SfxScriptLibraryContainer::implLoadPasswordLibrary try { xElementRootStorage = ::comphelper::OStorageHelper::GetStorageFromURL( aElementPath, - embed::ElementModes::READWRITE ); + embed::ElementModes::READ ); } catch( uno::Exception& ) { // TODO: error handling @@ -1166,6 +1166,45 @@ bool SAL_CALL SfxScriptLibrary::isLibraryElementValid( ::com::sun::star::uno::An return SfxScriptLibrary::containsValidModule( aElement ); } +IMPLEMENT_FORWARD_XINTERFACE2( SfxScriptLibrary, SfxLibrary, SfxScriptLibrary_BASE ); +IMPLEMENT_FORWARD_XTYPEPROVIDER2( SfxScriptLibrary, SfxLibrary, SfxScriptLibrary_BASE ); + +script::ModuleInfo SAL_CALL +SfxScriptLibrary::getModuleInfo( const ::rtl::OUString& ModuleName ) throw (NoSuchElementException, WrappedTargetException, RuntimeException) +{ + if ( !hasModuleInfo( ModuleName ) ) + throw NoSuchElementException(); + return mModuleInfos[ ModuleName ]; +} + +sal_Bool SAL_CALL +SfxScriptLibrary::hasModuleInfo( const ::rtl::OUString& ModuleName ) throw (RuntimeException) +{ + sal_Bool bRes = sal_False; + ModuleInfoMap::iterator it = mModuleInfos.find( ModuleName ); + + if ( it != mModuleInfos.end() ) + bRes = sal_True; + + return bRes; +} + +void SAL_CALL SfxScriptLibrary::insertModuleInfo( const ::rtl::OUString& ModuleName, const script::ModuleInfo& ModuleInfo ) throw (IllegalArgumentException, ElementExistException, WrappedTargetException, RuntimeException) +{ + if ( hasModuleInfo( ModuleName ) ) + throw ElementExistException(); + mModuleInfos[ ModuleName ] = ModuleInfo; +} + +void SAL_CALL SfxScriptLibrary::removeModuleInfo( const ::rtl::OUString& ModuleName ) throw (NoSuchElementException, WrappedTargetException, RuntimeException) +{ + // #FIXME add NoSuchElementException to the spec + if ( !hasModuleInfo( ModuleName ) ) + throw NoSuchElementException(); + mModuleInfos.erase( mModuleInfos.find( ModuleName ) ); +} + + //============================================================================ } // namespace basic |