Version 4.0.2.1, tag libreoffice-4.0.2.1
[LibreOffice.git] / basic / source / classes / sbxmod.cxx
blobb192a4f129137812980a95a04de23edf59361a41
1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 /*
3 * This file is part of the LibreOffice project.
5 * This Source Code Form is subject to the terms of the Mozilla Public
6 * License, v. 2.0. If a copy of the MPL was not distributed with this
7 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 * This file incorporates work covered by the following license notice:
11 * Licensed to the Apache Software Foundation (ASF) under one or more
12 * contributor license agreements. See the NOTICE file distributed
13 * with this work for additional information regarding copyright
14 * ownership. The ASF licenses this file to you under the Apache
15 * License, Version 2.0 (the "License"); you may not use this file
16 * except in compliance with the License. You may obtain a copy of
17 * the License at http://www.apache.org/licenses/LICENSE-2.0 .
21 #include <list>
23 #include <vcl/svapp.hxx>
24 #include <tools/stream.hxx>
25 #include <svl/brdcst.hxx>
26 #include <tools/shl.hxx>
27 #include <basic/sbx.hxx>
28 #include "sbdiagnose.hxx"
29 #include "sb.hxx"
30 #include <sbjsmeth.hxx>
31 #include "sbjsmod.hxx"
32 #include "sbintern.hxx"
33 #include "image.hxx"
34 #include "opcodes.hxx"
35 #include "runtime.hxx"
36 #include "token.hxx"
37 #include "sbunoobj.hxx"
39 #include <svtools/syntaxhighlight.hxx>
41 #include <basic/basrdll.hxx>
42 #include <osl/mutex.hxx>
43 #include <basic/sbobjmod.hxx>
44 #include <basic/vbahelper.hxx>
45 #include <cppuhelper/implbase3.hxx>
46 #include <unotools/eventcfg.hxx>
47 #include <com/sun/star/lang/XServiceInfo.hpp>
48 #include <com/sun/star/script/ModuleType.hpp>
49 #include <com/sun/star/script/vba/XVBACompatibility.hpp>
50 #include <com/sun/star/script/vba/VBAScriptEventId.hpp>
51 #include <com/sun/star/beans/XPropertySet.hpp>
52 #include <com/sun/star/document/XEventBroadcaster.hpp>
53 #include <com/sun/star/document/XEventListener.hpp>
55 using namespace com::sun::star;
57 // for the bsearch
58 #ifdef WNT
59 #define CDECL _cdecl
60 #endif
61 #if defined(UNX)
62 #define CDECL
63 #endif
64 #ifdef UNX
65 #include <sys/resource.h>
66 #endif
68 #include <stdio.h>
69 #include <com/sun/star/frame/XDesktop.hpp>
70 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
71 #include <comphelper/processfactory.hxx>
72 #include <map>
73 #include <com/sun/star/reflection/ProxyFactory.hpp>
74 #include <cppuhelper/implbase1.hxx>
75 #include <com/sun/star/uno/XAggregation.hpp>
76 #include <com/sun/star/script/XInvocation.hpp>
78 using namespace ::com::sun::star;
79 using namespace com::sun::star::lang;
80 using namespace com::sun::star::reflection;
81 using namespace com::sun::star::beans;
82 using namespace com::sun::star::script;
85 #include <com/sun/star/script/XLibraryContainer.hpp>
86 #include <com/sun/star/awt/XDialogProvider.hpp>
87 #include <com/sun/star/awt/XTopWindow.hpp>
88 #include <com/sun/star/awt/XWindow.hpp>
89 #include <com/sun/star/awt/XControl.hpp>
90 #include <comphelper/anytostring.hxx>
91 #include <ooo/vba/VbQueryClose.hpp>
93 typedef ::cppu::WeakImplHelper1< XInvocation > DocObjectWrapper_BASE;
94 typedef ::std::map< sal_Int16, Any, ::std::less< sal_Int16 > > OutParamMap;
95 ::com::sun::star::uno::Any sbxToUnoValue( SbxVariable* pVar );
96 void unoToSbxValue( SbxVariable* pVar, const ::com::sun::star::uno::Any& aValue );
98 class DocObjectWrapper : public DocObjectWrapper_BASE
100 Reference< XAggregation > m_xAggProxy;
101 Reference< XInvocation > m_xAggInv;
102 Reference< XTypeProvider > m_xAggregateTypeProv;
103 Sequence< Type > m_Types;
104 SbModule* m_pMod;
105 SbMethodRef getMethod( const OUString& aName ) throw (RuntimeException);
106 SbPropertyRef getProperty( const OUString& aName ) throw (RuntimeException);
107 OUString mName; // for debugging
109 public:
110 DocObjectWrapper( SbModule* pMod );
111 virtual ~DocObjectWrapper();
113 virtual void SAL_CALL acquire() throw();
114 virtual void SAL_CALL release() throw();
116 virtual Sequence< sal_Int8 > SAL_CALL getImplementationId() throw (RuntimeException)
118 if( !m_xAggregateTypeProv.is() )
119 throw RuntimeException();
120 return m_xAggregateTypeProv->getImplementationId();
123 virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection( ) throw (RuntimeException);
125 virtual Any SAL_CALL invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) throw (IllegalArgumentException, CannotConvertException, InvocationTargetException, RuntimeException);
126 virtual void SAL_CALL setValue( const OUString& aPropertyName, const Any& aValue ) throw (UnknownPropertyException, CannotConvertException, InvocationTargetException, RuntimeException);
127 virtual Any SAL_CALL getValue( const OUString& aPropertyName ) throw (UnknownPropertyException, RuntimeException);
128 virtual ::sal_Bool SAL_CALL hasMethod( const OUString& aName ) throw (RuntimeException);
129 virtual ::sal_Bool SAL_CALL hasProperty( const OUString& aName ) throw (RuntimeException);
130 virtual Any SAL_CALL queryInterface( const Type& aType ) throw ( RuntimeException );
132 virtual Sequence< Type > SAL_CALL getTypes() throw ( RuntimeException );
135 DocObjectWrapper::DocObjectWrapper( SbModule* pVar ) : m_pMod( pVar ), mName( pVar->GetName() )
137 SbObjModule* pMod = PTR_CAST(SbObjModule,pVar);
138 if ( pMod )
140 if ( pMod->GetModuleType() == ModuleType::DOCUMENT )
142 // Use proxy factory service to create aggregatable proxy.
143 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pMod->GetObject() );
144 Reference< XInterface > xIf;
145 if ( pUnoObj )
147 Any aObj = pUnoObj->getUnoAny();
148 aObj >>= xIf;
149 if ( xIf.is() )
151 m_xAggregateTypeProv.set( xIf, UNO_QUERY );
152 m_xAggInv.set( xIf, UNO_QUERY );
155 if ( xIf.is() )
159 Reference< XProxyFactory > xProxyFac = ProxyFactory::create( comphelper::getProcessComponentContext() );
160 m_xAggProxy = xProxyFac->createProxy( xIf );
162 catch(const Exception& )
164 OSL_FAIL( "DocObjectWrapper::DocObjectWrapper: Caught exception!" );
168 if ( m_xAggProxy.is() )
170 osl_atomic_increment( &m_refCount );
172 /* i35609 - Fix crash on Solaris. The setDelegator call needs
173 to be in its own block to ensure that all temporary Reference
174 instances that are acquired during the call are released
175 before m_refCount is decremented again */
177 m_xAggProxy->setDelegator( static_cast< cppu::OWeakObject * >( this ) );
180 osl_atomic_decrement( &m_refCount );
186 void SAL_CALL
187 DocObjectWrapper::acquire() throw ()
189 osl_atomic_increment( &m_refCount );
190 OSL_TRACE("DocObjectWrapper::acquire(%s) 0x%x refcount is now %d", rtl::OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr(), this, m_refCount );
192 void SAL_CALL
193 DocObjectWrapper::release() throw ()
195 if ( osl_atomic_decrement( &m_refCount ) == 0 )
197 OSL_TRACE("DocObjectWrapper::release(%s) 0x%x refcount is now %d", rtl::OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr(), this, m_refCount );
198 delete this;
200 else
202 OSL_TRACE("DocObjectWrapper::release(%s) 0x%x refcount is now %d", rtl::OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr(), this, m_refCount );
206 DocObjectWrapper::~DocObjectWrapper()
210 Sequence< Type > SAL_CALL DocObjectWrapper::getTypes()
211 throw ( RuntimeException )
213 if ( m_Types.getLength() == 0 )
215 Sequence< Type > sTypes;
216 if ( m_xAggregateTypeProv.is() )
218 sTypes = m_xAggregateTypeProv->getTypes();
220 m_Types.realloc( sTypes.getLength() + 1 );
221 Type* pPtr = m_Types.getArray();
222 for ( int i=0; i<m_Types.getLength(); ++i, ++pPtr )
224 if ( i == 0 )
226 *pPtr = XInvocation::static_type( NULL );
228 else
230 *pPtr = sTypes[ i - 1 ];
234 return m_Types;
237 Reference< XIntrospectionAccess > SAL_CALL
238 DocObjectWrapper::getIntrospection( ) throw (RuntimeException)
240 return NULL;
243 Any SAL_CALL
244 DocObjectWrapper::invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) throw (IllegalArgumentException, CannotConvertException, InvocationTargetException, RuntimeException)
246 if ( m_xAggInv.is() && m_xAggInv->hasMethod( aFunctionName ) )
247 return m_xAggInv->invoke( aFunctionName, aParams, aOutParamIndex, aOutParam );
248 SbMethodRef pMethod = getMethod( aFunctionName );
249 if ( !pMethod )
250 throw RuntimeException();
251 // check number of parameters
252 sal_Int32 nParamsCount = aParams.getLength();
253 SbxInfo* pInfo = pMethod->GetInfo();
254 if ( pInfo )
256 sal_Int32 nSbxOptional = 0;
257 sal_uInt16 n = 1;
258 for ( const SbxParamInfo* pParamInfo = pInfo->GetParam( n ); pParamInfo; pParamInfo = pInfo->GetParam( ++n ) )
260 if ( ( pParamInfo->nFlags & SBX_OPTIONAL ) != 0 )
261 ++nSbxOptional;
262 else
263 nSbxOptional = 0;
265 sal_Int32 nSbxCount = n - 1;
266 if ( nParamsCount < nSbxCount - nSbxOptional )
268 throw RuntimeException( OUString( "wrong number of parameters!" ), Reference< XInterface >() );
271 // set parameters
272 SbxArrayRef xSbxParams;
273 if ( nParamsCount > 0 )
275 xSbxParams = new SbxArray;
276 const Any* pParams = aParams.getConstArray();
277 for ( sal_Int32 i = 0; i < nParamsCount; ++i )
279 SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
280 unoToSbxValue( static_cast< SbxVariable* >( xSbxVar ), pParams[i] );
281 xSbxParams->Put( xSbxVar, static_cast< sal_uInt16 >( i ) + 1 );
283 // Enable passing by ref
284 if ( xSbxVar->GetType() != SbxVARIANT )
285 xSbxVar->SetFlag( SBX_FIXED );
288 if ( xSbxParams.Is() )
289 pMethod->SetParameters( xSbxParams );
291 // call method
292 SbxVariableRef xReturn = new SbxVariable;
294 pMethod->Call( xReturn );
295 Any aReturn;
296 // get output parameters
297 if ( xSbxParams.Is() )
299 SbxInfo* pInfo_ = pMethod->GetInfo();
300 if ( pInfo_ )
302 OutParamMap aOutParamMap;
303 for ( sal_uInt16 n = 1, nCount = xSbxParams->Count(); n < nCount; ++n )
305 const SbxParamInfo* pParamInfo = pInfo_->GetParam( n );
306 if ( pParamInfo && ( pParamInfo->eType & SbxBYREF ) != 0 )
308 SbxVariable* pVar = xSbxParams->Get( n );
309 if ( pVar )
311 SbxVariableRef xVar = pVar;
312 aOutParamMap.insert( OutParamMap::value_type( n - 1, sbxToUnoValue( xVar ) ) );
316 sal_Int32 nOutParamCount = aOutParamMap.size();
317 aOutParamIndex.realloc( nOutParamCount );
318 aOutParam.realloc( nOutParamCount );
319 sal_Int16* pOutParamIndex = aOutParamIndex.getArray();
320 Any* pOutParam = aOutParam.getArray();
321 for ( OutParamMap::iterator aIt = aOutParamMap.begin(); aIt != aOutParamMap.end(); ++aIt, ++pOutParamIndex, ++pOutParam )
323 *pOutParamIndex = aIt->first;
324 *pOutParam = aIt->second;
329 // get return value
330 aReturn = sbxToUnoValue( xReturn );
332 pMethod->SetParameters( NULL );
334 return aReturn;
337 void SAL_CALL
338 DocObjectWrapper::setValue( const OUString& aPropertyName, const Any& aValue ) throw (UnknownPropertyException, CannotConvertException, InvocationTargetException, RuntimeException)
340 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
341 return m_xAggInv->setValue( aPropertyName, aValue );
343 SbPropertyRef pProperty = getProperty( aPropertyName );
344 if ( !pProperty.Is() )
345 throw UnknownPropertyException();
346 unoToSbxValue( (SbxVariable*) pProperty, aValue );
349 Any SAL_CALL
350 DocObjectWrapper::getValue( const OUString& aPropertyName ) throw (UnknownPropertyException, RuntimeException)
352 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
353 return m_xAggInv->getValue( aPropertyName );
355 SbPropertyRef pProperty = getProperty( aPropertyName );
356 if ( !pProperty.Is() )
357 throw UnknownPropertyException();
359 SbxVariable* pProp = ( SbxVariable* ) pProperty;
360 if ( pProp->GetType() == SbxEMPTY )
361 pProperty->Broadcast( SBX_HINT_DATAWANTED );
363 Any aRet = sbxToUnoValue( pProp );
364 return aRet;
367 ::sal_Bool SAL_CALL
368 DocObjectWrapper::hasMethod( const OUString& aName ) throw (RuntimeException)
370 if ( m_xAggInv.is() && m_xAggInv->hasMethod( aName ) )
371 return sal_True;
372 return getMethod( aName ).Is();
375 ::sal_Bool SAL_CALL
376 DocObjectWrapper::hasProperty( const OUString& aName ) throw (RuntimeException)
378 sal_Bool bRes = sal_False;
379 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aName ) )
380 bRes = sal_True;
381 else bRes = getProperty( aName ).Is();
382 return bRes;
385 Any SAL_CALL DocObjectWrapper::queryInterface( const Type& aType )
386 throw ( RuntimeException )
388 Any aRet = DocObjectWrapper_BASE::queryInterface( aType );
389 if ( aRet.hasValue() )
390 return aRet;
391 else if ( m_xAggProxy.is() )
392 aRet = m_xAggProxy->queryAggregation( aType );
393 return aRet;
396 SbMethodRef DocObjectWrapper::getMethod( const OUString& aName ) throw (RuntimeException)
398 SbMethodRef pMethod = NULL;
399 if ( m_pMod )
401 sal_uInt16 nSaveFlgs = m_pMod->GetFlags();
402 // Limit search to this module
403 m_pMod->ResetFlag( SBX_GBLSEARCH );
404 pMethod = (SbMethod*) m_pMod->SbModule::Find( aName, SbxCLASS_METHOD );
405 m_pMod->SetFlags( nSaveFlgs );
408 return pMethod;
411 SbPropertyRef DocObjectWrapper::getProperty( const OUString& aName ) throw (RuntimeException)
413 SbPropertyRef pProperty = NULL;
414 if ( m_pMod )
416 sal_uInt16 nSaveFlgs = m_pMod->GetFlags();
417 // Limit search to this module.
418 m_pMod->ResetFlag( SBX_GBLSEARCH );
419 pProperty = (SbProperty*)m_pMod->SbModule::Find( aName, SbxCLASS_PROPERTY );
420 m_pMod->SetFlag( nSaveFlgs );
423 return pProperty;
426 TYPEINIT1(SbModule,SbxObject)
427 TYPEINIT1(SbMethod,SbxMethod)
428 TYPEINIT1(SbProperty,SbxProperty)
429 TYPEINIT1(SbProcedureProperty,SbxProperty)
430 TYPEINIT1(SbJScriptModule,SbModule)
431 TYPEINIT1(SbJScriptMethod,SbMethod)
432 TYPEINIT1(SbObjModule,SbModule)
433 TYPEINIT1(SbUserFormModule,SbObjModule)
435 uno::Reference< frame::XModel > getDocumentModel( StarBASIC* pb )
437 uno::Reference< frame::XModel > xModel;
438 if( pb && pb->IsDocBasic() )
440 uno::Any aDoc;
441 if( pb->GetUNOConstant( "ThisComponent", aDoc ) )
442 xModel.set( aDoc, uno::UNO_QUERY );
444 return xModel;
447 uno::Reference< vba::XVBACompatibility > getVBACompatibility( const uno::Reference< frame::XModel >& rxModel )
449 uno::Reference< vba::XVBACompatibility > xVBACompat;
452 uno::Reference< beans::XPropertySet > xModelProps( rxModel, uno::UNO_QUERY_THROW );
453 xVBACompat.set( xModelProps->getPropertyValue( OUString( "BasicLibraries" ) ), uno::UNO_QUERY );
455 catch(const uno::Exception& )
458 return xVBACompat;
461 bool getDefaultVBAMode( StarBASIC* pb )
463 uno::Reference< vba::XVBACompatibility > xVBACompat = getVBACompatibility( getDocumentModel( pb ) );
464 return xVBACompat.is() && xVBACompat->getVBACompatibilityMode();
467 class AsyncQuitHandler
469 AsyncQuitHandler() {}
470 AsyncQuitHandler( const AsyncQuitHandler&);
471 public:
472 static AsyncQuitHandler& instance()
474 static AsyncQuitHandler dInst;
475 return dInst;
478 void QuitApplication()
480 uno::Reference< lang::XMultiServiceFactory > xFactory = comphelper::getProcessServiceFactory();
481 if ( xFactory.is() )
483 uno::Reference< frame::XDesktop > xDeskTop( xFactory->createInstance( OUString( "com.sun.star.frame.Desktop" ) ), uno::UNO_QUERY );
484 if ( xDeskTop.is() )
485 xDeskTop->terminate();
488 DECL_LINK( OnAsyncQuit, void* );
491 IMPL_LINK( AsyncQuitHandler, OnAsyncQuit, void*, /*pNull*/ )
493 QuitApplication();
494 return 0L;
497 // A Basic module has set EXTSEARCH, so that the elements, that the modul contains,
498 // could be found from other module.
500 SbModule::SbModule( const OUString& rName, sal_Bool bVBACompat )
501 : SbxObject( OUString("StarBASICModule") ),
502 pImage( NULL ), pBreaks( NULL ), pClassData( NULL ), mbVBACompat( bVBACompat ), pDocObject( NULL ), bIsProxyModule( false )
504 SetName( rName );
505 SetFlag( SBX_EXTSEARCH | SBX_GBLSEARCH );
506 SetModuleType( script::ModuleType::NORMAL );
508 // #i92642: Set name property to intitial name
509 SbxVariable* pNameProp = pProps->Find( OUString("Name"), SbxCLASS_PROPERTY );
510 if( pNameProp != NULL )
512 pNameProp->PutString( GetName() );
516 SbModule::~SbModule()
518 OSL_TRACE("Module named %s is destructing", rtl::OUStringToOString( GetName(), RTL_TEXTENCODING_UTF8 ).getStr() );
519 delete pImage;
520 delete pBreaks;
521 delete pClassData;
522 mxWrapper = NULL;
525 uno::Reference< script::XInvocation >
526 SbModule::GetUnoModule()
528 if ( !mxWrapper.is() )
529 mxWrapper = new DocObjectWrapper( this );
531 OSL_TRACE("Module named %s returning wrapper mxWrapper (0x%x)", rtl::OUStringToOString( GetName(), RTL_TEXTENCODING_UTF8 ).getStr(), mxWrapper.get() );
532 return mxWrapper;
535 sal_Bool SbModule::IsCompiled() const
537 return sal_Bool( pImage != 0 );
540 const SbxObject* SbModule::FindType( OUString aTypeName ) const
542 return pImage ? pImage->FindType( aTypeName ) : NULL;
546 // From the code generator: deletion of images and the oposite of validation for entries
548 void SbModule::StartDefinitions()
550 delete pImage; pImage = NULL;
551 if( pClassData )
552 pClassData->clear();
554 // methods and properties persist, but they are invalid;
555 // at least are the information under certain conditions clogged
556 sal_uInt16 i;
557 for( i = 0; i < pMethods->Count(); i++ )
559 SbMethod* p = PTR_CAST(SbMethod,pMethods->Get( i ) );
560 if( p )
561 p->bInvalid = sal_True;
563 for( i = 0; i < pProps->Count(); )
565 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
566 if( p )
567 pProps->Remove( i );
568 else
569 i++;
573 // request/create method
575 SbMethod* SbModule::GetMethod( const OUString& rName, SbxDataType t )
577 SbxVariable* p = pMethods->Find( rName, SbxCLASS_METHOD );
578 SbMethod* pMeth = p ? PTR_CAST(SbMethod,p) : NULL;
579 if( p && !pMeth )
581 pMethods->Remove( p );
583 if( !pMeth )
585 pMeth = new SbMethod( rName, t, this );
586 pMeth->SetParent( this );
587 pMeth->SetFlags( SBX_READ );
588 pMethods->Put( pMeth, pMethods->Count() );
589 StartListening( pMeth->GetBroadcaster(), sal_True );
591 // The method is per default valid, because it could be
592 // created from the compiler (code generator) as well.
593 pMeth->bInvalid = sal_False;
594 pMeth->ResetFlag( SBX_FIXED );
595 pMeth->SetFlag( SBX_WRITE );
596 pMeth->SetType( t );
597 pMeth->ResetFlag( SBX_WRITE );
598 if( t != SbxVARIANT )
600 pMeth->SetFlag( SBX_FIXED );
602 return pMeth;
605 // request/create property
607 SbProperty* SbModule::GetProperty( const OUString& rName, SbxDataType t )
609 SbxVariable* p = pProps->Find( rName, SbxCLASS_PROPERTY );
610 SbProperty* pProp = p ? PTR_CAST(SbProperty,p) : NULL;
611 if( p && !pProp )
613 pProps->Remove( p );
615 if( !pProp )
617 pProp = new SbProperty( rName, t, this );
618 pProp->SetFlag( SBX_READWRITE );
619 pProp->SetParent( this );
620 pProps->Put( pProp, pProps->Count() );
621 StartListening( pProp->GetBroadcaster(), sal_True );
623 return pProp;
626 SbProcedureProperty* SbModule::GetProcedureProperty( const OUString& rName, SbxDataType t )
628 SbxVariable* p = pProps->Find( rName, SbxCLASS_PROPERTY );
629 SbProcedureProperty* pProp = p ? PTR_CAST(SbProcedureProperty,p) : NULL;
630 if( p && !pProp )
632 pProps->Remove( p );
634 if( !pProp )
636 pProp = new SbProcedureProperty( rName, t );
637 pProp->SetFlag( SBX_READWRITE );
638 pProp->SetParent( this );
639 pProps->Put( pProp, pProps->Count() );
640 StartListening( pProp->GetBroadcaster(), sal_True );
642 return pProp;
645 SbIfaceMapperMethod* SbModule::GetIfaceMapperMethod( const OUString& rName, SbMethod* pImplMeth )
647 SbxVariable* p = pMethods->Find( rName, SbxCLASS_METHOD );
648 SbIfaceMapperMethod* pMapperMethod = p ? PTR_CAST(SbIfaceMapperMethod,p) : NULL;
649 if( p && !pMapperMethod )
651 pMethods->Remove( p );
653 if( !pMapperMethod )
655 pMapperMethod = new SbIfaceMapperMethod( rName, pImplMeth );
656 pMapperMethod->SetParent( this );
657 pMapperMethod->SetFlags( SBX_READ );
658 pMethods->Put( pMapperMethod, pMethods->Count() );
660 pMapperMethod->bInvalid = sal_False;
661 return pMapperMethod;
664 SbIfaceMapperMethod::~SbIfaceMapperMethod()
668 TYPEINIT1(SbIfaceMapperMethod,SbMethod)
671 // From the code generator: remove invalid entries
673 void SbModule::EndDefinitions( sal_Bool bNewState )
675 for( sal_uInt16 i = 0; i < pMethods->Count(); )
677 SbMethod* p = PTR_CAST(SbMethod,pMethods->Get( i ) );
678 if( p )
680 if( p->bInvalid )
681 pMethods->Remove( p );
682 else
684 p->bInvalid = bNewState;
685 i++;
688 else
689 i++;
691 SetModified( sal_True );
694 void SbModule::Clear()
696 delete pImage; pImage = NULL;
697 if( pClassData )
698 pClassData->clear();
699 SbxObject::Clear();
703 SbxVariable* SbModule::Find( const OUString& rName, SbxClassType t )
705 // make sure a search in an uninstatiated class module will fail
706 SbxVariable* pRes = SbxObject::Find( rName, t );
707 if ( bIsProxyModule && !GetSbData()->bRunInit )
709 return NULL;
711 if( !pRes && pImage )
713 SbiInstance* pInst = GetSbData()->pInst;
714 if( pInst && pInst->IsCompatibility() )
716 // Put enum types as objects into module,
717 // allows MyEnum.First notation
718 SbxArrayRef xArray = pImage->GetEnums();
719 if( xArray.Is() )
721 SbxVariable* pEnumVar = xArray->Find( rName, SbxCLASS_DONTCARE );
722 SbxObject* pEnumObject = PTR_CAST( SbxObject, pEnumVar );
723 if( pEnumObject )
725 bool bPrivate = pEnumObject->IsSet( SBX_PRIVATE );
726 OUString aEnumName = pEnumObject->GetName();
728 pRes = new SbxVariable( SbxOBJECT );
729 pRes->SetName( aEnumName );
730 pRes->SetParent( this );
731 pRes->SetFlag( SBX_READ );
732 if( bPrivate )
734 pRes->SetFlag( SBX_PRIVATE );
736 pRes->PutObject( pEnumObject );
741 return pRes;
744 const OUString& SbModule::GetSource32() const
746 return aOUSource;
749 const OUString& SbModule::GetSource() const
751 static OUString aRetStr;
752 aRetStr = aOUSource;
753 return aRetStr;
756 // Parent and BASIC are one!
758 void SbModule::SetParent( SbxObject* p )
760 pParent = p;
763 void SbModule::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
764 const SfxHint& rHint, const TypeId& rHintType )
766 const SbxHint* pHint = PTR_CAST(SbxHint,&rHint);
767 if( pHint )
769 SbxVariable* pVar = pHint->GetVar();
770 SbProperty* pProp = PTR_CAST(SbProperty,pVar);
771 SbMethod* pMeth = PTR_CAST(SbMethod,pVar);
772 SbProcedureProperty* pProcProperty = PTR_CAST( SbProcedureProperty, pVar );
773 if( pProcProperty )
776 if( pHint->GetId() == SBX_HINT_DATAWANTED )
778 OUString aProcName("Property Get ");
779 aProcName += pProcProperty->GetName();
781 SbxVariable* pMethVar = Find( aProcName, SbxCLASS_METHOD );
782 if( pMethVar )
784 SbxValues aVals;
785 aVals.eType = SbxVARIANT;
787 SbxArray* pArg = pVar->GetParameters();
788 sal_uInt16 nVarParCount = (pArg != NULL) ? pArg->Count() : 0;
789 if( nVarParCount > 1 )
791 SbxArrayRef xMethParameters = new SbxArray;
792 xMethParameters->Put( pMethVar, 0 ); // Method as parameter 0
793 for( sal_uInt16 i = 1 ; i < nVarParCount ; ++i )
795 SbxVariable* pPar = pArg->Get( i );
796 xMethParameters->Put( pPar, i );
799 pMethVar->SetParameters( xMethParameters );
800 pMethVar->Get( aVals );
801 pMethVar->SetParameters( NULL );
803 else
805 pMethVar->Get( aVals );
808 pVar->Put( aVals );
811 else if( pHint->GetId() == SBX_HINT_DATACHANGED )
813 SbxVariable* pMethVar = NULL;
815 bool bSet = pProcProperty->isSet();
816 if( bSet )
818 pProcProperty->setSet( false );
820 OUString aProcName("Property Set ");
821 aProcName += pProcProperty->GetName();
822 pMethVar = Find( aProcName, SbxCLASS_METHOD );
824 if( !pMethVar ) // Let
826 OUString aProcName("Property Let " );
827 aProcName += pProcProperty->GetName();
828 pMethVar = Find( aProcName, SbxCLASS_METHOD );
831 if( pMethVar )
833 // Setup parameters
834 SbxArrayRef xArray = new SbxArray;
835 xArray->Put( pMethVar, 0 ); // Method as parameter 0
836 xArray->Put( pVar, 1 );
837 pMethVar->SetParameters( xArray );
839 SbxValues aVals;
840 pMethVar->Get( aVals );
841 pMethVar->SetParameters( NULL );
845 if( pProp )
847 if( pProp->GetModule() != this )
848 SetError( SbxERR_BAD_ACTION );
850 else if( pMeth )
852 if( pHint->GetId() == SBX_HINT_DATAWANTED )
854 if( pMeth->bInvalid && !Compile() )
856 // auto compile has not worked!
857 StarBASIC::Error( SbERR_BAD_PROP_VALUE );
859 else
861 // Call of a subprogram
862 SbModule* pOld = GetSbData()->pMod;
863 GetSbData()->pMod = this;
864 Run( (SbMethod*) pVar );
865 GetSbData()->pMod = pOld;
869 else
871 // #i92642: Special handling for name property to avoid
872 // side effects when using name as variable implicitely
873 bool bForwardToSbxObject = true;
875 sal_uIntPtr nId = pHint->GetId();
876 if( (nId == SBX_HINT_DATAWANTED || nId == SBX_HINT_DATACHANGED) &&
877 pVar->GetName().equalsIgnoreAsciiCase( "name" ) )
879 bForwardToSbxObject = false;
881 if( bForwardToSbxObject )
883 SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType );
889 // The setting of the source makes the image invalid
890 // and scans the method definitions newly in
892 void SbModule::SetSource( const OUString& r )
894 SetSource32( r );
897 void SbModule::SetSource32( const OUString& r )
899 // Default basic mode to library container mode, but.. allow Option VBASupport 0/1 override
900 SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) );
901 aOUSource = r;
902 StartDefinitions();
903 SbiTokenizer aTok( r );
904 aTok.SetCompatible( IsVBACompat() );
905 while( !aTok.IsEof() )
907 SbiToken eEndTok = NIL;
909 // Searching for SUB or FUNCTION
910 SbiToken eLastTok = NIL;
911 while( !aTok.IsEof() )
913 // #32385: not by declare
914 SbiToken eCurTok = aTok.Next();
915 if( eLastTok != DECLARE )
917 if( eCurTok == SUB )
919 eEndTok = ENDSUB; break;
921 if( eCurTok == FUNCTION )
923 eEndTok = ENDFUNC; break;
925 if( eCurTok == PROPERTY )
927 eEndTok = ENDPROPERTY; break;
929 if( eCurTok == OPTION )
931 eCurTok = aTok.Next();
932 if( eCurTok == COMPATIBLE )
934 aTok.SetCompatible( true );
936 else if ( ( eCurTok == VBASUPPORT ) && ( aTok.Next() == NUMBER ) )
938 sal_Bool bIsVBA = ( aTok.GetDbl()== 1 );
939 SetVBACompat( bIsVBA );
940 aTok.SetCompatible( bIsVBA );
944 eLastTok = eCurTok;
946 // Definition of the method
947 SbMethod* pMeth = NULL;
948 if( eEndTok != NIL )
950 sal_uInt16 nLine1 = aTok.GetLine();
951 if( aTok.Next() == SYMBOL )
953 OUString aName_( aTok.GetSym() );
954 SbxDataType t = aTok.GetType();
955 if( t == SbxVARIANT && eEndTok == ENDSUB )
957 t = SbxVOID;
959 pMeth = GetMethod( aName_, t );
960 pMeth->nLine1 = pMeth->nLine2 = nLine1;
961 // The method is for a start VALID
962 pMeth->bInvalid = sal_False;
964 else
966 eEndTok = NIL;
969 // Skip up to END SUB/END FUNCTION
970 if( eEndTok != NIL )
972 while( !aTok.IsEof() )
974 if( aTok.Next() == eEndTok )
976 pMeth->nLine2 = aTok.GetLine();
977 break;
980 if( aTok.IsEof() )
982 pMeth->nLine2 = aTok.GetLine();
986 EndDefinitions( sal_True );
989 SbMethod* SbModule::GetFunctionForLine( sal_uInt16 nLine )
991 for( sal_uInt16 i = 0; i < pMethods->Count(); i++ )
993 SbMethod* p = (SbMethod*) pMethods->Get( i );
994 if( p->GetSbxId() == SBXID_BASICMETHOD )
996 if( nLine >= p->nLine1 && nLine <= p->nLine2 )
997 return p;
1000 return NULL;
1003 // Broadcast of a hint to all Basics
1005 static void _SendHint( SbxObject* pObj, sal_uIntPtr nId, SbMethod* p )
1007 // Self a BASIC?
1008 if( pObj->IsA( TYPE(StarBASIC) ) && pObj->IsBroadcaster() )
1009 pObj->GetBroadcaster().Broadcast( SbxHint( nId, p ) );
1010 // Then ask for the subobjects
1011 SbxArray* pObjs = pObj->GetObjects();
1012 for( sal_uInt16 i = 0; i < pObjs->Count(); i++ )
1014 SbxVariable* pVar = pObjs->Get( i );
1015 if( pVar->IsA( TYPE(SbxObject) ) )
1016 _SendHint( PTR_CAST(SbxObject,pVar), nId, p );
1020 static void SendHint( SbxObject* pObj, sal_uIntPtr nId, SbMethod* p )
1022 while( pObj->GetParent() )
1023 pObj = pObj->GetParent();
1024 _SendHint( pObj, nId, p );
1027 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1028 // at the end of the program, so that nothing were helt.
1029 void ClearUnoObjectsInRTL_Impl_Rek( StarBASIC* pBasic )
1031 // delete the return value of CreateUnoService
1032 static OUString aName("CreateUnoService");
1033 SbxVariable* pVar = pBasic->GetRtl()->Find( aName, SbxCLASS_METHOD );
1034 if( pVar )
1036 pVar->SbxValue::Clear();
1038 // delete the return value of CreateUnoDialog
1039 static OUString aName2("CreateUnoDialog");
1040 pVar = pBasic->GetRtl()->Find( aName2, SbxCLASS_METHOD );
1041 if( pVar )
1043 pVar->SbxValue::Clear();
1045 // delete the return value of CDec
1046 static OUString aName3("CDec");
1047 pVar = pBasic->GetRtl()->Find( aName3, SbxCLASS_METHOD );
1048 if( pVar )
1050 pVar->SbxValue::Clear();
1052 // delete return value of CreateObject
1053 static OUString aName4("CreateObject");
1054 pVar = pBasic->GetRtl()->Find( aName4, SbxCLASS_METHOD );
1055 if( pVar )
1057 pVar->SbxValue::Clear();
1059 // Go over all Sub-Basics
1060 SbxArray* pObjs = pBasic->GetObjects();
1061 sal_uInt16 nCount = pObjs->Count();
1062 for( sal_uInt16 i = 0 ; i < nCount ; i++ )
1064 SbxVariable* pObjVar = pObjs->Get( i );
1065 StarBASIC* pSubBasic = PTR_CAST( StarBASIC, pObjVar );
1066 if( pSubBasic )
1068 ClearUnoObjectsInRTL_Impl_Rek( pSubBasic );
1073 void ClearUnoObjectsInRTL_Impl( StarBASIC* pBasic )
1075 // #67781 Delete return values of the Uno-methods
1076 clearUnoMethods();
1077 clearUnoServiceCtors();
1079 ClearUnoObjectsInRTL_Impl_Rek( pBasic );
1081 // Search for the topmost Basic
1082 SbxObject* p = pBasic;
1083 while( p->GetParent() )
1084 p = p->GetParent();
1085 if( ((StarBASIC*)p) != pBasic )
1086 ClearUnoObjectsInRTL_Impl_Rek( (StarBASIC*)p );
1089 bool SbModule::IsVBACompat() const
1091 return mbVBACompat;
1094 void SbModule::SetVBACompat( bool bCompat )
1096 if( mbVBACompat != bCompat )
1098 mbVBACompat = bCompat;
1099 // initialize VBA document API
1100 if( mbVBACompat ) try
1102 StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
1103 uno::Reference< lang::XMultiServiceFactory > xFactory( getDocumentModel( pBasic ), uno::UNO_QUERY_THROW );
1104 xFactory->createInstance( OUString("ooo.vba.VBAGlobals") );
1106 catch( Exception& )
1112 // Run a Basic-subprogram
1113 sal_uInt16 SbModule::Run( SbMethod* pMeth )
1115 OSL_TRACE("About to run %s, vba compatmode is %d", rtl::OUStringToOString( pMeth->GetName(), RTL_TEXTENCODING_UTF8 ).getStr(), mbVBACompat );
1116 static sal_uInt16 nMaxCallLevel = 0;
1118 sal_uInt16 nRes = 0;
1119 bool bDelInst = ( GetSbData()->pInst == NULL );
1120 bool bQuit = false;
1121 StarBASICRef xBasic;
1122 uno::Reference< frame::XModel > xModel;
1123 uno::Reference< script::vba::XVBACompatibility > xVBACompat;
1124 if( bDelInst )
1126 // #32779: Hold Basic during the execution
1127 xBasic = (StarBASIC*) GetParent();
1129 GetSbData()->pInst = new SbiInstance( (StarBASIC*) GetParent() );
1131 /* If a VBA script in a document is started, get the VBA compatibility
1132 interface from the document Basic library container, and notify all
1133 VBA script listeners about the started script. */
1134 if( mbVBACompat )
1136 StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
1137 if( pBasic && pBasic->IsDocBasic() ) try
1139 xModel.set( getDocumentModel( pBasic ), uno::UNO_SET_THROW );
1140 xVBACompat.set( getVBACompatibility( xModel ), uno::UNO_SET_THROW );
1141 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STARTED, GetName() );
1143 catch(const uno::Exception& )
1148 // Launcher problem
1149 // i80726 The Find below will genarate an error in Testtool so we reset it unless there was one before already
1150 sal_Bool bWasError = SbxBase::GetError() != 0;
1151 SbxVariable* pMSOMacroRuntimeLibVar = Find( OUString("Launcher"), SbxCLASS_OBJECT );
1152 if ( !bWasError && (SbxBase::GetError() == SbxERR_PROC_UNDEFINED) )
1153 SbxBase::ResetError();
1154 if( pMSOMacroRuntimeLibVar )
1156 StarBASIC* pMSOMacroRuntimeLib = PTR_CAST(StarBASIC,pMSOMacroRuntimeLibVar);
1157 if( pMSOMacroRuntimeLib )
1159 sal_uInt16 nGblFlag = pMSOMacroRuntimeLib->GetFlags() & SBX_GBLSEARCH;
1160 pMSOMacroRuntimeLib->ResetFlag( SBX_GBLSEARCH );
1161 SbxVariable* pAppSymbol = pMSOMacroRuntimeLib->Find( OUString("Application"), SbxCLASS_METHOD );
1162 pMSOMacroRuntimeLib->SetFlag( nGblFlag );
1163 if( pAppSymbol )
1165 pMSOMacroRuntimeLib->SetFlag( SBX_EXTSEARCH ); // Could have been disabled before
1166 GetSbData()->pMSOMacroRuntimLib = pMSOMacroRuntimeLib;
1171 if( nMaxCallLevel == 0 )
1173 #ifdef UNX
1174 struct rlimit rl;
1175 getrlimit ( RLIMIT_STACK, &rl );
1176 #endif
1177 #if defined LINUX
1178 // Empiric value, 900 = needed bytes/Basic call level
1179 // for Linux including 10% safety margin
1180 nMaxCallLevel = rl.rlim_cur / 900;
1181 #elif defined SOLARIS
1182 // Empiric value, 1650 = needed bytes/Basic call level
1183 // for Solaris including 10% safety margin
1184 nMaxCallLevel = rl.rlim_cur / 1650;
1185 #elif defined WIN32
1186 nMaxCallLevel = 5800;
1187 #else
1188 nMaxCallLevel = MAXRECURSION;
1189 #endif
1193 // Recursion to deep?
1194 if( ++GetSbData()->pInst->nCallLvl <= nMaxCallLevel )
1196 // Define a globale variable in all Mods
1197 GlobalRunInit( /* bBasicStart = */ bDelInst );
1199 // Appeared a compiler error? Then we don't launch
1200 if( !GetSbData()->bGlobalInitErr )
1202 if( bDelInst )
1204 SendHint( GetParent(), SBX_HINT_BASICSTART, pMeth );
1206 // 1996-10-16: #31460 New concept for StepInto/Over/Out
1207 // For an explanation see runtime.cxx at SbiInstance::CalcBreakCallLevel()
1208 // Identify the BreakCallLevel
1209 GetSbData()->pInst->CalcBreakCallLevel( pMeth->GetDebugFlags() );
1212 SbModule* pOldMod = GetSbData()->pMod;
1213 GetSbData()->pMod = this;
1214 SbiRuntime* pRt = new SbiRuntime( this, pMeth, pMeth->nStart );
1216 pRt->pNext = GetSbData()->pInst->pRun;
1217 if( pRt->pNext )
1218 pRt->pNext->block();
1219 GetSbData()->pInst->pRun = pRt;
1220 if ( mbVBACompat )
1222 GetSbData()->pInst->EnableCompatibility( sal_True );
1224 while( pRt->Step() ) {}
1225 if( pRt->pNext )
1226 pRt->pNext->unblock();
1228 // #63710 It can happen by an another thread handling at events,
1229 // that the show call returns to an dialog (by closing the
1230 // dialog per UI), before a by an event triggered further call returned,
1231 // which stands in Basic more top in the stack and that had been run on
1232 // a Basic-Breakpoint. Then would the instance below destroyed. And if the Basic,
1233 // that stand still in the call, further runs, there is a GPF.
1234 // Thus here had to be wait until the other call comes back.
1235 if( bDelInst )
1237 // Compare here with 1 instead of 0, because before nCallLvl--
1238 while( GetSbData()->pInst->nCallLvl != 1 )
1239 GetpApp()->Yield();
1242 nRes = sal_True;
1243 GetSbData()->pInst->pRun = pRt->pNext;
1244 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1246 // Exist an higher-ranking runtime instance?
1247 // Then take over SbDEBUG_BREAK, if set
1248 SbiRuntime* pRtNext = pRt->pNext;
1249 if( pRtNext && (pRt->GetDebugFlags() & SbDEBUG_BREAK) )
1250 pRtNext->SetDebugFlags( SbDEBUG_BREAK );
1252 delete pRt;
1253 GetSbData()->pMod = pOldMod;
1254 if( bDelInst )
1256 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1257 // at the end of the program, so that nothing were helt.
1258 ClearUnoObjectsInRTL_Impl( xBasic );
1260 clearNativeObjectWrapperVector();
1262 DBG_ASSERT(GetSbData()->pInst->nCallLvl==0,"BASIC-Call-Level > 0");
1263 delete GetSbData()->pInst, GetSbData()->pInst = NULL, bDelInst = false;
1265 // #i30690
1266 SolarMutexGuard aSolarGuard;
1267 SendHint( GetParent(), SBX_HINT_BASICSTOP, pMeth );
1269 GlobalRunDeInit();
1271 #ifdef DBG_UTIL
1272 ResetCapturedAssertions();
1273 #endif
1275 if( xVBACompat.is() )
1277 // notify all VBA script listeners about the stopped script
1280 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STOPPED, GetName() );
1282 catch(const uno::Exception& )
1285 // VBA always ensures screenupdating is enabled after completing
1286 ::basic::vba::lockControllersOfAllDocuments( xModel, sal_False );
1287 ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, sal_True );
1290 #ifdef DBG_TRACE_BASIC
1291 dbg_DeInitTrace();
1292 #endif
1295 else
1296 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1298 else
1300 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1301 StarBASIC::FatalError( SbERR_STACK_OVERFLOW );
1304 StarBASIC* pBasic = PTR_CAST(StarBASIC,GetParent());
1305 if( bDelInst )
1307 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1308 // the end of the program, so that nothing were helt.
1309 ClearUnoObjectsInRTL_Impl( xBasic );
1311 delete GetSbData()->pInst;
1312 GetSbData()->pInst = NULL;
1314 if ( pBasic && pBasic->IsDocBasic() && pBasic->IsQuitApplication() && !GetSbData()->pInst )
1315 bQuit = true;
1316 if ( bQuit )
1318 Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ), NULL );
1321 return nRes;
1324 // Execute of the init method of a module after the loading
1325 // or the compilation
1327 void SbModule::RunInit()
1329 if( pImage
1330 && !pImage->bInit
1331 && pImage->GetFlag( SBIMG_INITCODE ) )
1333 // Set flag, so that RunInit get activ (Testtool)
1334 GetSbData()->bRunInit = true;
1336 SbModule* pOldMod = GetSbData()->pMod;
1337 GetSbData()->pMod = this;
1338 // The init code starts always here
1339 SbiRuntime* pRt = new SbiRuntime( this, NULL, 0 );
1341 pRt->pNext = GetSbData()->pInst->pRun;
1342 GetSbData()->pInst->pRun = pRt;
1343 while( pRt->Step() ) {}
1345 GetSbData()->pInst->pRun = pRt->pNext;
1346 delete pRt;
1347 GetSbData()->pMod = pOldMod;
1348 pImage->bInit = true;
1349 pImage->bFirstInit = false;
1351 // RunInit is not activ anymore
1352 GetSbData()->bRunInit = false;
1356 // Delete with private/dim declared variables
1358 void SbModule::AddVarName( const OUString& aName )
1360 // see if the name is added allready
1361 std::vector< OUString >::iterator it_end = mModuleVariableNames.end();
1362 for ( std::vector< OUString >::iterator it = mModuleVariableNames.begin(); it != it_end; ++it )
1364 if ( aName == *it )
1365 return;
1367 mModuleVariableNames.push_back( aName );
1370 void SbModule::RemoveVars()
1372 std::vector< OUString >::iterator it_end = mModuleVariableNames.end();
1373 for ( std::vector< OUString >::iterator it = mModuleVariableNames.begin(); it != it_end; ++it )
1375 // We don't want a Find being called in a derived class ( e.g.
1376 // SbUserform because it could trigger say an initialise event
1377 // which would cause basic to be re-run in the middle of the init ( and remember RemoveVars is called from compile and we don't want code to run as part of the compile )
1378 SbxVariableRef p = SbModule::Find( *it, SbxCLASS_PROPERTY );
1379 if( p.Is() )
1380 Remove (p);
1384 void SbModule::ClearPrivateVars()
1386 for( sal_uInt16 i = 0 ; i < pProps->Count() ; i++ )
1388 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
1389 if( p )
1391 // Delete not the arrays, only their content
1392 if( p->GetType() & SbxARRAY )
1394 SbxArray* pArray = PTR_CAST(SbxArray,p->GetObject());
1395 if( pArray )
1397 for( sal_uInt16 j = 0 ; j < pArray->Count() ; j++ )
1399 SbxVariable* pj = PTR_CAST(SbxVariable,pArray->Get( j ));
1400 pj->SbxValue::Clear();
1404 else
1406 p->SbxValue::Clear();
1412 void SbModule::implClearIfVarDependsOnDeletedBasic( SbxVariable* pVar, StarBASIC* pDeletedBasic )
1414 if( pVar->SbxValue::GetType() != SbxOBJECT || pVar->ISA( SbProcedureProperty ) )
1415 return;
1417 SbxObject* pObj = PTR_CAST(SbxObject,pVar->GetObject());
1418 if( pObj != NULL )
1420 SbxObject* p = pObj;
1422 SbModule* pMod = PTR_CAST( SbModule, p );
1423 if( pMod != NULL )
1424 pMod->ClearVarsDependingOnDeletedBasic( pDeletedBasic );
1426 while( (p = p->GetParent()) != NULL )
1428 StarBASIC* pBasic = PTR_CAST( StarBASIC, p );
1429 if( pBasic != NULL && pBasic == pDeletedBasic )
1431 pVar->SbxValue::Clear();
1432 break;
1438 void SbModule::ClearVarsDependingOnDeletedBasic( StarBASIC* pDeletedBasic )
1440 (void)pDeletedBasic;
1442 for( sal_uInt16 i = 0 ; i < pProps->Count() ; i++ )
1444 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
1445 if( p )
1447 if( p->GetType() & SbxARRAY )
1449 SbxArray* pArray = PTR_CAST(SbxArray,p->GetObject());
1450 if( pArray )
1452 for( sal_uInt16 j = 0 ; j < pArray->Count() ; j++ )
1454 SbxVariable* pVar = PTR_CAST(SbxVariable,pArray->Get( j ));
1455 implClearIfVarDependsOnDeletedBasic( pVar, pDeletedBasic );
1459 else
1461 implClearIfVarDependsOnDeletedBasic( p, pDeletedBasic );
1467 void StarBASIC::ClearAllModuleVars( void )
1469 // Initialise the own module
1470 for ( sal_uInt16 nMod = 0; nMod < pModules->Count(); nMod++ )
1472 SbModule* pModule = (SbModule*)pModules->Get( nMod );
1473 // Initialise only, if the startcode was already executed
1474 if( pModule->pImage && pModule->pImage->bInit && !pModule->isProxyModule() && !pModule->ISA(SbObjModule) )
1475 pModule->ClearPrivateVars();
1480 // Execution of the init-code of all module
1481 void SbModule::GlobalRunInit( bool bBasicStart )
1483 // If no Basic-Start, only initialise, if the module is not initialised
1484 if( !bBasicStart )
1485 if( !(pImage && !pImage->bInit) )
1486 return;
1488 // Initialise GlobalInitErr-Flag for Compiler-Error
1489 // With the help of this flags could be located in SbModule::Run() after the call of
1490 // GlobalRunInit, if at the intialising of the module
1491 // an error occurred. Then it will not be launched.
1492 GetSbData()->bGlobalInitErr = false;
1494 // Parent of the module is a Basic
1495 StarBASIC *pBasic = PTR_CAST(StarBASIC,GetParent());
1496 if( pBasic )
1498 pBasic->InitAllModules();
1500 SbxObject* pParent_ = pBasic->GetParent();
1501 if( pParent_ )
1503 StarBASIC * pParentBasic = PTR_CAST(StarBASIC,pParent_);
1504 if( pParentBasic )
1506 pParentBasic->InitAllModules( pBasic );
1508 // #109018 Parent can also have a parent (library in doc)
1509 SbxObject* pParentParent = pParentBasic->GetParent();
1510 if( pParentParent )
1512 StarBASIC * pParentParentBasic = PTR_CAST(StarBASIC,pParentParent);
1513 if( pParentParentBasic )
1514 pParentParentBasic->InitAllModules( pParentBasic );
1521 void SbModule::GlobalRunDeInit( void )
1523 StarBASIC *pBasic = PTR_CAST(StarBASIC,GetParent());
1524 if( pBasic )
1526 pBasic->DeInitAllModules();
1528 SbxObject* pParent_ = pBasic->GetParent();
1529 if( pParent_ )
1530 pBasic = PTR_CAST(StarBASIC,pParent_);
1531 if( pBasic )
1532 pBasic->DeInitAllModules();
1536 // Search for the next STMNT-Command in the code. This was used from the STMNT-
1537 // Opcode to set the endcolumn.
1539 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol ) const
1541 return FindNextStmnt( p, nLine, nCol, sal_False );
1544 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol,
1545 sal_Bool bFollowJumps, const SbiImage* pImg ) const
1547 sal_uInt32 nPC = (sal_uInt32) ( p - (const sal_uInt8*) pImage->GetCode() );
1548 while( nPC < pImage->GetCodeSize() )
1550 SbiOpcode eOp = (SbiOpcode ) ( *p++ );
1551 nPC++;
1552 if( bFollowJumps && eOp == _JUMP && pImg )
1554 DBG_ASSERT( pImg, "FindNextStmnt: pImg==NULL with FollowJumps option" );
1555 sal_uInt32 nOp1 = *p++; nOp1 |= *p++ << 8;
1556 nOp1 |= *p++ << 16; nOp1 |= *p++ << 24;
1557 p = (const sal_uInt8*) pImg->GetCode() + nOp1;
1559 else if( eOp >= SbOP1_START && eOp <= SbOP1_END )
1560 p += 4, nPC += 4;
1561 else if( eOp == _STMNT )
1563 sal_uInt32 nl, nc;
1564 nl = *p++; nl |= *p++ << 8;
1565 nl |= *p++ << 16 ; nl |= *p++ << 24;
1566 nc = *p++; nc |= *p++ << 8;
1567 nc |= *p++ << 16 ; nc |= *p++ << 24;
1568 nLine = (sal_uInt16)nl; nCol = (sal_uInt16)nc;
1569 return p;
1571 else if( eOp >= SbOP2_START && eOp <= SbOP2_END )
1572 p += 8, nPC += 8;
1573 else if( !( eOp >= SbOP0_START && eOp <= SbOP0_END ) )
1575 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1576 break;
1579 return NULL;
1582 // Test, if a line contains STMNT-Opcodes
1584 sal_Bool SbModule::IsBreakable( sal_uInt16 nLine ) const
1586 if( !pImage )
1587 return sal_False;
1588 const sal_uInt8* p = (const sal_uInt8* ) pImage->GetCode();
1589 sal_uInt16 nl, nc;
1590 while( ( p = FindNextStmnt( p, nl, nc ) ) != NULL )
1591 if( nl == nLine )
1592 return sal_True;
1593 return sal_False;
1596 size_t SbModule::GetBPCount() const
1598 return pBreaks ? pBreaks->size() : 0;
1601 sal_uInt16 SbModule::GetBP( size_t n ) const
1603 if( pBreaks && n < pBreaks->size() )
1604 return pBreaks->operator[]( n );
1605 else
1606 return 0;
1609 sal_Bool SbModule::IsBP( sal_uInt16 nLine ) const
1611 if( pBreaks )
1613 for( size_t i = 0; i < pBreaks->size(); i++ )
1615 sal_uInt16 b = pBreaks->operator[]( i );
1616 if( b == nLine )
1617 return sal_True;
1618 if( b < nLine )
1619 break;
1622 return sal_False;
1625 sal_Bool SbModule::SetBP( sal_uInt16 nLine )
1627 if( !IsBreakable( nLine ) )
1628 return sal_False;
1629 if( !pBreaks )
1630 pBreaks = new SbiBreakpoints;
1631 size_t i;
1632 for( i = 0; i < pBreaks->size(); i++ )
1634 sal_uInt16 b = pBreaks->operator[]( i );
1635 if( b == nLine )
1636 return sal_True;
1637 if( b < nLine )
1638 break;
1640 pBreaks->insert( pBreaks->begin() + i, nLine );
1642 // #38568: Set during runtime as well here SbDEBUG_BREAK
1643 if( GetSbData()->pInst && GetSbData()->pInst->pRun )
1644 GetSbData()->pInst->pRun->SetDebugFlags( SbDEBUG_BREAK );
1646 return IsBreakable( nLine );
1649 sal_Bool SbModule::ClearBP( sal_uInt16 nLine )
1651 sal_Bool bRes = sal_False;
1652 if( pBreaks )
1654 for( size_t i = 0; i < pBreaks->size(); i++ )
1656 sal_uInt16 b = pBreaks->operator[]( i );
1657 if( b == nLine )
1659 pBreaks->erase( pBreaks->begin() + i );
1660 bRes = sal_True;
1661 break;
1663 if( b < nLine )
1664 break;
1666 if( pBreaks->empty() )
1667 delete pBreaks, pBreaks = NULL;
1669 return bRes;
1672 void SbModule::ClearAllBP()
1674 delete pBreaks;
1675 pBreaks = NULL;
1678 void
1679 SbModule::fixUpMethodStart( bool bCvtToLegacy, SbiImage* pImg ) const
1681 if ( !pImg )
1682 pImg = pImage;
1683 for( sal_uInt32 i = 0; i < pMethods->Count(); i++ )
1685 SbMethod* pMeth = PTR_CAST(SbMethod,pMethods->Get( (sal_uInt16)i ) );
1686 if( pMeth )
1688 //fixup method start positions
1689 if ( bCvtToLegacy )
1690 pMeth->nStart = pImg->CalcLegacyOffset( pMeth->nStart );
1691 else
1692 pMeth->nStart = pImg->CalcNewOffset( (sal_uInt16)pMeth->nStart );
1698 sal_Bool SbModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
1700 Clear();
1701 if( !SbxObject::LoadData( rStrm, 1 ) )
1702 return sal_False;
1703 // As a precaution...
1704 SetFlag( SBX_EXTSEARCH | SBX_GBLSEARCH );
1705 sal_uInt8 bImage;
1706 rStrm >> bImage;
1707 if( bImage )
1709 SbiImage* p = new SbiImage;
1710 sal_uInt32 nImgVer = 0;
1712 if( !p->Load( rStrm, nImgVer ) )
1714 delete p;
1715 return sal_False;
1717 // If the image is in old format, we fix up the method start offsets
1718 if ( nImgVer < B_EXT_IMG_VERSION )
1720 fixUpMethodStart( false, p );
1721 p->ReleaseLegacyBuffer();
1723 aComment = p->aComment;
1724 SetName( p->aName );
1725 if( p->GetCodeSize() )
1727 aOUSource = p->aOUSource;
1728 // Old version: image away
1729 if( nVer == 1 )
1731 SetSource32( p->aOUSource );
1732 delete p;
1734 else
1735 pImage = p;
1737 else
1739 SetSource32( p->aOUSource );
1740 delete p;
1743 return sal_True;
1746 sal_Bool SbModule::StoreData( SvStream& rStrm ) const
1748 bool bFixup = ( pImage && !pImage->ExceedsLegacyLimits() );
1749 if ( bFixup )
1750 fixUpMethodStart( true );
1751 sal_Bool bRet = SbxObject::StoreData( rStrm );
1752 if ( !bRet )
1753 return sal_False;
1755 if( pImage )
1757 pImage->aOUSource = aOUSource;
1758 pImage->aComment = aComment;
1759 pImage->aName = GetName();
1760 rStrm << (sal_uInt8) 1;
1761 // # PCode is saved only for legacy formats only
1762 // It should be noted that it probably isn't necessary
1763 // It would be better not to store the image ( more flexible with
1764 // formats )
1765 bool bRes = pImage->Save( rStrm, B_LEGACYVERSION );
1766 if ( bFixup )
1767 fixUpMethodStart( false ); // restore method starts
1768 return bRes;
1771 else
1773 SbiImage aImg;
1774 aImg.aOUSource = aOUSource;
1775 aImg.aComment = aComment;
1776 aImg.aName = GetName();
1777 rStrm << (sal_uInt8) 1;
1778 return aImg.Save( rStrm );
1782 sal_Bool SbModule::ExceedsLegacyModuleSize()
1784 if ( !IsCompiled() )
1785 Compile();
1786 if ( pImage && pImage->ExceedsLegacyLimits() )
1787 return true;
1788 return false;
1791 class ErrorHdlResetter
1793 Link mErrHandler;
1794 bool mbError;
1795 public:
1796 ErrorHdlResetter() : mbError( false )
1798 // save error handler
1799 mErrHandler = StarBASIC::GetGlobalErrorHdl();
1800 // set new error handler
1801 StarBASIC::SetGlobalErrorHdl( LINK( this, ErrorHdlResetter, BasicErrorHdl ) );
1803 ~ErrorHdlResetter()
1805 // restore error handler
1806 StarBASIC::SetGlobalErrorHdl(mErrHandler);
1808 DECL_LINK( BasicErrorHdl, StarBASIC * );
1809 bool HasError() { return mbError; }
1811 IMPL_LINK( ErrorHdlResetter, BasicErrorHdl, StarBASIC *, /*pBasic*/)
1813 mbError = true;
1814 return 0;
1817 bool SbModule::HasExeCode()
1819 // And empty Image always has the Global Chain set up
1820 static const unsigned char pEmptyImage[] = { 0x45, 0x0 , 0x0, 0x0, 0x0 };
1821 // lets be stricter for the moment than VBA
1823 if (!IsCompiled())
1825 ErrorHdlResetter aGblErrHdl;
1826 Compile();
1827 if (aGblErrHdl.HasError()) //assume unsafe on compile error
1828 return true;
1831 bool bRes = false;
1832 if (pImage && !(pImage->GetCodeSize() == 5 && (memcmp(pImage->GetCode(), pEmptyImage, pImage->GetCodeSize()) == 0 )))
1833 bRes = true;
1835 return bRes;
1838 // Store only image, no source
1839 sal_Bool SbModule::StoreBinaryData( SvStream& rStrm )
1841 return StoreBinaryData( rStrm, 0 );
1844 sal_Bool SbModule::StoreBinaryData( SvStream& rStrm, sal_uInt16 nVer )
1846 sal_Bool bRet = Compile();
1847 if( bRet )
1849 bool bFixup = ( !nVer && !pImage->ExceedsLegacyLimits() );// save in old image format, fix up method starts
1851 if ( bFixup ) // save in old image format, fix up method starts
1852 fixUpMethodStart( true );
1853 bRet = SbxObject::StoreData( rStrm );
1854 if( bRet )
1856 pImage->aOUSource = OUString();
1857 pImage->aComment = aComment;
1858 pImage->aName = GetName();
1860 rStrm << (sal_uInt8) 1;
1861 if ( nVer )
1862 bRet = pImage->Save( rStrm, B_EXT_IMG_VERSION );
1863 else
1864 bRet = pImage->Save( rStrm, B_LEGACYVERSION );
1865 if ( bFixup )
1866 fixUpMethodStart( false ); // restore method starts
1868 pImage->aOUSource = aOUSource;
1871 return bRet;
1874 // Called for >= OO 1.0 passwd protected libraries only
1876 sal_Bool SbModule::LoadBinaryData( SvStream& rStrm )
1878 OUString aKeepSource = aOUSource;
1879 bool bRet = LoadData( rStrm, 2 );
1880 LoadCompleted();
1881 aOUSource = aKeepSource;
1882 return bRet;
1885 sal_Bool SbModule::LoadCompleted()
1887 SbxArray* p = GetMethods();
1888 sal_uInt16 i;
1889 for( i = 0; i < p->Count(); i++ )
1891 SbMethod* q = PTR_CAST(SbMethod,p->Get( i ) );
1892 if( q )
1893 q->pMod = this;
1895 p = GetProperties();
1896 for( i = 0; i < p->Count(); i++ )
1898 SbProperty* q = PTR_CAST(SbProperty,p->Get( i ) );
1899 if( q )
1900 q->pMod = this;
1902 return sal_True;
1905 void SbModule::handleProcedureProperties( SfxBroadcaster& rBC, const SfxHint& rHint )
1907 bool bDone = false;
1909 const SbxHint* pHint = PTR_CAST(SbxHint,&rHint);
1910 if( pHint )
1912 SbxVariable* pVar = pHint->GetVar();
1913 SbProcedureProperty* pProcProperty = PTR_CAST( SbProcedureProperty, pVar );
1914 if( pProcProperty )
1916 bDone = true;
1918 if( pHint->GetId() == SBX_HINT_DATAWANTED )
1920 OUString aProcName("Property Get ");
1921 aProcName += pProcProperty->GetName();
1923 SbxVariable* pMeth = Find( aProcName, SbxCLASS_METHOD );
1924 if( pMeth )
1926 SbxValues aVals;
1927 aVals.eType = SbxVARIANT;
1929 SbxArray* pArg = pVar->GetParameters();
1930 sal_uInt16 nVarParCount = (pArg != NULL) ? pArg->Count() : 0;
1931 if( nVarParCount > 1 )
1933 SbxArrayRef xMethParameters = new SbxArray;
1934 xMethParameters->Put( pMeth, 0 ); // Method as parameter 0
1935 for( sal_uInt16 i = 1 ; i < nVarParCount ; ++i )
1937 SbxVariable* pPar = pArg->Get( i );
1938 xMethParameters->Put( pPar, i );
1941 pMeth->SetParameters( xMethParameters );
1942 pMeth->Get( aVals );
1943 pMeth->SetParameters( NULL );
1945 else
1947 pMeth->Get( aVals );
1950 pVar->Put( aVals );
1953 else if( pHint->GetId() == SBX_HINT_DATACHANGED )
1955 SbxVariable* pMeth = NULL;
1957 bool bSet = pProcProperty->isSet();
1958 if( bSet )
1960 pProcProperty->setSet( false );
1962 OUString aProcName("Property Set " );
1963 aProcName += pProcProperty->GetName();
1964 pMeth = Find( aProcName, SbxCLASS_METHOD );
1966 if( !pMeth ) // Let
1968 OUString aProcName("Property Set " );
1969 aProcName += pProcProperty->GetName();
1970 pMeth = Find( aProcName, SbxCLASS_METHOD );
1973 if( pMeth )
1975 // Setup parameters
1976 SbxArrayRef xArray = new SbxArray;
1977 xArray->Put( pMeth, 0 ); // Method as parameter 0
1978 xArray->Put( pVar, 1 );
1979 pMeth->SetParameters( xArray );
1981 SbxValues aVals;
1982 pMeth->Get( aVals );
1983 pMeth->SetParameters( NULL );
1989 if( !bDone )
1990 SbModule::Notify( rBC, rHint );
1994 // Implementation SbJScriptModule (Basic module for JavaScript source code)
1995 SbJScriptModule::SbJScriptModule( const OUString& rName )
1996 :SbModule( rName )
2000 sal_Bool SbJScriptModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
2002 (void)nVer;
2004 Clear();
2005 if( !SbxObject::LoadData( rStrm, 1 ) )
2006 return sal_False;
2008 // Get the source string
2009 aOUSource = rStrm.ReadUniOrByteString( osl_getThreadTextEncoding() );
2010 return sal_True;
2013 sal_Bool SbJScriptModule::StoreData( SvStream& rStrm ) const
2015 if( !SbxObject::StoreData( rStrm ) )
2016 return sal_False;
2018 // Write the source string
2019 OUString aTmp = aOUSource;
2020 rStrm.WriteUniOrByteString( aTmp, osl_getThreadTextEncoding() );
2021 return sal_True;
2025 /////////////////////////////////////////////////////////////////////////
2027 SbMethod::SbMethod( const OUString& r, SbxDataType t, SbModule* p )
2028 : SbxMethod( r, t ), pMod( p )
2030 bInvalid = sal_True;
2031 nStart =
2032 nDebugFlags =
2033 nLine1 =
2034 nLine2 = 0;
2035 refStatics = new SbxArray;
2036 mCaller = 0;
2037 // HACK due to 'Referenz could not be saved'
2038 SetFlag( SBX_NO_MODIFY );
2041 SbMethod::SbMethod( const SbMethod& r )
2042 : SvRefBase( r ), SbxMethod( r )
2044 pMod = r.pMod;
2045 bInvalid = r.bInvalid;
2046 nStart = r.nStart;
2047 nDebugFlags = r.nDebugFlags;
2048 nLine1 = r.nLine1;
2049 nLine2 = r.nLine2;
2050 refStatics = r.refStatics;
2051 mCaller = r.mCaller;
2052 SetFlag( SBX_NO_MODIFY );
2055 SbMethod::~SbMethod()
2059 void SbMethod::ClearStatics()
2061 refStatics = new SbxArray;
2064 SbxArray* SbMethod::GetStatics()
2066 return refStatics;
2069 sal_Bool SbMethod::LoadData( SvStream& rStrm, sal_uInt16 nVer )
2071 if( !SbxMethod::LoadData( rStrm, 1 ) )
2072 return sal_False;
2073 sal_Int16 n;
2074 rStrm >> n;
2075 sal_Int16 nTempStart = (sal_Int16)nStart;
2076 if( nVer == 2 )
2077 rStrm >> nLine1 >> nLine2 >> nTempStart >> bInvalid;
2078 // HACK ue to 'Referenz could not be saved'
2079 SetFlag( SBX_NO_MODIFY );
2080 nStart = nTempStart;
2081 return sal_True;
2084 sal_Bool SbMethod::StoreData( SvStream& rStrm ) const
2086 if( !SbxMethod::StoreData( rStrm ) )
2087 return sal_False;
2088 rStrm << (sal_Int16) nDebugFlags
2089 << (sal_Int16) nLine1
2090 << (sal_Int16) nLine2
2091 << (sal_Int16) nStart
2092 << (sal_uInt8) bInvalid;
2093 return sal_True;
2096 void SbMethod::GetLineRange( sal_uInt16& l1, sal_uInt16& l2 )
2098 l1 = nLine1; l2 = nLine2;
2101 // Could later be deleted
2103 SbxInfo* SbMethod::GetInfo()
2105 return pInfo;
2108 // Interface to execute a method of the applications
2109 // With special RefCounting, so that the Basic was not fired of by CloseDocument()
2110 // The return value will be delivered as string.
2111 ErrCode SbMethod::Call( SbxValue* pRet, SbxVariable* pCaller )
2113 if ( pCaller )
2115 OSL_TRACE("SbMethod::Call Have been passed a caller 0x%x", pCaller );
2116 mCaller = pCaller;
2118 // RefCount vom Modul hochzaehlen
2119 SbModule* pMod_ = (SbModule*)GetParent();
2120 pMod_->AddRef();
2122 // Increment the RefCount of the Basic
2123 StarBASIC* pBasic = (StarBASIC*)pMod_->GetParent();
2124 pBasic->AddRef();
2126 // Establish the values to get the return value
2127 SbxValues aVals;
2128 aVals.eType = SbxVARIANT;
2130 // #104083: Compile BEFORE get
2131 if( bInvalid && !pMod_->Compile() )
2132 StarBASIC::Error( SbERR_BAD_PROP_VALUE );
2134 Get( aVals );
2135 if ( pRet )
2136 pRet->Put( aVals );
2138 // Was there an error
2139 ErrCode nErr = SbxBase::GetError();
2140 SbxBase::ResetError();
2142 // Release objects
2143 pMod_->ReleaseRef();
2144 pBasic->ReleaseRef();
2145 mCaller = 0;
2146 return nErr;
2150 // #100883 Own Broadcast for SbMethod
2151 void SbMethod::Broadcast( sal_uIntPtr nHintId )
2153 if( pCst && !IsSet( SBX_NO_BROADCAST ) )
2155 // Because the method could be called from outside, test here once again
2156 // the authorisation
2157 if( nHintId & SBX_HINT_DATAWANTED )
2158 if( !CanRead() )
2159 return;
2160 if( nHintId & SBX_HINT_DATACHANGED )
2161 if( !CanWrite() )
2162 return;
2164 if( pMod && !pMod->IsCompiled() )
2165 pMod->Compile();
2167 // Block broadcasts while creating new method
2168 SfxBroadcaster* pSave = pCst;
2169 pCst = NULL;
2170 SbMethod* pThisCopy = new SbMethod( *this );
2171 SbMethodRef xHolder = pThisCopy;
2172 if( mpPar.Is() )
2174 // Enrigister this as element 0, but don't reset the parent!
2175 if( GetType() != SbxVOID )
2176 mpPar->PutDirect( pThisCopy, 0 );
2177 SetParameters( NULL );
2180 pCst = pSave;
2181 pSave->Broadcast( SbxHint( nHintId, pThisCopy ) );
2183 sal_uInt16 nSaveFlags = GetFlags();
2184 SetFlag( SBX_READWRITE );
2185 pCst = NULL;
2186 Put( pThisCopy->GetValues_Impl() );
2187 pCst = pSave;
2188 SetFlags( nSaveFlags );
2193 // Implementation of SbJScriptMethod (method class as a wrapper for JavaScript-functions)
2195 SbJScriptMethod::SbJScriptMethod( const OUString& r, SbxDataType t, SbModule* p )
2196 : SbMethod( r, t, p )
2200 SbJScriptMethod::~SbJScriptMethod()
2204 SbObjModule::SbObjModule( const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVbaCompatible )
2205 : SbModule( rName, bIsVbaCompatible )
2207 SetModuleType( mInfo.ModuleType );
2208 if ( mInfo.ModuleType == script::ModuleType::FORM )
2210 SetClassName( OUString("Form" ) );
2212 else if ( mInfo.ModuleObject.is() )
2214 SetUnoObject( uno::makeAny( mInfo.ModuleObject ) );
2218 SbObjModule::~SbObjModule()
2222 void
2223 SbObjModule::SetUnoObject( const uno::Any& aObj ) throw ( uno::RuntimeException )
2225 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxVariable*)pDocObject);
2226 if ( pUnoObj && pUnoObj->getUnoAny() == aObj ) // object is equal, nothing to do
2227 return;
2228 pDocObject = new SbUnoObject( GetName(), uno::makeAny( aObj ) );
2230 com::sun::star::uno::Reference< com::sun::star::lang::XServiceInfo > xServiceInfo( aObj, com::sun::star::uno::UNO_QUERY_THROW );
2231 if( xServiceInfo->supportsService( OUString("ooo.vba.excel.Worksheet" ) ) )
2233 SetClassName( OUString("Worksheet" ) );
2235 else if( xServiceInfo->supportsService( OUString("ooo.vba.excel.Workbook" ) ) )
2237 SetClassName( OUString("Workbook" ) );
2241 SbxVariable*
2242 SbObjModule::GetObject()
2244 return pDocObject;
2246 SbxVariable*
2247 SbObjModule::Find( const OUString& rName, SbxClassType t )
2249 SbxVariable* pVar = NULL;
2250 if ( pDocObject)
2251 pVar = pDocObject->Find( rName, t );
2252 if ( !pVar )
2253 pVar = SbModule::Find( rName, t );
2254 return pVar;
2257 void SbObjModule::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
2258 const SfxHint& rHint, const TypeId& rHintType )
2260 SbModule::handleProcedureProperties( rBC, rHint );
2264 typedef ::cppu::WeakImplHelper3<
2265 awt::XTopWindowListener,
2266 awt::XWindowListener,
2267 document::XEventListener > FormObjEventListener_BASE;
2269 class FormObjEventListenerImpl : public FormObjEventListener_BASE
2271 SbUserFormModule* mpUserForm;
2272 uno::Reference< lang::XComponent > mxComponent;
2273 uno::Reference< frame::XModel > mxModel;
2274 bool mbDisposed;
2275 sal_Bool mbOpened;
2276 sal_Bool mbActivated;
2277 sal_Bool mbShowing;
2279 FormObjEventListenerImpl(const FormObjEventListenerImpl&); // not defined
2280 FormObjEventListenerImpl& operator=(const FormObjEventListenerImpl&); // not defined
2282 public:
2283 FormObjEventListenerImpl( SbUserFormModule* pUserForm, const uno::Reference< lang::XComponent >& xComponent, const uno::Reference< frame::XModel >& xModel ) :
2284 mpUserForm( pUserForm ), mxComponent( xComponent), mxModel( xModel ),
2285 mbDisposed( false ), mbOpened( sal_False ), mbActivated( sal_False ), mbShowing( sal_False )
2287 if ( mxComponent.is() )
2289 OSL_TRACE("*********** Registering the listeners");
2292 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->addTopWindowListener( this );
2294 catch(const uno::Exception& ) {}
2297 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->addWindowListener( this );
2299 catch(const uno::Exception& ) {}
2302 if ( mxModel.is() )
2306 uno::Reference< document::XEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->addEventListener( this );
2308 catch(const uno::Exception& ) {}
2312 virtual ~FormObjEventListenerImpl()
2314 removeListener();
2317 sal_Bool isShowing() const { return mbShowing; }
2319 void removeListener()
2321 if ( mxComponent.is() && !mbDisposed )
2323 OSL_TRACE("*********** Removing the listeners");
2326 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeTopWindowListener( this );
2328 catch(const uno::Exception& ) {}
2331 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeWindowListener( this );
2333 catch(const uno::Exception& ) {}
2335 mxComponent.clear();
2337 if ( mxModel.is() && !mbDisposed )
2341 uno::Reference< document::XEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->removeEventListener( this );
2343 catch(const uno::Exception& ) {}
2345 mxModel.clear();
2348 virtual void SAL_CALL windowOpened( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2350 if ( mpUserForm )
2352 mbOpened = sal_True;
2353 mbShowing = sal_True;
2354 if ( mbActivated )
2356 mbOpened = mbActivated = sal_False;
2357 mpUserForm->triggerActivateEvent();
2363 virtual void SAL_CALL windowClosing( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2365 #ifdef IN_THE_FUTURE
2366 uno::Reference< awt::XDialog > xDialog( e.Source, uno::UNO_QUERY );
2367 if ( xDialog.is() )
2369 uno::Reference< awt::XControl > xControl( xDialog, uno::UNO_QUERY );
2370 if ( xControl->getPeer().is() )
2372 uno::Reference< document::XVbaMethodParameter > xVbaMethodParameter( xControl->getPeer(), uno::UNO_QUERY );
2373 if ( xVbaMethodParameter.is() )
2375 sal_Int8 nCancel = 0;
2376 sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormControlMenu;
2378 Sequence< Any > aParams;
2379 aParams.realloc(2);
2380 aParams[0] <<= nCancel;
2381 aParams[1] <<= nCloseMode;
2383 mpUserForm->triggerMethod( OUString("Userform_QueryClose" ), aParams);
2384 return;
2390 mpUserForm->triggerMethod( OUString("Userform_QueryClose" ) );
2391 #endif
2395 virtual void SAL_CALL windowClosed( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2397 mbOpened = sal_False;
2398 mbShowing = sal_False;
2401 virtual void SAL_CALL windowMinimized( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2405 virtual void SAL_CALL windowNormalized( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2409 virtual void SAL_CALL windowActivated( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2411 if ( mpUserForm )
2413 mbActivated = sal_True;
2414 if ( mbOpened )
2416 mbOpened = mbActivated = sal_False;
2417 mpUserForm->triggerActivateEvent();
2422 virtual void SAL_CALL windowDeactivated( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2424 if ( mpUserForm )
2425 mpUserForm->triggerDeactivateEvent();
2428 virtual void SAL_CALL windowResized( const awt::WindowEvent& /*e*/ ) throw (uno::RuntimeException)
2430 if ( mpUserForm )
2432 mpUserForm->triggerResizeEvent();
2433 mpUserForm->triggerLayoutEvent();
2437 virtual void SAL_CALL windowMoved( const awt::WindowEvent& /*e*/ ) throw (uno::RuntimeException)
2439 if ( mpUserForm )
2440 mpUserForm->triggerLayoutEvent();
2443 virtual void SAL_CALL windowShown( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2447 virtual void SAL_CALL windowHidden( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2451 virtual void SAL_CALL notifyEvent( const document::EventObject& rEvent ) throw (uno::RuntimeException)
2453 // early dosposing on document event "OnUnload", to be sure Basic still exists when calling VBA "UserForm_Terminate"
2454 if( rEvent.EventName == GlobalEventConfig::GetEventName( STR_EVENT_CLOSEDOC ) )
2456 removeListener();
2457 mbDisposed = true;
2458 if ( mpUserForm )
2459 mpUserForm->ResetApiObj(); // will trigger "UserForm_Terminate"
2463 virtual void SAL_CALL disposing( const lang::EventObject& /*Source*/ ) throw (uno::RuntimeException)
2465 OSL_TRACE("** Userform/Dialog disposing");
2466 removeListener();
2467 mbDisposed = true;
2468 if ( mpUserForm )
2469 mpUserForm->ResetApiObj( false ); // pass false (too late to trigger VBA events here)
2473 SbUserFormModule::SbUserFormModule( const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsCompat )
2474 : SbObjModule( rName, mInfo, bIsCompat )
2475 , m_mInfo( mInfo )
2476 , mbInit( false )
2478 m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW );
2481 SbUserFormModule::~SbUserFormModule()
2485 void SbUserFormModule::ResetApiObj( bool bTriggerTerminateEvent )
2487 OSL_TRACE(" SbUserFormModule::ResetApiObj( %s )", bTriggerTerminateEvent ? "true" : "false" );
2488 if ( bTriggerTerminateEvent && m_xDialog.is() ) // probably someone close the dialog window
2490 triggerTerminateEvent();
2492 pDocObject = NULL;
2493 m_xDialog = NULL;
2496 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun )
2498 Sequence< Any > aArguments;
2499 triggerMethod( aMethodToRun, aArguments );
2502 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun, Sequence< Any >& aArguments )
2504 OSL_TRACE("*** trigger %s ***", rtl::OUStringToOString( aMethodToRun, RTL_TEXTENCODING_UTF8 ).getStr() );
2505 // Search method
2506 SbxVariable* pMeth = SbObjModule::Find( aMethodToRun, SbxCLASS_METHOD );
2507 if( pMeth )
2509 if ( aArguments.getLength() > 0 ) // Setup parameters
2511 SbxArrayRef xArray = new SbxArray;
2512 xArray->Put( pMeth, 0 ); // Method as parameter 0
2514 for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2516 SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
2517 unoToSbxValue( static_cast< SbxVariable* >( xSbxVar ), aArguments[i] );
2518 xArray->Put( xSbxVar, static_cast< sal_uInt16 >( i ) + 1 );
2520 // Enable passing by ref
2521 if ( xSbxVar->GetType() != SbxVARIANT )
2522 xSbxVar->SetFlag( SBX_FIXED );
2524 pMeth->SetParameters( xArray );
2526 SbxValues aVals;
2527 pMeth->Get( aVals );
2529 for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2531 aArguments[i] = sbxToUnoValue( xArray->Get( static_cast< sal_uInt16 >(i) + 1) );
2533 pMeth->SetParameters( NULL );
2535 else
2537 SbxValues aVals;
2538 pMeth->Get( aVals );
2543 void SbUserFormModule::triggerActivateEvent( void )
2545 OSL_TRACE("**** entering SbUserFormModule::triggerActivate");
2546 triggerMethod( OUString( "UserForm_Activate" ) );
2547 OSL_TRACE("**** leaving SbUserFormModule::triggerActivate");
2550 void SbUserFormModule::triggerDeactivateEvent( void )
2552 OSL_TRACE("**** SbUserFormModule::triggerDeactivate");
2553 triggerMethod( OUString("Userform_Deactivate" ) );
2556 void SbUserFormModule::triggerInitializeEvent( void )
2558 if ( mbInit )
2559 return;
2560 OSL_TRACE("**** SbUserFormModule::triggerInitializeEvent");
2561 static OUString aInitMethodName( "Userform_Initialize");
2562 triggerMethod( aInitMethodName );
2563 mbInit = true;
2566 void SbUserFormModule::triggerTerminateEvent( void )
2568 OSL_TRACE("**** SbUserFormModule::triggerTerminateEvent");
2569 static OUString aTermMethodName( "Userform_Terminate" );
2570 triggerMethod( aTermMethodName );
2571 mbInit=false;
2574 void SbUserFormModule::triggerLayoutEvent( void )
2576 static OUString aMethodName( "Userform_Layout" );
2577 triggerMethod( aMethodName );
2580 void SbUserFormModule::triggerResizeEvent( void )
2582 static OUString aMethodName("Userform_Resize");
2583 triggerMethod( aMethodName );
2586 SbUserFormModuleInstance* SbUserFormModule::CreateInstance()
2588 SbUserFormModuleInstance* pInstance = new SbUserFormModuleInstance( this, GetName(), m_mInfo, IsVBACompat() );
2589 return pInstance;
2592 SbUserFormModuleInstance::SbUserFormModuleInstance( SbUserFormModule* pParentModule,
2593 const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVBACompat )
2594 : SbUserFormModule( rName, mInfo, bIsVBACompat )
2595 , m_pParentModule( pParentModule )
2599 sal_Bool SbUserFormModuleInstance::IsClass( const OUString& rName ) const
2601 sal_Bool bParentNameMatches = m_pParentModule->GetName().equalsIgnoreAsciiCase( rName );
2602 sal_Bool bRet = bParentNameMatches || SbxObject::IsClass( rName );
2603 return bRet;
2606 SbxVariable* SbUserFormModuleInstance::Find( const OUString& rName, SbxClassType t )
2608 SbxVariable* pVar = m_pParentModule->Find( rName, t );
2609 return pVar;
2613 void SbUserFormModule::Load()
2615 OSL_TRACE("** load() ");
2616 // forces a load
2617 if ( !pDocObject )
2618 InitObject();
2622 void SbUserFormModule::Unload()
2624 OSL_TRACE("** Unload() ");
2626 sal_Int8 nCancel = 0;
2627 sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormCode;
2629 Sequence< Any > aParams;
2630 aParams.realloc(2);
2631 aParams[0] <<= nCancel;
2632 aParams[1] <<= nCloseMode;
2634 triggerMethod( OUString("Userform_QueryClose" ), aParams);
2636 aParams[0] >>= nCancel;
2637 // basic boolean ( and what the user might use ) can be ambiguous ( e.g. basic true = -1 )
2638 // test agains 0 ( false ) and assume anything else is true
2639 // ( Note: ) this used to work ( something changes somewhere )
2640 if (nCancel != 0)
2642 return;
2645 if ( m_xDialog.is() )
2647 triggerTerminateEvent();
2649 // Search method
2650 SbxVariable* pMeth = SbObjModule::Find( OUString("UnloadObject"), SbxCLASS_METHOD );
2651 if( pMeth )
2653 OSL_TRACE("Attempting too run the UnloadObjectMethod");
2654 m_xDialog.clear(); //release ref to the uno object
2655 SbxValues aVals;
2656 bool bWaitForDispose = true; // assume dialog is showing
2657 if ( m_DialogListener.get() )
2659 bWaitForDispose = m_DialogListener->isShowing();
2660 OSL_TRACE("Showing %d", bWaitForDispose );
2662 pMeth->Get( aVals);
2663 if ( !bWaitForDispose )
2665 // we've either already got a dispose or we'er never going to get one
2666 ResetApiObj();
2667 } // else wait for dispose
2668 OSL_TRACE("UnloadObject completed ( we hope )");
2673 void registerComponentToBeDisposedForBasic( Reference< XComponent > xComponent, StarBASIC* pBasic );
2675 void SbUserFormModule::InitObject()
2679 OUString aHook("VBAGlobals");
2680 SbUnoObject* pGlobs = (SbUnoObject*)GetParent()->Find( aHook, SbxCLASS_DONTCARE );
2681 if ( m_xModel.is() && pGlobs )
2683 // broadcast INITIALIZE_USERFORM script event before the dialog is created
2684 Reference< script::vba::XVBACompatibility > xVBACompat( getVBACompatibility( m_xModel ), uno::UNO_SET_THROW );
2685 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::INITIALIZE_USERFORM, GetName() );
2687 uno::Reference< lang::XMultiServiceFactory > xVBAFactory( pGlobs->getUnoAny(), uno::UNO_QUERY_THROW );
2688 uno::Reference< lang::XMultiServiceFactory > xFactory = comphelper::getProcessServiceFactory();
2689 uno::Sequence< uno::Any > aArgs(1);
2690 aArgs[ 0 ] <<= m_xModel;
2691 OUString sDialogUrl( "vnd.sun.star.script:" );
2692 OUString sProjectName( "Standard" );
2696 Reference< beans::XPropertySet > xProps( m_xModel, UNO_QUERY_THROW );
2697 uno::Reference< script::vba::XVBACompatibility > xVBAMode( xProps->getPropertyValue( OUString( "BasicLibraries" ) ), uno::UNO_QUERY_THROW );
2698 sProjectName = xVBAMode->getProjectName();
2700 catch(const Exception& ) {}
2702 sDialogUrl = sDialogUrl + sProjectName + "." + GetName() + "?location=document";
2704 uno::Reference< awt::XDialogProvider > xProvider( xFactory->createInstanceWithArguments( OUString( "com.sun.star.awt.DialogProvider"), aArgs ), uno::UNO_QUERY_THROW );
2705 m_xDialog = xProvider->createDialog( sDialogUrl );
2707 // create vba api object
2708 aArgs.realloc( 4 );
2709 aArgs[ 0 ] = uno::Any();
2710 aArgs[ 1 ] <<= m_xDialog;
2711 aArgs[ 2 ] <<= m_xModel;
2712 aArgs[ 3 ] <<= rtl::OUString( GetParent()->GetName() );
2713 pDocObject = new SbUnoObject( GetName(), uno::makeAny( xVBAFactory->createInstanceWithArguments( rtl::OUString( "ooo.vba.msforms.UserForm"), aArgs ) ) );
2715 uno::Reference< lang::XComponent > xComponent( m_xDialog, uno::UNO_QUERY_THROW );
2717 // the dialog must be disposed at the end!
2718 StarBASIC* pParentBasic = NULL;
2719 SbxObject* pCurObject = this;
2722 SbxObject* pObjParent = pCurObject->GetParent();
2723 pParentBasic = PTR_CAST( StarBASIC, pObjParent );
2724 pCurObject = pObjParent;
2726 while( pParentBasic == NULL && pCurObject != NULL );
2728 OSL_ASSERT( pParentBasic != NULL );
2729 registerComponentToBeDisposedForBasic( xComponent, pParentBasic );
2731 // if old listener object exists, remove it from dialog and document model
2732 if( m_DialogListener.is() )
2733 m_DialogListener->removeListener();
2734 m_DialogListener.set( new FormObjEventListenerImpl( this, xComponent, m_xModel ) );
2736 triggerInitializeEvent();
2739 catch(const uno::Exception& )
2745 SbxVariable*
2746 SbUserFormModule::Find( const rtl::OUString& rName, SbxClassType t )
2748 if ( !pDocObject && !GetSbData()->bRunInit && GetSbData()->pInst )
2749 InitObject();
2750 return SbObjModule::Find( rName, t );
2753 SbProperty::SbProperty( const OUString& r, SbxDataType t, SbModule* p )
2754 : SbxProperty( r, t ), pMod( p )
2756 bInvalid = sal_False;
2759 SbProperty::~SbProperty()
2763 SbProcedureProperty::~SbProcedureProperty()
2766 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */