fdo#74697 Add Bluez 5 support for impress remote.
[LibreOffice.git] / basic / source / classes / sbxmod.cxx
blob0a1e338cbc8e5523cc1b473fa7ded3065ae2539d
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 <basic/sbuno.hxx>
29 #include "sbdiagnose.hxx"
30 #include "sb.hxx"
31 #include <sbjsmeth.hxx>
32 #include "sbjsmod.hxx"
33 #include "sbintern.hxx"
34 #include "image.hxx"
35 #include "opcodes.hxx"
36 #include "runtime.hxx"
37 #include "token.hxx"
38 #include "sbunoobj.hxx"
40 #include "sal/log.hxx"
42 #include <basic/basrdll.hxx>
43 #include <osl/mutex.hxx>
44 #include <basic/sbobjmod.hxx>
45 #include <basic/vbahelper.hxx>
46 #include <cppuhelper/implbase3.hxx>
47 #include <unotools/eventcfg.hxx>
48 #include <com/sun/star/frame/Desktop.hpp>
49 #include <com/sun/star/lang/XServiceInfo.hpp>
50 #include <com/sun/star/script/ModuleType.hpp>
51 #include <com/sun/star/script/vba/XVBACompatibility.hpp>
52 #include <com/sun/star/script/vba/VBAScriptEventId.hpp>
53 #include <com/sun/star/beans/XPropertySet.hpp>
54 #include <com/sun/star/document/XEventBroadcaster.hpp>
55 #include <com/sun/star/document/XEventListener.hpp>
57 using namespace com::sun::star;
59 #ifdef UNX
60 #include <sys/resource.h>
61 #endif
63 #include <stdio.h>
64 #include <com/sun/star/frame/XDesktop.hpp>
65 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
66 #include <comphelper/processfactory.hxx>
67 #include <map>
68 #include <com/sun/star/reflection/ProxyFactory.hpp>
69 #include <cppuhelper/implbase1.hxx>
70 #include <com/sun/star/uno/XAggregation.hpp>
71 #include <com/sun/star/script/XInvocation.hpp>
73 using namespace ::com::sun::star;
74 using namespace com::sun::star::lang;
75 using namespace com::sun::star::reflection;
76 using namespace com::sun::star::beans;
77 using namespace com::sun::star::script;
78 using namespace com::sun::star::uno;
80 #include <com/sun/star/script/XLibraryContainer.hpp>
81 #include <com/sun/star/awt/DialogProvider.hpp>
82 #include <com/sun/star/awt/XTopWindow.hpp>
83 #include <com/sun/star/awt/XWindow.hpp>
84 #include <com/sun/star/awt/XControl.hpp>
85 #include <comphelper/anytostring.hxx>
86 #include <ooo/vba/VbQueryClose.hpp>
88 typedef ::cppu::WeakImplHelper1< XInvocation > DocObjectWrapper_BASE;
89 typedef ::std::map< sal_Int16, Any, ::std::less< sal_Int16 > > OutParamMap;
91 class DocObjectWrapper : public DocObjectWrapper_BASE
93 Reference< XAggregation > m_xAggProxy;
94 Reference< XInvocation > m_xAggInv;
95 Reference< XTypeProvider > m_xAggregateTypeProv;
96 Sequence< Type > m_Types;
97 SbModule* m_pMod;
98 SbMethodRef getMethod( const OUString& aName ) throw (RuntimeException);
99 SbPropertyRef getProperty( const OUString& aName ) throw (RuntimeException);
100 OUString mName; // for debugging
102 public:
103 DocObjectWrapper( SbModule* pMod );
104 virtual ~DocObjectWrapper();
106 virtual void SAL_CALL acquire() throw();
107 virtual void SAL_CALL release() throw();
109 virtual Sequence< sal_Int8 > SAL_CALL getImplementationId() throw (RuntimeException)
111 if( !m_xAggregateTypeProv.is() )
112 throw RuntimeException();
113 return m_xAggregateTypeProv->getImplementationId();
116 virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection( ) throw (RuntimeException);
118 virtual Any SAL_CALL invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) throw (IllegalArgumentException, CannotConvertException, InvocationTargetException, RuntimeException);
119 virtual void SAL_CALL setValue( const OUString& aPropertyName, const Any& aValue ) throw (UnknownPropertyException, CannotConvertException, InvocationTargetException, RuntimeException);
120 virtual Any SAL_CALL getValue( const OUString& aPropertyName ) throw (UnknownPropertyException, RuntimeException);
121 virtual ::sal_Bool SAL_CALL hasMethod( const OUString& aName ) throw (RuntimeException);
122 virtual ::sal_Bool SAL_CALL hasProperty( const OUString& aName ) throw (RuntimeException);
123 virtual Any SAL_CALL queryInterface( const Type& aType ) throw ( RuntimeException );
125 virtual Sequence< Type > SAL_CALL getTypes() throw ( RuntimeException );
128 DocObjectWrapper::DocObjectWrapper( SbModule* pVar ) : m_pMod( pVar ), mName( pVar->GetName() )
130 SbObjModule* pMod = PTR_CAST(SbObjModule,pVar);
131 if ( pMod )
133 if ( pMod->GetModuleType() == ModuleType::DOCUMENT )
135 // Use proxy factory service to create aggregatable proxy.
136 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pMod->GetObject() );
137 Reference< XInterface > xIf;
138 if ( pUnoObj )
140 Any aObj = pUnoObj->getUnoAny();
141 aObj >>= xIf;
142 if ( xIf.is() )
144 m_xAggregateTypeProv.set( xIf, UNO_QUERY );
145 m_xAggInv.set( xIf, UNO_QUERY );
148 if ( xIf.is() )
152 Reference< XProxyFactory > xProxyFac = ProxyFactory::create( comphelper::getProcessComponentContext() );
153 m_xAggProxy = xProxyFac->createProxy( xIf );
155 catch(const Exception& )
157 SAL_WARN( "basic", "DocObjectWrapper::DocObjectWrapper: Caught exception!" );
161 if ( m_xAggProxy.is() )
163 osl_atomic_increment( &m_refCount );
165 /* i35609 - Fix crash on Solaris. The setDelegator call needs
166 to be in its own block to ensure that all temporary Reference
167 instances that are acquired during the call are released
168 before m_refCount is decremented again */
170 m_xAggProxy->setDelegator( static_cast< cppu::OWeakObject * >( this ) );
173 osl_atomic_decrement( &m_refCount );
179 void SAL_CALL
180 DocObjectWrapper::acquire() throw ()
182 osl_atomic_increment( &m_refCount );
183 SAL_INFO("basic","DocObjectWrapper::acquire("<< OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr() << ") 0x" << this << " refcount is now " << m_refCount );
185 void SAL_CALL
186 DocObjectWrapper::release() throw ()
188 if ( osl_atomic_decrement( &m_refCount ) == 0 )
190 SAL_INFO("basic","DocObjectWrapper::release("<< OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr() << ") 0x" << this << " refcount is now " << m_refCount );
191 delete this;
193 else
195 SAL_INFO("basic","DocObjectWrapper::release("<< OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr() << ") 0x" << this << " refcount is now " << m_refCount );
199 DocObjectWrapper::~DocObjectWrapper()
203 Sequence< Type > SAL_CALL DocObjectWrapper::getTypes()
204 throw ( RuntimeException )
206 if ( m_Types.getLength() == 0 )
208 Sequence< Type > sTypes;
209 if ( m_xAggregateTypeProv.is() )
211 sTypes = m_xAggregateTypeProv->getTypes();
213 m_Types.realloc( sTypes.getLength() + 1 );
214 Type* pPtr = m_Types.getArray();
215 for ( int i=0; i<m_Types.getLength(); ++i, ++pPtr )
217 if ( i == 0 )
219 *pPtr = XInvocation::static_type( NULL );
221 else
223 *pPtr = sTypes[ i - 1 ];
227 return m_Types;
230 Reference< XIntrospectionAccess > SAL_CALL
231 DocObjectWrapper::getIntrospection( ) throw (RuntimeException)
233 return NULL;
236 Any SAL_CALL
237 DocObjectWrapper::invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) throw (IllegalArgumentException, CannotConvertException, InvocationTargetException, RuntimeException)
239 if ( m_xAggInv.is() && m_xAggInv->hasMethod( aFunctionName ) )
240 return m_xAggInv->invoke( aFunctionName, aParams, aOutParamIndex, aOutParam );
241 SbMethodRef pMethod = getMethod( aFunctionName );
242 if ( !pMethod )
243 throw RuntimeException();
244 // check number of parameters
245 sal_Int32 nParamsCount = aParams.getLength();
246 SbxInfo* pInfo = pMethod->GetInfo();
247 if ( pInfo )
249 sal_Int32 nSbxOptional = 0;
250 sal_uInt16 n = 1;
251 for ( const SbxParamInfo* pParamInfo = pInfo->GetParam( n ); pParamInfo; pParamInfo = pInfo->GetParam( ++n ) )
253 if ( ( pParamInfo->nFlags & SBX_OPTIONAL ) != 0 )
254 ++nSbxOptional;
255 else
256 nSbxOptional = 0;
258 sal_Int32 nSbxCount = n - 1;
259 if ( nParamsCount < nSbxCount - nSbxOptional )
261 throw RuntimeException( "wrong number of parameters!", Reference< XInterface >() );
264 // set parameters
265 SbxArrayRef xSbxParams;
266 if ( nParamsCount > 0 )
268 xSbxParams = new SbxArray;
269 const Any* pParams = aParams.getConstArray();
270 for ( sal_Int32 i = 0; i < nParamsCount; ++i )
272 SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
273 unoToSbxValue( static_cast< SbxVariable* >( xSbxVar ), pParams[i] );
274 xSbxParams->Put( xSbxVar, static_cast< sal_uInt16 >( i ) + 1 );
276 // Enable passing by ref
277 if ( xSbxVar->GetType() != SbxVARIANT )
278 xSbxVar->SetFlag( SBX_FIXED );
281 if ( xSbxParams.Is() )
282 pMethod->SetParameters( xSbxParams );
284 // call method
285 SbxVariableRef xReturn = new SbxVariable;
287 pMethod->Call( xReturn );
288 Any aReturn;
289 // get output parameters
290 if ( xSbxParams.Is() )
292 SbxInfo* pInfo_ = pMethod->GetInfo();
293 if ( pInfo_ )
295 OutParamMap aOutParamMap;
296 for ( sal_uInt16 n = 1, nCount = xSbxParams->Count(); n < nCount; ++n )
298 const SbxParamInfo* pParamInfo = pInfo_->GetParam( n );
299 if ( pParamInfo && ( pParamInfo->eType & SbxBYREF ) != 0 )
301 SbxVariable* pVar = xSbxParams->Get( n );
302 if ( pVar )
304 SbxVariableRef xVar = pVar;
305 aOutParamMap.insert( OutParamMap::value_type( n - 1, sbxToUnoValue( xVar ) ) );
309 sal_Int32 nOutParamCount = aOutParamMap.size();
310 aOutParamIndex.realloc( nOutParamCount );
311 aOutParam.realloc( nOutParamCount );
312 sal_Int16* pOutParamIndex = aOutParamIndex.getArray();
313 Any* pOutParam = aOutParam.getArray();
314 for ( OutParamMap::iterator aIt = aOutParamMap.begin(); aIt != aOutParamMap.end(); ++aIt, ++pOutParamIndex, ++pOutParam )
316 *pOutParamIndex = aIt->first;
317 *pOutParam = aIt->second;
322 // get return value
323 aReturn = sbxToUnoValue( xReturn );
325 pMethod->SetParameters( NULL );
327 return aReturn;
330 void SAL_CALL
331 DocObjectWrapper::setValue( const OUString& aPropertyName, const Any& aValue ) throw (UnknownPropertyException, CannotConvertException, InvocationTargetException, RuntimeException)
333 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
334 return m_xAggInv->setValue( aPropertyName, aValue );
336 SbPropertyRef pProperty = getProperty( aPropertyName );
337 if ( !pProperty.Is() )
338 throw UnknownPropertyException();
339 unoToSbxValue( (SbxVariable*) pProperty, aValue );
342 Any SAL_CALL
343 DocObjectWrapper::getValue( const OUString& aPropertyName ) throw (UnknownPropertyException, RuntimeException)
345 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
346 return m_xAggInv->getValue( aPropertyName );
348 SbPropertyRef pProperty = getProperty( aPropertyName );
349 if ( !pProperty.Is() )
350 throw UnknownPropertyException();
352 SbxVariable* pProp = ( SbxVariable* ) pProperty;
353 if ( pProp->GetType() == SbxEMPTY )
354 pProperty->Broadcast( SBX_HINT_DATAWANTED );
356 Any aRet = sbxToUnoValue( pProp );
357 return aRet;
360 ::sal_Bool SAL_CALL
361 DocObjectWrapper::hasMethod( const OUString& aName ) throw (RuntimeException)
363 if ( m_xAggInv.is() && m_xAggInv->hasMethod( aName ) )
364 return sal_True;
365 return getMethod( aName ).Is();
368 ::sal_Bool SAL_CALL
369 DocObjectWrapper::hasProperty( const OUString& aName ) throw (RuntimeException)
371 sal_Bool bRes = sal_False;
372 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aName ) )
373 bRes = sal_True;
374 else bRes = getProperty( aName ).Is();
375 return bRes;
378 Any SAL_CALL DocObjectWrapper::queryInterface( const Type& aType )
379 throw ( RuntimeException )
381 Any aRet = DocObjectWrapper_BASE::queryInterface( aType );
382 if ( aRet.hasValue() )
383 return aRet;
384 else if ( m_xAggProxy.is() )
385 aRet = m_xAggProxy->queryAggregation( aType );
386 return aRet;
389 SbMethodRef DocObjectWrapper::getMethod( const OUString& aName ) throw (RuntimeException)
391 SbMethodRef pMethod = NULL;
392 if ( m_pMod )
394 sal_uInt16 nSaveFlgs = m_pMod->GetFlags();
395 // Limit search to this module
396 m_pMod->ResetFlag( SBX_GBLSEARCH );
397 pMethod = (SbMethod*) m_pMod->SbModule::Find( aName, SbxCLASS_METHOD );
398 m_pMod->SetFlags( nSaveFlgs );
401 return pMethod;
404 SbPropertyRef DocObjectWrapper::getProperty( const OUString& aName ) throw (RuntimeException)
406 SbPropertyRef pProperty = NULL;
407 if ( m_pMod )
409 sal_uInt16 nSaveFlgs = m_pMod->GetFlags();
410 // Limit search to this module.
411 m_pMod->ResetFlag( SBX_GBLSEARCH );
412 pProperty = (SbProperty*)m_pMod->SbModule::Find( aName, SbxCLASS_PROPERTY );
413 m_pMod->SetFlag( nSaveFlgs );
416 return pProperty;
419 TYPEINIT1(SbModule,SbxObject)
420 TYPEINIT1(SbMethod,SbxMethod)
421 TYPEINIT1(SbProperty,SbxProperty)
422 TYPEINIT1(SbProcedureProperty,SbxProperty)
423 TYPEINIT1(SbJScriptModule,SbModule)
424 TYPEINIT1(SbJScriptMethod,SbMethod)
425 TYPEINIT1(SbObjModule,SbModule)
426 TYPEINIT1(SbUserFormModule,SbObjModule)
428 uno::Reference< frame::XModel > getDocumentModel( StarBASIC* pb )
430 uno::Reference< frame::XModel > xModel;
431 if( pb && pb->IsDocBasic() )
433 uno::Any aDoc;
434 if( pb->GetUNOConstant( "ThisComponent", aDoc ) )
435 xModel.set( aDoc, uno::UNO_QUERY );
437 return xModel;
440 uno::Reference< vba::XVBACompatibility > getVBACompatibility( const uno::Reference< frame::XModel >& rxModel )
442 uno::Reference< vba::XVBACompatibility > xVBACompat;
445 uno::Reference< beans::XPropertySet > xModelProps( rxModel, uno::UNO_QUERY_THROW );
446 xVBACompat.set( xModelProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY );
448 catch(const uno::Exception& )
451 return xVBACompat;
454 bool getDefaultVBAMode( StarBASIC* pb )
456 uno::Reference< vba::XVBACompatibility > xVBACompat = getVBACompatibility( getDocumentModel( pb ) );
457 return xVBACompat.is() && xVBACompat->getVBACompatibilityMode();
460 class AsyncQuitHandler
462 AsyncQuitHandler() {}
463 AsyncQuitHandler( const AsyncQuitHandler&);
464 public:
465 static AsyncQuitHandler& instance()
467 static AsyncQuitHandler dInst;
468 return dInst;
471 void QuitApplication()
473 uno::Reference< frame::XDesktop2 > xDeskTop = frame::Desktop::create( comphelper::getProcessComponentContext() );
474 xDeskTop->terminate();
476 DECL_LINK( OnAsyncQuit, void* );
479 IMPL_LINK( AsyncQuitHandler, OnAsyncQuit, void*, /*pNull*/ )
481 QuitApplication();
482 return 0L;
485 // A Basic module has set EXTSEARCH, so that the elements, that the modul contains,
486 // could be found from other module.
488 SbModule::SbModule( const OUString& rName, sal_Bool bVBACompat )
489 : SbxObject( "StarBASICModule" ),
490 pImage( NULL ), pBreaks( NULL ), pClassData( NULL ), mbVBACompat( bVBACompat ), pDocObject( NULL ), bIsProxyModule( false )
492 SetName( rName );
493 SetFlag( SBX_EXTSEARCH | SBX_GBLSEARCH );
494 SetModuleType( script::ModuleType::NORMAL );
496 // #i92642: Set name property to intitial name
497 SbxVariable* pNameProp = pProps->Find( "Name", SbxCLASS_PROPERTY );
498 if( pNameProp != NULL )
500 pNameProp->PutString( GetName() );
504 SbModule::~SbModule()
506 SAL_INFO("basic","Module named " << OUStringToOString( GetName(), RTL_TEXTENCODING_UTF8 ).getStr() << " is destructing");
507 delete pImage;
508 delete pBreaks;
509 delete pClassData;
510 mxWrapper = NULL;
513 uno::Reference< script::XInvocation >
514 SbModule::GetUnoModule()
516 if ( !mxWrapper.is() )
517 mxWrapper = new DocObjectWrapper( this );
519 SAL_INFO("basic","Module named " << OUStringToOString( GetName(), RTL_TEXTENCODING_UTF8 ).getStr() << " returning wrapper mxWrapper (0x" << mxWrapper.get() <<")" );
520 return mxWrapper;
523 sal_Bool SbModule::IsCompiled() const
525 return sal_Bool( pImage != 0 );
528 const SbxObject* SbModule::FindType( OUString aTypeName ) const
530 return pImage ? pImage->FindType( aTypeName ) : NULL;
534 // From the code generator: deletion of images and the oposite of validation for entries
536 void SbModule::StartDefinitions()
538 delete pImage; pImage = NULL;
539 if( pClassData )
540 pClassData->clear();
542 // methods and properties persist, but they are invalid;
543 // at least are the information under certain conditions clogged
544 sal_uInt16 i;
545 for( i = 0; i < pMethods->Count(); i++ )
547 SbMethod* p = PTR_CAST(SbMethod,pMethods->Get( i ) );
548 if( p )
549 p->bInvalid = sal_True;
551 for( i = 0; i < pProps->Count(); )
553 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
554 if( p )
555 pProps->Remove( i );
556 else
557 i++;
561 // request/create method
563 SbMethod* SbModule::GetMethod( const OUString& rName, SbxDataType t )
565 SbxVariable* p = pMethods->Find( rName, SbxCLASS_METHOD );
566 SbMethod* pMeth = p ? PTR_CAST(SbMethod,p) : NULL;
567 if( p && !pMeth )
569 pMethods->Remove( p );
571 if( !pMeth )
573 pMeth = new SbMethod( rName, t, this );
574 pMeth->SetParent( this );
575 pMeth->SetFlags( SBX_READ );
576 pMethods->Put( pMeth, pMethods->Count() );
577 StartListening( pMeth->GetBroadcaster(), sal_True );
579 // The method is per default valid, because it could be
580 // created from the compiler (code generator) as well.
581 pMeth->bInvalid = sal_False;
582 pMeth->ResetFlag( SBX_FIXED );
583 pMeth->SetFlag( SBX_WRITE );
584 pMeth->SetType( t );
585 pMeth->ResetFlag( SBX_WRITE );
586 if( t != SbxVARIANT )
588 pMeth->SetFlag( SBX_FIXED );
590 return pMeth;
593 // request/create property
595 SbProperty* SbModule::GetProperty( const OUString& rName, SbxDataType t )
597 SbxVariable* p = pProps->Find( rName, SbxCLASS_PROPERTY );
598 SbProperty* pProp = p ? PTR_CAST(SbProperty,p) : NULL;
599 if( p && !pProp )
601 pProps->Remove( p );
603 if( !pProp )
605 pProp = new SbProperty( rName, t, this );
606 pProp->SetFlag( SBX_READWRITE );
607 pProp->SetParent( this );
608 pProps->Put( pProp, pProps->Count() );
609 StartListening( pProp->GetBroadcaster(), sal_True );
611 return pProp;
614 SbProcedureProperty* SbModule::GetProcedureProperty( const OUString& rName, SbxDataType t )
616 SbxVariable* p = pProps->Find( rName, SbxCLASS_PROPERTY );
617 SbProcedureProperty* pProp = p ? PTR_CAST(SbProcedureProperty,p) : NULL;
618 if( p && !pProp )
620 pProps->Remove( p );
622 if( !pProp )
624 pProp = new SbProcedureProperty( rName, t );
625 pProp->SetFlag( SBX_READWRITE );
626 pProp->SetParent( this );
627 pProps->Put( pProp, pProps->Count() );
628 StartListening( pProp->GetBroadcaster(), sal_True );
630 return pProp;
633 SbIfaceMapperMethod* SbModule::GetIfaceMapperMethod( const OUString& rName, SbMethod* pImplMeth )
635 SbxVariable* p = pMethods->Find( rName, SbxCLASS_METHOD );
636 SbIfaceMapperMethod* pMapperMethod = p ? PTR_CAST(SbIfaceMapperMethod,p) : NULL;
637 if( p && !pMapperMethod )
639 pMethods->Remove( p );
641 if( !pMapperMethod )
643 pMapperMethod = new SbIfaceMapperMethod( rName, pImplMeth );
644 pMapperMethod->SetParent( this );
645 pMapperMethod->SetFlags( SBX_READ );
646 pMethods->Put( pMapperMethod, pMethods->Count() );
648 pMapperMethod->bInvalid = sal_False;
649 return pMapperMethod;
652 SbIfaceMapperMethod::~SbIfaceMapperMethod()
656 TYPEINIT1(SbIfaceMapperMethod,SbMethod)
659 // From the code generator: remove invalid entries
661 void SbModule::EndDefinitions( sal_Bool bNewState )
663 for( sal_uInt16 i = 0; i < pMethods->Count(); )
665 SbMethod* p = PTR_CAST(SbMethod,pMethods->Get( i ) );
666 if( p )
668 if( p->bInvalid )
669 pMethods->Remove( p );
670 else
672 p->bInvalid = bNewState;
673 i++;
676 else
677 i++;
679 SetModified( sal_True );
682 void SbModule::Clear()
684 delete pImage; pImage = NULL;
685 if( pClassData )
686 pClassData->clear();
687 SbxObject::Clear();
691 SbxVariable* SbModule::Find( const OUString& rName, SbxClassType t )
693 // make sure a search in an uninstatiated class module will fail
694 SbxVariable* pRes = SbxObject::Find( rName, t );
695 if ( bIsProxyModule && !GetSbData()->bRunInit )
697 return NULL;
699 if( !pRes && pImage )
701 SbiInstance* pInst = GetSbData()->pInst;
702 if( pInst && pInst->IsCompatibility() )
704 // Put enum types as objects into module,
705 // allows MyEnum.First notation
706 SbxArrayRef xArray = pImage->GetEnums();
707 if( xArray.Is() )
709 SbxVariable* pEnumVar = xArray->Find( rName, SbxCLASS_DONTCARE );
710 SbxObject* pEnumObject = PTR_CAST( SbxObject, pEnumVar );
711 if( pEnumObject )
713 bool bPrivate = pEnumObject->IsSet( SBX_PRIVATE );
714 OUString aEnumName = pEnumObject->GetName();
716 pRes = new SbxVariable( SbxOBJECT );
717 pRes->SetName( aEnumName );
718 pRes->SetParent( this );
719 pRes->SetFlag( SBX_READ );
720 if( bPrivate )
722 pRes->SetFlag( SBX_PRIVATE );
724 pRes->PutObject( pEnumObject );
729 return pRes;
732 const OUString& SbModule::GetSource32() const
734 return aOUSource;
737 const OUString& SbModule::GetSource() const
739 static OUString aRetStr;
740 aRetStr = aOUSource;
741 return aRetStr;
744 // Parent and BASIC are one!
746 void SbModule::SetParent( SbxObject* p )
748 pParent = p;
751 void SbModule::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
752 const SfxHint& rHint, const TypeId& rHintType )
754 const SbxHint* pHint = PTR_CAST(SbxHint,&rHint);
755 if( pHint )
757 SbxVariable* pVar = pHint->GetVar();
758 SbProperty* pProp = PTR_CAST(SbProperty,pVar);
759 SbMethod* pMeth = PTR_CAST(SbMethod,pVar);
760 SbProcedureProperty* pProcProperty = PTR_CAST( SbProcedureProperty, pVar );
761 if( pProcProperty )
764 if( pHint->GetId() == SBX_HINT_DATAWANTED )
766 OUString aProcName("Property Get ");
767 aProcName += pProcProperty->GetName();
769 SbxVariable* pMethVar = Find( aProcName, SbxCLASS_METHOD );
770 if( pMethVar )
772 SbxValues aVals;
773 aVals.eType = SbxVARIANT;
775 SbxArray* pArg = pVar->GetParameters();
776 sal_uInt16 nVarParCount = (pArg != NULL) ? pArg->Count() : 0;
777 if( nVarParCount > 1 )
779 SbxArrayRef xMethParameters = new SbxArray;
780 xMethParameters->Put( pMethVar, 0 ); // Method as parameter 0
781 for( sal_uInt16 i = 1 ; i < nVarParCount ; ++i )
783 SbxVariable* pPar = pArg->Get( i );
784 xMethParameters->Put( pPar, i );
787 pMethVar->SetParameters( xMethParameters );
788 pMethVar->Get( aVals );
789 pMethVar->SetParameters( NULL );
791 else
793 pMethVar->Get( aVals );
796 pVar->Put( aVals );
799 else if( pHint->GetId() == SBX_HINT_DATACHANGED )
801 SbxVariable* pMethVar = NULL;
803 bool bSet = pProcProperty->isSet();
804 if( bSet )
806 pProcProperty->setSet( false );
808 OUString aProcName("Property Set ");
809 aProcName += pProcProperty->GetName();
810 pMethVar = Find( aProcName, SbxCLASS_METHOD );
812 if( !pMethVar ) // Let
814 OUString aProcName("Property Let " );
815 aProcName += pProcProperty->GetName();
816 pMethVar = Find( aProcName, SbxCLASS_METHOD );
819 if( pMethVar )
821 // Setup parameters
822 SbxArrayRef xArray = new SbxArray;
823 xArray->Put( pMethVar, 0 ); // Method as parameter 0
824 xArray->Put( pVar, 1 );
825 pMethVar->SetParameters( xArray );
827 SbxValues aVals;
828 pMethVar->Get( aVals );
829 pMethVar->SetParameters( NULL );
833 if( pProp )
835 if( pProp->GetModule() != this )
836 SetError( SbxERR_BAD_ACTION );
838 else if( pMeth )
840 if( pHint->GetId() == SBX_HINT_DATAWANTED )
842 if( pMeth->bInvalid && !Compile() )
844 // auto compile has not worked!
845 StarBASIC::Error( SbERR_BAD_PROP_VALUE );
847 else
849 // Call of a subprogram
850 SbModule* pOld = GetSbData()->pMod;
851 GetSbData()->pMod = this;
852 Run( (SbMethod*) pVar );
853 GetSbData()->pMod = pOld;
857 else
859 // #i92642: Special handling for name property to avoid
860 // side effects when using name as variable implicitely
861 bool bForwardToSbxObject = true;
863 sal_uIntPtr nId = pHint->GetId();
864 if( (nId == SBX_HINT_DATAWANTED || nId == SBX_HINT_DATACHANGED) &&
865 pVar->GetName().equalsIgnoreAsciiCase( "name" ) )
867 bForwardToSbxObject = false;
869 if( bForwardToSbxObject )
871 SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType );
877 // The setting of the source makes the image invalid
878 // and scans the method definitions newly in
880 void SbModule::SetSource( const OUString& r )
882 SetSource32( r );
885 void SbModule::SetSource32( const OUString& r )
887 // Default basic mode to library container mode, but.. allow Option VBASupport 0/1 override
888 SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) );
889 aOUSource = r;
890 StartDefinitions();
891 SbiTokenizer aTok( r );
892 aTok.SetCompatible( IsVBACompat() );
893 while( !aTok.IsEof() )
895 SbiToken eEndTok = NIL;
897 // Searching for SUB or FUNCTION
898 SbiToken eLastTok = NIL;
899 while( !aTok.IsEof() )
901 // #32385: not by declare
902 SbiToken eCurTok = aTok.Next();
903 if( eLastTok != DECLARE )
905 if( eCurTok == SUB )
907 eEndTok = ENDSUB; break;
909 if( eCurTok == FUNCTION )
911 eEndTok = ENDFUNC; break;
913 if( eCurTok == PROPERTY )
915 eEndTok = ENDPROPERTY; break;
917 if( eCurTok == OPTION )
919 eCurTok = aTok.Next();
920 if( eCurTok == COMPATIBLE )
922 aTok.SetCompatible( true );
924 else if ( ( eCurTok == VBASUPPORT ) && ( aTok.Next() == NUMBER ) )
926 sal_Bool bIsVBA = ( aTok.GetDbl()== 1 );
927 SetVBACompat( bIsVBA );
928 aTok.SetCompatible( bIsVBA );
932 eLastTok = eCurTok;
934 // Definition of the method
935 SbMethod* pMeth = NULL;
936 if( eEndTok != NIL )
938 sal_uInt16 nLine1 = aTok.GetLine();
939 if( aTok.Next() == SYMBOL )
941 OUString aName_( aTok.GetSym() );
942 SbxDataType t = aTok.GetType();
943 if( t == SbxVARIANT && eEndTok == ENDSUB )
945 t = SbxVOID;
947 pMeth = GetMethod( aName_, t );
948 pMeth->nLine1 = pMeth->nLine2 = nLine1;
949 // The method is for a start VALID
950 pMeth->bInvalid = sal_False;
952 else
954 eEndTok = NIL;
957 // Skip up to END SUB/END FUNCTION
958 if( eEndTok != NIL )
960 while( !aTok.IsEof() )
962 if( aTok.Next() == eEndTok )
964 pMeth->nLine2 = aTok.GetLine();
965 break;
968 if( aTok.IsEof() )
970 pMeth->nLine2 = aTok.GetLine();
974 EndDefinitions( sal_True );
977 // Broadcast of a hint to all Basics
979 static void _SendHint( SbxObject* pObj, sal_uIntPtr nId, SbMethod* p )
981 // Self a BASIC?
982 if( pObj->IsA( TYPE(StarBASIC) ) && pObj->IsBroadcaster() )
983 pObj->GetBroadcaster().Broadcast( SbxHint( nId, p ) );
984 // Then ask for the subobjects
985 SbxArray* pObjs = pObj->GetObjects();
986 for( sal_uInt16 i = 0; i < pObjs->Count(); i++ )
988 SbxVariable* pVar = pObjs->Get( i );
989 if( pVar->IsA( TYPE(SbxObject) ) )
990 _SendHint( PTR_CAST(SbxObject,pVar), nId, p );
994 static void SendHint( SbxObject* pObj, sal_uIntPtr nId, SbMethod* p )
996 while( pObj->GetParent() )
997 pObj = pObj->GetParent();
998 _SendHint( pObj, nId, p );
1001 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1002 // at the end of the program, so that nothing were helt.
1003 void ClearUnoObjectsInRTL_Impl_Rek( StarBASIC* pBasic )
1005 // delete the return value of CreateUnoService
1006 static OUString aName("CreateUnoService");
1007 SbxVariable* pVar = pBasic->GetRtl()->Find( aName, SbxCLASS_METHOD );
1008 if( pVar )
1010 pVar->SbxValue::Clear();
1012 // delete the return value of CreateUnoDialog
1013 static OUString aName2("CreateUnoDialog");
1014 pVar = pBasic->GetRtl()->Find( aName2, SbxCLASS_METHOD );
1015 if( pVar )
1017 pVar->SbxValue::Clear();
1019 // delete the return value of CDec
1020 static OUString aName3("CDec");
1021 pVar = pBasic->GetRtl()->Find( aName3, SbxCLASS_METHOD );
1022 if( pVar )
1024 pVar->SbxValue::Clear();
1026 // delete return value of CreateObject
1027 static OUString aName4("CreateObject");
1028 pVar = pBasic->GetRtl()->Find( aName4, SbxCLASS_METHOD );
1029 if( pVar )
1031 pVar->SbxValue::Clear();
1033 // Go over all Sub-Basics
1034 SbxArray* pObjs = pBasic->GetObjects();
1035 sal_uInt16 nCount = pObjs->Count();
1036 for( sal_uInt16 i = 0 ; i < nCount ; i++ )
1038 SbxVariable* pObjVar = pObjs->Get( i );
1039 StarBASIC* pSubBasic = PTR_CAST( StarBASIC, pObjVar );
1040 if( pSubBasic )
1042 ClearUnoObjectsInRTL_Impl_Rek( pSubBasic );
1047 void ClearUnoObjectsInRTL_Impl( StarBASIC* pBasic )
1049 // #67781 Delete return values of the Uno-methods
1050 clearUnoMethods();
1051 clearUnoServiceCtors();
1053 ClearUnoObjectsInRTL_Impl_Rek( pBasic );
1055 // Search for the topmost Basic
1056 SbxObject* p = pBasic;
1057 while( p->GetParent() )
1058 p = p->GetParent();
1059 if( ((StarBASIC*)p) != pBasic )
1060 ClearUnoObjectsInRTL_Impl_Rek( (StarBASIC*)p );
1063 bool SbModule::IsVBACompat() const
1065 return mbVBACompat;
1068 void SbModule::SetVBACompat( bool bCompat )
1070 if( mbVBACompat != bCompat )
1072 mbVBACompat = bCompat;
1073 // initialize VBA document API
1074 if( mbVBACompat ) try
1076 StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
1077 uno::Reference< lang::XMultiServiceFactory > xFactory( getDocumentModel( pBasic ), uno::UNO_QUERY_THROW );
1078 xFactory->createInstance( "ooo.vba.VBAGlobals" );
1080 catch( Exception& )
1086 // Run a Basic-subprogram
1087 sal_uInt16 SbModule::Run( SbMethod* pMeth )
1089 SAL_INFO("basic","About to run " << OUStringToOString( pMeth->GetName(), RTL_TEXTENCODING_UTF8 ).getStr() << ", vba compatmode is " << mbVBACompat );
1090 static sal_uInt16 nMaxCallLevel = 0;
1092 sal_uInt16 nRes = 0;
1093 bool bDelInst = ( GetSbData()->pInst == NULL );
1094 bool bQuit = false;
1095 StarBASICRef xBasic;
1096 uno::Reference< frame::XModel > xModel;
1097 uno::Reference< script::vba::XVBACompatibility > xVBACompat;
1098 if( bDelInst )
1100 // #32779: Hold Basic during the execution
1101 xBasic = (StarBASIC*) GetParent();
1103 GetSbData()->pInst = new SbiInstance( (StarBASIC*) GetParent() );
1105 /* If a VBA script in a document is started, get the VBA compatibility
1106 interface from the document Basic library container, and notify all
1107 VBA script listeners about the started script. */
1108 if( mbVBACompat )
1110 StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
1111 if( pBasic && pBasic->IsDocBasic() ) try
1113 xModel.set( getDocumentModel( pBasic ), uno::UNO_SET_THROW );
1114 xVBACompat.set( getVBACompatibility( xModel ), uno::UNO_SET_THROW );
1115 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STARTED, GetName() );
1117 catch(const uno::Exception& )
1122 // Launcher problem
1123 // i80726 The Find below will genarate an error in Testtool so we reset it unless there was one before already
1124 sal_Bool bWasError = SbxBase::GetError() != 0;
1125 SbxVariable* pMSOMacroRuntimeLibVar = Find( "Launcher", SbxCLASS_OBJECT );
1126 if ( !bWasError && (SbxBase::GetError() == SbxERR_PROC_UNDEFINED) )
1127 SbxBase::ResetError();
1128 if( pMSOMacroRuntimeLibVar )
1130 StarBASIC* pMSOMacroRuntimeLib = PTR_CAST(StarBASIC,pMSOMacroRuntimeLibVar);
1131 if( pMSOMacroRuntimeLib )
1133 sal_uInt16 nGblFlag = pMSOMacroRuntimeLib->GetFlags() & SBX_GBLSEARCH;
1134 pMSOMacroRuntimeLib->ResetFlag( SBX_GBLSEARCH );
1135 SbxVariable* pAppSymbol = pMSOMacroRuntimeLib->Find( "Application", SbxCLASS_METHOD );
1136 pMSOMacroRuntimeLib->SetFlag( nGblFlag );
1137 if( pAppSymbol )
1139 pMSOMacroRuntimeLib->SetFlag( SBX_EXTSEARCH ); // Could have been disabled before
1140 GetSbData()->pMSOMacroRuntimLib = pMSOMacroRuntimeLib;
1145 if( nMaxCallLevel == 0 )
1147 #ifdef UNX
1148 struct rlimit rl;
1149 getrlimit ( RLIMIT_STACK, &rl );
1150 #endif
1151 #if defined LINUX
1152 // Empiric value, 900 = needed bytes/Basic call level
1153 // for Linux including 10% safety margin
1154 nMaxCallLevel = rl.rlim_cur / 900;
1155 #elif defined SOLARIS
1156 // Empiric value, 1650 = needed bytes/Basic call level
1157 // for Solaris including 10% safety margin
1158 nMaxCallLevel = rl.rlim_cur / 1650;
1159 #elif defined WIN32
1160 nMaxCallLevel = 5800;
1161 #else
1162 nMaxCallLevel = MAXRECURSION;
1163 #endif
1167 // Recursion to deep?
1168 if( ++GetSbData()->pInst->nCallLvl <= nMaxCallLevel )
1170 // Define a globale variable in all Mods
1171 GlobalRunInit( /* bBasicStart = */ bDelInst );
1173 // Appeared a compiler error? Then we don't launch
1174 if( !GetSbData()->bGlobalInitErr )
1176 if( bDelInst )
1178 SendHint( GetParent(), SBX_HINT_BASICSTART, pMeth );
1180 // 1996-10-16: #31460 New concept for StepInto/Over/Out
1181 // For an explanation see runtime.cxx at SbiInstance::CalcBreakCallLevel()
1182 // Identify the BreakCallLevel
1183 GetSbData()->pInst->CalcBreakCallLevel( pMeth->GetDebugFlags() );
1186 SbModule* pOldMod = GetSbData()->pMod;
1187 GetSbData()->pMod = this;
1188 SbiRuntime* pRt = new SbiRuntime( this, pMeth, pMeth->nStart );
1190 pRt->pNext = GetSbData()->pInst->pRun;
1191 if( pRt->pNext )
1192 pRt->pNext->block();
1193 GetSbData()->pInst->pRun = pRt;
1194 if ( mbVBACompat )
1196 GetSbData()->pInst->EnableCompatibility( sal_True );
1198 while( pRt->Step() ) {}
1199 if( pRt->pNext )
1200 pRt->pNext->unblock();
1202 // #63710 It can happen by an another thread handling at events,
1203 // that the show call returns to an dialog (by closing the
1204 // dialog per UI), before a by an event triggered further call returned,
1205 // which stands in Basic more top in the stack and that had been run on
1206 // a Basic-Breakpoint. Then would the instance below destroyed. And if the Basic,
1207 // that stand still in the call, further runs, there is a GPF.
1208 // Thus here had to be wait until the other call comes back.
1209 if( bDelInst )
1211 // Compare here with 1 instead of 0, because before nCallLvl--
1212 while( GetSbData()->pInst->nCallLvl != 1 )
1213 GetpApp()->Yield();
1216 nRes = sal_True;
1217 GetSbData()->pInst->pRun = pRt->pNext;
1218 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1220 // Exist an higher-ranking runtime instance?
1221 // Then take over SbDEBUG_BREAK, if set
1222 SbiRuntime* pRtNext = pRt->pNext;
1223 if( pRtNext && (pRt->GetDebugFlags() & SbDEBUG_BREAK) )
1224 pRtNext->SetDebugFlags( SbDEBUG_BREAK );
1226 delete pRt;
1227 GetSbData()->pMod = pOldMod;
1228 if( bDelInst )
1230 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1231 // at the end of the program, so that nothing were helt.
1232 ClearUnoObjectsInRTL_Impl( xBasic );
1234 clearNativeObjectWrapperVector();
1236 SAL_WARN_IF(GetSbData()->pInst->nCallLvl != 0,"basic","BASIC-Call-Level > 0");
1237 delete GetSbData()->pInst, GetSbData()->pInst = NULL, bDelInst = false;
1239 // #i30690
1240 SolarMutexGuard aSolarGuard;
1241 SendHint( GetParent(), SBX_HINT_BASICSTOP, pMeth );
1243 GlobalRunDeInit();
1245 #ifdef DBG_UTIL
1246 ResetCapturedAssertions();
1247 #endif
1249 if( xVBACompat.is() )
1251 // notify all VBA script listeners about the stopped script
1254 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STOPPED, GetName() );
1256 catch(const uno::Exception& )
1259 // VBA always ensures screenupdating is enabled after completing
1260 ::basic::vba::lockControllersOfAllDocuments( xModel, sal_False );
1261 ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, sal_True );
1264 #ifdef DBG_TRACE_BASIC
1265 dbg_DeInitTrace();
1266 #endif
1269 else
1270 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1272 else
1274 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1275 StarBASIC::FatalError( SbERR_STACK_OVERFLOW );
1278 StarBASIC* pBasic = PTR_CAST(StarBASIC,GetParent());
1279 if( bDelInst )
1281 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1282 // the end of the program, so that nothing were helt.
1283 ClearUnoObjectsInRTL_Impl( xBasic );
1285 delete GetSbData()->pInst;
1286 GetSbData()->pInst = NULL;
1288 if ( pBasic && pBasic->IsDocBasic() && pBasic->IsQuitApplication() && !GetSbData()->pInst )
1289 bQuit = true;
1290 if ( bQuit )
1292 Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ), NULL );
1295 return nRes;
1298 // Execute of the init method of a module after the loading
1299 // or the compilation
1301 void SbModule::RunInit()
1303 if( pImage
1304 && !pImage->bInit
1305 && pImage->GetFlag( SBIMG_INITCODE ) )
1307 // Set flag, so that RunInit get activ (Testtool)
1308 GetSbData()->bRunInit = true;
1310 SbModule* pOldMod = GetSbData()->pMod;
1311 GetSbData()->pMod = this;
1312 // The init code starts always here
1313 SbiRuntime* pRt = new SbiRuntime( this, NULL, 0 );
1315 pRt->pNext = GetSbData()->pInst->pRun;
1316 GetSbData()->pInst->pRun = pRt;
1317 while( pRt->Step() ) {}
1319 GetSbData()->pInst->pRun = pRt->pNext;
1320 delete pRt;
1321 GetSbData()->pMod = pOldMod;
1322 pImage->bInit = true;
1323 pImage->bFirstInit = false;
1325 // RunInit is not activ anymore
1326 GetSbData()->bRunInit = false;
1330 // Delete with private/dim declared variables
1332 void SbModule::AddVarName( const OUString& aName )
1334 // see if the name is added already
1335 std::vector< OUString >::iterator it_end = mModuleVariableNames.end();
1336 for ( std::vector< OUString >::iterator it = mModuleVariableNames.begin(); it != it_end; ++it )
1338 if ( aName == *it )
1339 return;
1341 mModuleVariableNames.push_back( aName );
1344 void SbModule::RemoveVars()
1346 std::vector< OUString >::iterator it_end = mModuleVariableNames.end();
1347 for ( std::vector< OUString >::iterator it = mModuleVariableNames.begin(); it != it_end; ++it )
1349 // We don't want a Find being called in a derived class ( e.g.
1350 // SbUserform because it could trigger say an initialise event
1351 // 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 )
1352 SbxVariableRef p = SbModule::Find( *it, SbxCLASS_PROPERTY );
1353 if( p.Is() )
1354 Remove (p);
1358 void SbModule::ClearPrivateVars()
1360 for( sal_uInt16 i = 0 ; i < pProps->Count() ; i++ )
1362 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
1363 if( p )
1365 // Delete not the arrays, only their content
1366 if( p->GetType() & SbxARRAY )
1368 SbxArray* pArray = PTR_CAST(SbxArray,p->GetObject());
1369 if( pArray )
1371 for( sal_uInt16 j = 0 ; j < pArray->Count() ; j++ )
1373 SbxVariable* pj = PTR_CAST(SbxVariable,pArray->Get( j ));
1374 pj->SbxValue::Clear();
1378 else
1380 p->SbxValue::Clear();
1386 void SbModule::implClearIfVarDependsOnDeletedBasic( SbxVariable* pVar, StarBASIC* pDeletedBasic )
1388 if( pVar->SbxValue::GetType() != SbxOBJECT || pVar->ISA( SbProcedureProperty ) )
1389 return;
1391 SbxObject* pObj = PTR_CAST(SbxObject,pVar->GetObject());
1392 if( pObj != NULL )
1394 SbxObject* p = pObj;
1396 SbModule* pMod = PTR_CAST( SbModule, p );
1397 if( pMod != NULL )
1398 pMod->ClearVarsDependingOnDeletedBasic( pDeletedBasic );
1400 while( (p = p->GetParent()) != NULL )
1402 StarBASIC* pBasic = PTR_CAST( StarBASIC, p );
1403 if( pBasic != NULL && pBasic == pDeletedBasic )
1405 pVar->SbxValue::Clear();
1406 break;
1412 void SbModule::ClearVarsDependingOnDeletedBasic( StarBASIC* pDeletedBasic )
1414 (void)pDeletedBasic;
1416 for( sal_uInt16 i = 0 ; i < pProps->Count() ; i++ )
1418 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
1419 if( p )
1421 if( p->GetType() & SbxARRAY )
1423 SbxArray* pArray = PTR_CAST(SbxArray,p->GetObject());
1424 if( pArray )
1426 for( sal_uInt16 j = 0 ; j < pArray->Count() ; j++ )
1428 SbxVariable* pVar = PTR_CAST(SbxVariable,pArray->Get( j ));
1429 implClearIfVarDependsOnDeletedBasic( pVar, pDeletedBasic );
1433 else
1435 implClearIfVarDependsOnDeletedBasic( p, pDeletedBasic );
1441 void StarBASIC::ClearAllModuleVars( void )
1443 // Initialise the own module
1444 for ( sal_uInt16 nMod = 0; nMod < pModules->Count(); nMod++ )
1446 SbModule* pModule = (SbModule*)pModules->Get( nMod );
1447 // Initialise only, if the startcode was already executed
1448 if( pModule->pImage && pModule->pImage->bInit && !pModule->isProxyModule() && !pModule->ISA(SbObjModule) )
1449 pModule->ClearPrivateVars();
1454 // Execution of the init-code of all module
1455 void SbModule::GlobalRunInit( bool bBasicStart )
1457 // If no Basic-Start, only initialise, if the module is not initialised
1458 if( !bBasicStart )
1459 if( !(pImage && !pImage->bInit) )
1460 return;
1462 // Initialise GlobalInitErr-Flag for Compiler-Error
1463 // With the help of this flags could be located in SbModule::Run() after the call of
1464 // GlobalRunInit, if at the intialising of the module
1465 // an error occurred. Then it will not be launched.
1466 GetSbData()->bGlobalInitErr = false;
1468 // Parent of the module is a Basic
1469 StarBASIC *pBasic = PTR_CAST(StarBASIC,GetParent());
1470 if( pBasic )
1472 pBasic->InitAllModules();
1474 SbxObject* pParent_ = pBasic->GetParent();
1475 if( pParent_ )
1477 StarBASIC * pParentBasic = PTR_CAST(StarBASIC,pParent_);
1478 if( pParentBasic )
1480 pParentBasic->InitAllModules( pBasic );
1482 // #109018 Parent can also have a parent (library in doc)
1483 SbxObject* pParentParent = pParentBasic->GetParent();
1484 if( pParentParent )
1486 StarBASIC * pParentParentBasic = PTR_CAST(StarBASIC,pParentParent);
1487 if( pParentParentBasic )
1488 pParentParentBasic->InitAllModules( pParentBasic );
1495 void SbModule::GlobalRunDeInit( void )
1497 StarBASIC *pBasic = PTR_CAST(StarBASIC,GetParent());
1498 if( pBasic )
1500 pBasic->DeInitAllModules();
1502 SbxObject* pParent_ = pBasic->GetParent();
1503 if( pParent_ )
1504 pBasic = PTR_CAST(StarBASIC,pParent_);
1505 if( pBasic )
1506 pBasic->DeInitAllModules();
1510 // Search for the next STMNT-Command in the code. This was used from the STMNT-
1511 // Opcode to set the endcolumn.
1513 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol ) const
1515 return FindNextStmnt( p, nLine, nCol, sal_False );
1518 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol,
1519 sal_Bool bFollowJumps, const SbiImage* pImg ) const
1521 sal_uInt32 nPC = (sal_uInt32) ( p - (const sal_uInt8*) pImage->GetCode() );
1522 while( nPC < pImage->GetCodeSize() )
1524 SbiOpcode eOp = (SbiOpcode ) ( *p++ );
1525 nPC++;
1526 if( bFollowJumps && eOp == _JUMP && pImg )
1528 SAL_WARN_IF( !pImg, "basic", "FindNextStmnt: pImg==NULL with FollowJumps option" );
1529 sal_uInt32 nOp1 = *p++; nOp1 |= *p++ << 8;
1530 nOp1 |= *p++ << 16; nOp1 |= *p++ << 24;
1531 p = (const sal_uInt8*) pImg->GetCode() + nOp1;
1533 else if( eOp >= SbOP1_START && eOp <= SbOP1_END )
1534 p += 4, nPC += 4;
1535 else if( eOp == _STMNT )
1537 sal_uInt32 nl, nc;
1538 nl = *p++; nl |= *p++ << 8;
1539 nl |= *p++ << 16 ; nl |= *p++ << 24;
1540 nc = *p++; nc |= *p++ << 8;
1541 nc |= *p++ << 16 ; nc |= *p++ << 24;
1542 nLine = (sal_uInt16)nl; nCol = (sal_uInt16)nc;
1543 return p;
1545 else if( eOp >= SbOP2_START && eOp <= SbOP2_END )
1546 p += 8, nPC += 8;
1547 else if( !( eOp >= SbOP0_START && eOp <= SbOP0_END ) )
1549 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1550 break;
1553 return NULL;
1556 // Test, if a line contains STMNT-Opcodes
1558 sal_Bool SbModule::IsBreakable( sal_uInt16 nLine ) const
1560 if( !pImage )
1561 return sal_False;
1562 const sal_uInt8* p = (const sal_uInt8* ) pImage->GetCode();
1563 sal_uInt16 nl, nc;
1564 while( ( p = FindNextStmnt( p, nl, nc ) ) != NULL )
1565 if( nl == nLine )
1566 return sal_True;
1567 return sal_False;
1570 sal_Bool SbModule::IsBP( sal_uInt16 nLine ) const
1572 if( pBreaks )
1574 for( size_t i = 0; i < pBreaks->size(); i++ )
1576 sal_uInt16 b = pBreaks->operator[]( i );
1577 if( b == nLine )
1578 return sal_True;
1579 if( b < nLine )
1580 break;
1583 return sal_False;
1586 sal_Bool SbModule::SetBP( sal_uInt16 nLine )
1588 if( !IsBreakable( nLine ) )
1589 return sal_False;
1590 if( !pBreaks )
1591 pBreaks = new SbiBreakpoints;
1592 size_t i;
1593 for( i = 0; i < pBreaks->size(); i++ )
1595 sal_uInt16 b = pBreaks->operator[]( i );
1596 if( b == nLine )
1597 return sal_True;
1598 if( b < nLine )
1599 break;
1601 pBreaks->insert( pBreaks->begin() + i, nLine );
1603 // #38568: Set during runtime as well here SbDEBUG_BREAK
1604 if( GetSbData()->pInst && GetSbData()->pInst->pRun )
1605 GetSbData()->pInst->pRun->SetDebugFlags( SbDEBUG_BREAK );
1607 return IsBreakable( nLine );
1610 sal_Bool SbModule::ClearBP( sal_uInt16 nLine )
1612 sal_Bool bRes = sal_False;
1613 if( pBreaks )
1615 for( size_t i = 0; i < pBreaks->size(); i++ )
1617 sal_uInt16 b = pBreaks->operator[]( i );
1618 if( b == nLine )
1620 pBreaks->erase( pBreaks->begin() + i );
1621 bRes = sal_True;
1622 break;
1624 if( b < nLine )
1625 break;
1627 if( pBreaks->empty() )
1628 delete pBreaks, pBreaks = NULL;
1630 return bRes;
1633 void SbModule::ClearAllBP()
1635 delete pBreaks;
1636 pBreaks = NULL;
1639 void
1640 SbModule::fixUpMethodStart( bool bCvtToLegacy, SbiImage* pImg ) const
1642 if ( !pImg )
1643 pImg = pImage;
1644 for( sal_uInt32 i = 0; i < pMethods->Count(); i++ )
1646 SbMethod* pMeth = PTR_CAST(SbMethod,pMethods->Get( (sal_uInt16)i ) );
1647 if( pMeth )
1649 //fixup method start positions
1650 if ( bCvtToLegacy )
1651 pMeth->nStart = pImg->CalcLegacyOffset( pMeth->nStart );
1652 else
1653 pMeth->nStart = pImg->CalcNewOffset( (sal_uInt16)pMeth->nStart );
1659 sal_Bool SbModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
1661 Clear();
1662 if( !SbxObject::LoadData( rStrm, 1 ) )
1663 return sal_False;
1664 // As a precaution...
1665 SetFlag( SBX_EXTSEARCH | SBX_GBLSEARCH );
1666 sal_uInt8 bImage;
1667 rStrm >> bImage;
1668 if( bImage )
1670 SbiImage* p = new SbiImage;
1671 sal_uInt32 nImgVer = 0;
1673 if( !p->Load( rStrm, nImgVer ) )
1675 delete p;
1676 return sal_False;
1678 // If the image is in old format, we fix up the method start offsets
1679 if ( nImgVer < B_EXT_IMG_VERSION )
1681 fixUpMethodStart( false, p );
1682 p->ReleaseLegacyBuffer();
1684 aComment = p->aComment;
1685 SetName( p->aName );
1686 if( p->GetCodeSize() )
1688 aOUSource = p->aOUSource;
1689 // Old version: image away
1690 if( nVer == 1 )
1692 SetSource32( p->aOUSource );
1693 delete p;
1695 else
1696 pImage = p;
1698 else
1700 SetSource32( p->aOUSource );
1701 delete p;
1704 return sal_True;
1707 sal_Bool SbModule::StoreData( SvStream& rStrm ) const
1709 bool bFixup = ( pImage && !pImage->ExceedsLegacyLimits() );
1710 if ( bFixup )
1711 fixUpMethodStart( true );
1712 sal_Bool bRet = SbxObject::StoreData( rStrm );
1713 if ( !bRet )
1714 return sal_False;
1716 if( pImage )
1718 pImage->aOUSource = aOUSource;
1719 pImage->aComment = aComment;
1720 pImage->aName = GetName();
1721 rStrm << (sal_uInt8) 1;
1722 // # PCode is saved only for legacy formats only
1723 // It should be noted that it probably isn't necessary
1724 // It would be better not to store the image ( more flexible with
1725 // formats )
1726 bool bRes = pImage->Save( rStrm, B_LEGACYVERSION );
1727 if ( bFixup )
1728 fixUpMethodStart( false ); // restore method starts
1729 return bRes;
1732 else
1734 SbiImage aImg;
1735 aImg.aOUSource = aOUSource;
1736 aImg.aComment = aComment;
1737 aImg.aName = GetName();
1738 rStrm << (sal_uInt8) 1;
1739 return aImg.Save( rStrm );
1743 sal_Bool SbModule::ExceedsLegacyModuleSize()
1745 if ( !IsCompiled() )
1746 Compile();
1747 if ( pImage && pImage->ExceedsLegacyLimits() )
1748 return true;
1749 return false;
1752 class ErrorHdlResetter
1754 Link mErrHandler;
1755 bool mbError;
1756 public:
1757 ErrorHdlResetter() : mbError( false )
1759 // save error handler
1760 mErrHandler = StarBASIC::GetGlobalErrorHdl();
1761 // set new error handler
1762 StarBASIC::SetGlobalErrorHdl( LINK( this, ErrorHdlResetter, BasicErrorHdl ) );
1764 ~ErrorHdlResetter()
1766 // restore error handler
1767 StarBASIC::SetGlobalErrorHdl(mErrHandler);
1769 DECL_LINK( BasicErrorHdl, StarBASIC * );
1770 bool HasError() { return mbError; }
1772 IMPL_LINK( ErrorHdlResetter, BasicErrorHdl, StarBASIC *, /*pBasic*/)
1774 mbError = true;
1775 return 0;
1778 bool SbModule::HasExeCode()
1780 // And empty Image always has the Global Chain set up
1781 static const unsigned char pEmptyImage[] = { 0x45, 0x0 , 0x0, 0x0, 0x0 };
1782 // lets be stricter for the moment than VBA
1784 if (!IsCompiled())
1786 ErrorHdlResetter aGblErrHdl;
1787 Compile();
1788 if (aGblErrHdl.HasError()) //assume unsafe on compile error
1789 return true;
1792 bool bRes = false;
1793 if (pImage && !(pImage->GetCodeSize() == 5 && (memcmp(pImage->GetCode(), pEmptyImage, pImage->GetCodeSize()) == 0 )))
1794 bRes = true;
1796 return bRes;
1799 // Store only image, no source
1800 sal_Bool SbModule::StoreBinaryData( SvStream& rStrm )
1802 return StoreBinaryData( rStrm, 0 );
1805 sal_Bool SbModule::StoreBinaryData( SvStream& rStrm, sal_uInt16 nVer )
1807 sal_Bool bRet = Compile();
1808 if( bRet )
1810 bool bFixup = ( !nVer && !pImage->ExceedsLegacyLimits() );// save in old image format, fix up method starts
1812 if ( bFixup ) // save in old image format, fix up method starts
1813 fixUpMethodStart( true );
1814 bRet = SbxObject::StoreData( rStrm );
1815 if( bRet )
1817 pImage->aOUSource = OUString();
1818 pImage->aComment = aComment;
1819 pImage->aName = GetName();
1821 rStrm << (sal_uInt8) 1;
1822 if ( nVer )
1823 bRet = pImage->Save( rStrm, B_EXT_IMG_VERSION );
1824 else
1825 bRet = pImage->Save( rStrm, B_LEGACYVERSION );
1826 if ( bFixup )
1827 fixUpMethodStart( false ); // restore method starts
1829 pImage->aOUSource = aOUSource;
1832 return bRet;
1835 // Called for >= OO 1.0 passwd protected libraries only
1837 sal_Bool SbModule::LoadBinaryData( SvStream& rStrm )
1839 OUString aKeepSource = aOUSource;
1840 bool bRet = LoadData( rStrm, 2 );
1841 LoadCompleted();
1842 aOUSource = aKeepSource;
1843 return bRet;
1846 sal_Bool SbModule::LoadCompleted()
1848 SbxArray* p = GetMethods();
1849 sal_uInt16 i;
1850 for( i = 0; i < p->Count(); i++ )
1852 SbMethod* q = PTR_CAST(SbMethod,p->Get( i ) );
1853 if( q )
1854 q->pMod = this;
1856 p = GetProperties();
1857 for( i = 0; i < p->Count(); i++ )
1859 SbProperty* q = PTR_CAST(SbProperty,p->Get( i ) );
1860 if( q )
1861 q->pMod = this;
1863 return sal_True;
1866 void SbModule::handleProcedureProperties( SfxBroadcaster& rBC, const SfxHint& rHint )
1868 bool bDone = false;
1870 const SbxHint* pHint = PTR_CAST(SbxHint,&rHint);
1871 if( pHint )
1873 SbxVariable* pVar = pHint->GetVar();
1874 SbProcedureProperty* pProcProperty = PTR_CAST( SbProcedureProperty, pVar );
1875 if( pProcProperty )
1877 bDone = true;
1879 if( pHint->GetId() == SBX_HINT_DATAWANTED )
1881 OUString aProcName("Property Get ");
1882 aProcName += pProcProperty->GetName();
1884 SbxVariable* pMeth = Find( aProcName, SbxCLASS_METHOD );
1885 if( pMeth )
1887 SbxValues aVals;
1888 aVals.eType = SbxVARIANT;
1890 SbxArray* pArg = pVar->GetParameters();
1891 sal_uInt16 nVarParCount = (pArg != NULL) ? pArg->Count() : 0;
1892 if( nVarParCount > 1 )
1894 SbxArrayRef xMethParameters = new SbxArray;
1895 xMethParameters->Put( pMeth, 0 ); // Method as parameter 0
1896 for( sal_uInt16 i = 1 ; i < nVarParCount ; ++i )
1898 SbxVariable* pPar = pArg->Get( i );
1899 xMethParameters->Put( pPar, i );
1902 pMeth->SetParameters( xMethParameters );
1903 pMeth->Get( aVals );
1904 pMeth->SetParameters( NULL );
1906 else
1908 pMeth->Get( aVals );
1911 pVar->Put( aVals );
1914 else if( pHint->GetId() == SBX_HINT_DATACHANGED )
1916 SbxVariable* pMeth = NULL;
1918 bool bSet = pProcProperty->isSet();
1919 if( bSet )
1921 pProcProperty->setSet( false );
1923 OUString aProcName("Property Set " );
1924 aProcName += pProcProperty->GetName();
1925 pMeth = Find( aProcName, SbxCLASS_METHOD );
1927 if( !pMeth ) // Let
1929 OUString aProcName("Property Let " );
1930 aProcName += pProcProperty->GetName();
1931 pMeth = Find( aProcName, SbxCLASS_METHOD );
1934 if( pMeth )
1936 // Setup parameters
1937 SbxArrayRef xArray = new SbxArray;
1938 xArray->Put( pMeth, 0 ); // Method as parameter 0
1939 xArray->Put( pVar, 1 );
1940 pMeth->SetParameters( xArray );
1942 SbxValues aVals;
1943 pMeth->Get( aVals );
1944 pMeth->SetParameters( NULL );
1950 if( !bDone )
1951 SbModule::Notify( rBC, rHint );
1955 // Implementation SbJScriptModule (Basic module for JavaScript source code)
1956 SbJScriptModule::SbJScriptModule( const OUString& rName )
1957 :SbModule( rName )
1961 sal_Bool SbJScriptModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
1963 (void)nVer;
1965 Clear();
1966 if( !SbxObject::LoadData( rStrm, 1 ) )
1967 return sal_False;
1969 // Get the source string
1970 aOUSource = rStrm.ReadUniOrByteString( osl_getThreadTextEncoding() );
1971 return sal_True;
1974 sal_Bool SbJScriptModule::StoreData( SvStream& rStrm ) const
1976 if( !SbxObject::StoreData( rStrm ) )
1977 return sal_False;
1979 // Write the source string
1980 OUString aTmp = aOUSource;
1981 rStrm.WriteUniOrByteString( aTmp, osl_getThreadTextEncoding() );
1982 return sal_True;
1986 /////////////////////////////////////////////////////////////////////////
1988 SbMethod::SbMethod( const OUString& r, SbxDataType t, SbModule* p )
1989 : SbxMethod( r, t ), pMod( p )
1991 bInvalid = sal_True;
1992 nStart =
1993 nDebugFlags =
1994 nLine1 =
1995 nLine2 = 0;
1996 refStatics = new SbxArray;
1997 mCaller = 0;
1998 // HACK due to 'Referenz could not be saved'
1999 SetFlag( SBX_NO_MODIFY );
2002 SbMethod::SbMethod( const SbMethod& r )
2003 : SvRefBase( r ), SbxMethod( r )
2005 pMod = r.pMod;
2006 bInvalid = r.bInvalid;
2007 nStart = r.nStart;
2008 nDebugFlags = r.nDebugFlags;
2009 nLine1 = r.nLine1;
2010 nLine2 = r.nLine2;
2011 refStatics = r.refStatics;
2012 mCaller = r.mCaller;
2013 SetFlag( SBX_NO_MODIFY );
2016 SbMethod::~SbMethod()
2020 void SbMethod::ClearStatics()
2022 refStatics = new SbxArray;
2025 SbxArray* SbMethod::GetStatics()
2027 return refStatics;
2030 sal_Bool SbMethod::LoadData( SvStream& rStrm, sal_uInt16 nVer )
2032 if( !SbxMethod::LoadData( rStrm, 1 ) )
2033 return sal_False;
2034 sal_Int16 n;
2035 rStrm >> n;
2036 sal_Int16 nTempStart = (sal_Int16)nStart;
2037 if( nVer == 2 )
2038 rStrm >> nLine1 >> nLine2 >> nTempStart >> bInvalid;
2039 // HACK ue to 'Referenz could not be saved'
2040 SetFlag( SBX_NO_MODIFY );
2041 nStart = nTempStart;
2042 return sal_True;
2045 sal_Bool SbMethod::StoreData( SvStream& rStrm ) const
2047 if( !SbxMethod::StoreData( rStrm ) )
2048 return sal_False;
2049 rStrm << (sal_Int16) nDebugFlags
2050 << (sal_Int16) nLine1
2051 << (sal_Int16) nLine2
2052 << (sal_Int16) nStart
2053 << (sal_uInt8) bInvalid;
2054 return sal_True;
2057 void SbMethod::GetLineRange( sal_uInt16& l1, sal_uInt16& l2 )
2059 l1 = nLine1; l2 = nLine2;
2062 // Could later be deleted
2064 SbxInfo* SbMethod::GetInfo()
2066 return pInfo;
2069 // Interface to execute a method of the applications
2070 // With special RefCounting, so that the Basic was not fired of by CloseDocument()
2071 // The return value will be delivered as string.
2072 ErrCode SbMethod::Call( SbxValue* pRet, SbxVariable* pCaller )
2074 if ( pCaller )
2076 SAL_INFO("basic", "SbMethod::Call Have been passed a caller 0x" << pCaller );
2077 mCaller = pCaller;
2079 // RefCount vom Modul hochzaehlen
2080 SbModule* pMod_ = (SbModule*)GetParent();
2081 pMod_->AddRef();
2083 // Increment the RefCount of the Basic
2084 StarBASIC* pBasic = (StarBASIC*)pMod_->GetParent();
2085 pBasic->AddRef();
2087 // Establish the values to get the return value
2088 SbxValues aVals;
2089 aVals.eType = SbxVARIANT;
2091 // #104083: Compile BEFORE get
2092 if( bInvalid && !pMod_->Compile() )
2093 StarBASIC::Error( SbERR_BAD_PROP_VALUE );
2095 Get( aVals );
2096 if ( pRet )
2097 pRet->Put( aVals );
2099 // Was there an error
2100 ErrCode nErr = SbxBase::GetError();
2101 SbxBase::ResetError();
2103 // Release objects
2104 pMod_->ReleaseRef();
2105 pBasic->ReleaseRef();
2106 mCaller = 0;
2107 return nErr;
2111 // #100883 Own Broadcast for SbMethod
2112 void SbMethod::Broadcast( sal_uIntPtr nHintId )
2114 if( pCst && !IsSet( SBX_NO_BROADCAST ) )
2116 // Because the method could be called from outside, test here once again
2117 // the authorisation
2118 if( nHintId & SBX_HINT_DATAWANTED )
2119 if( !CanRead() )
2120 return;
2121 if( nHintId & SBX_HINT_DATACHANGED )
2122 if( !CanWrite() )
2123 return;
2125 if( pMod && !pMod->IsCompiled() )
2126 pMod->Compile();
2128 // Block broadcasts while creating new method
2129 SfxBroadcaster* pSave = pCst;
2130 pCst = NULL;
2131 SbMethod* pThisCopy = new SbMethod( *this );
2132 SbMethodRef xHolder = pThisCopy;
2133 if( mpPar.Is() )
2135 // Enrigister this as element 0, but don't reset the parent!
2136 if( GetType() != SbxVOID )
2137 mpPar->PutDirect( pThisCopy, 0 );
2138 SetParameters( NULL );
2141 pCst = pSave;
2142 pSave->Broadcast( SbxHint( nHintId, pThisCopy ) );
2144 sal_uInt16 nSaveFlags = GetFlags();
2145 SetFlag( SBX_READWRITE );
2146 pCst = NULL;
2147 Put( pThisCopy->GetValues_Impl() );
2148 pCst = pSave;
2149 SetFlags( nSaveFlags );
2154 // Implementation of SbJScriptMethod (method class as a wrapper for JavaScript-functions)
2156 SbJScriptMethod::SbJScriptMethod( const OUString& r, SbxDataType t, SbModule* p )
2157 : SbMethod( r, t, p )
2161 SbJScriptMethod::~SbJScriptMethod()
2165 SbObjModule::SbObjModule( const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVbaCompatible )
2166 : SbModule( rName, bIsVbaCompatible )
2168 SetModuleType( mInfo.ModuleType );
2169 if ( mInfo.ModuleType == script::ModuleType::FORM )
2171 SetClassName( "Form" );
2173 else if ( mInfo.ModuleObject.is() )
2175 SetUnoObject( uno::makeAny( mInfo.ModuleObject ) );
2179 SbObjModule::~SbObjModule()
2183 void
2184 SbObjModule::SetUnoObject( const uno::Any& aObj ) throw ( uno::RuntimeException )
2186 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxVariable*)pDocObject);
2187 if ( pUnoObj && pUnoObj->getUnoAny() == aObj ) // object is equal, nothing to do
2188 return;
2189 pDocObject = new SbUnoObject( GetName(), uno::makeAny( aObj ) );
2191 com::sun::star::uno::Reference< com::sun::star::lang::XServiceInfo > xServiceInfo( aObj, com::sun::star::uno::UNO_QUERY_THROW );
2192 if( xServiceInfo->supportsService( "ooo.vba.excel.Worksheet" ) )
2194 SetClassName( "Worksheet" );
2196 else if( xServiceInfo->supportsService( "ooo.vba.excel.Workbook" ) )
2198 SetClassName( "Workbook" );
2202 SbxVariable*
2203 SbObjModule::GetObject()
2205 return pDocObject;
2207 SbxVariable*
2208 SbObjModule::Find( const OUString& rName, SbxClassType t )
2210 SbxVariable* pVar = NULL;
2211 if ( pDocObject)
2212 pVar = pDocObject->Find( rName, t );
2213 if ( !pVar )
2214 pVar = SbModule::Find( rName, t );
2215 return pVar;
2218 void SbObjModule::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
2219 const SfxHint& rHint, const TypeId& rHintType )
2221 SbModule::handleProcedureProperties( rBC, rHint );
2225 typedef ::cppu::WeakImplHelper3<
2226 awt::XTopWindowListener,
2227 awt::XWindowListener,
2228 document::XEventListener > FormObjEventListener_BASE;
2230 class FormObjEventListenerImpl : public FormObjEventListener_BASE
2232 SbUserFormModule* mpUserForm;
2233 uno::Reference< lang::XComponent > mxComponent;
2234 uno::Reference< frame::XModel > mxModel;
2235 bool mbDisposed;
2236 sal_Bool mbOpened;
2237 sal_Bool mbActivated;
2238 sal_Bool mbShowing;
2240 FormObjEventListenerImpl(const FormObjEventListenerImpl&); // not defined
2241 FormObjEventListenerImpl& operator=(const FormObjEventListenerImpl&); // not defined
2243 public:
2244 FormObjEventListenerImpl( SbUserFormModule* pUserForm, const uno::Reference< lang::XComponent >& xComponent, const uno::Reference< frame::XModel >& xModel ) :
2245 mpUserForm( pUserForm ), mxComponent( xComponent), mxModel( xModel ),
2246 mbDisposed( false ), mbOpened( sal_False ), mbActivated( sal_False ), mbShowing( sal_False )
2248 if ( mxComponent.is() )
2250 SAL_INFO("basic", "*********** Registering the listeners");
2253 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->addTopWindowListener( this );
2255 catch(const uno::Exception& ) {}
2258 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->addWindowListener( this );
2260 catch(const uno::Exception& ) {}
2263 if ( mxModel.is() )
2267 uno::Reference< document::XEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->addEventListener( this );
2269 catch(const uno::Exception& ) {}
2273 virtual ~FormObjEventListenerImpl()
2275 removeListener();
2278 sal_Bool isShowing() const { return mbShowing; }
2280 void removeListener()
2282 if ( mxComponent.is() && !mbDisposed )
2284 SAL_INFO("basic", "*********** Removing the listeners");
2287 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeTopWindowListener( this );
2289 catch(const uno::Exception& ) {}
2292 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeWindowListener( this );
2294 catch(const uno::Exception& ) {}
2296 mxComponent.clear();
2298 if ( mxModel.is() && !mbDisposed )
2302 uno::Reference< document::XEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->removeEventListener( this );
2304 catch(const uno::Exception& ) {}
2306 mxModel.clear();
2309 virtual void SAL_CALL windowOpened( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2311 if ( mpUserForm )
2313 mbOpened = sal_True;
2314 mbShowing = sal_True;
2315 if ( mbActivated )
2317 mbOpened = mbActivated = sal_False;
2318 mpUserForm->triggerActivateEvent();
2324 virtual void SAL_CALL windowClosing( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2326 #ifdef IN_THE_FUTURE
2327 uno::Reference< awt::XDialog > xDialog( e.Source, uno::UNO_QUERY );
2328 if ( xDialog.is() )
2330 uno::Reference< awt::XControl > xControl( xDialog, uno::UNO_QUERY );
2331 if ( xControl->getPeer().is() )
2333 uno::Reference< document::XVbaMethodParameter > xVbaMethodParameter( xControl->getPeer(), uno::UNO_QUERY );
2334 if ( xVbaMethodParameter.is() )
2336 sal_Int8 nCancel = 0;
2337 sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormControlMenu;
2339 Sequence< Any > aParams;
2340 aParams.realloc(2);
2341 aParams[0] <<= nCancel;
2342 aParams[1] <<= nCloseMode;
2344 mpUserForm->triggerMethod( "Userform_QueryClose", aParams);
2345 return;
2351 mpUserForm->triggerMethod( "Userform_QueryClose" );
2352 #endif
2356 virtual void SAL_CALL windowClosed( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2358 mbOpened = sal_False;
2359 mbShowing = sal_False;
2362 virtual void SAL_CALL windowMinimized( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2366 virtual void SAL_CALL windowNormalized( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2370 virtual void SAL_CALL windowActivated( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2372 if ( mpUserForm )
2374 mbActivated = sal_True;
2375 if ( mbOpened )
2377 mbOpened = mbActivated = sal_False;
2378 mpUserForm->triggerActivateEvent();
2383 virtual void SAL_CALL windowDeactivated( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2385 if ( mpUserForm )
2386 mpUserForm->triggerDeactivateEvent();
2389 virtual void SAL_CALL windowResized( const awt::WindowEvent& /*e*/ ) throw (uno::RuntimeException)
2391 if ( mpUserForm )
2393 mpUserForm->triggerResizeEvent();
2394 mpUserForm->triggerLayoutEvent();
2398 virtual void SAL_CALL windowMoved( const awt::WindowEvent& /*e*/ ) throw (uno::RuntimeException)
2400 if ( mpUserForm )
2401 mpUserForm->triggerLayoutEvent();
2404 virtual void SAL_CALL windowShown( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2408 virtual void SAL_CALL windowHidden( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2412 virtual void SAL_CALL notifyEvent( const document::EventObject& rEvent ) throw (uno::RuntimeException)
2414 // early dosposing on document event "OnUnload", to be sure Basic still exists when calling VBA "UserForm_Terminate"
2415 if( rEvent.EventName == GlobalEventConfig::GetEventName( STR_EVENT_CLOSEDOC ) )
2417 removeListener();
2418 mbDisposed = true;
2419 if ( mpUserForm )
2420 mpUserForm->ResetApiObj(); // will trigger "UserForm_Terminate"
2424 virtual void SAL_CALL disposing( const lang::EventObject& /*Source*/ ) throw (uno::RuntimeException)
2426 SAL_INFO("basic", "** Userform/Dialog disposing");
2427 removeListener();
2428 mbDisposed = true;
2429 if ( mpUserForm )
2430 mpUserForm->ResetApiObj( false ); // pass false (too late to trigger VBA events here)
2434 SbUserFormModule::SbUserFormModule( const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsCompat )
2435 : SbObjModule( rName, mInfo, bIsCompat )
2436 , m_mInfo( mInfo )
2437 , mbInit( false )
2439 m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW );
2442 SbUserFormModule::~SbUserFormModule()
2446 void SbUserFormModule::ResetApiObj( bool bTriggerTerminateEvent )
2448 SAL_INFO("basic", " SbUserFormModule::ResetApiObj( " << (bTriggerTerminateEvent ? "true )" : "false )") );
2449 if ( bTriggerTerminateEvent && m_xDialog.is() ) // probably someone close the dialog window
2451 triggerTerminateEvent();
2453 pDocObject = NULL;
2454 m_xDialog = NULL;
2457 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun )
2459 Sequence< Any > aArguments;
2460 triggerMethod( aMethodToRun, aArguments );
2463 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun, Sequence< Any >& aArguments )
2465 SAL_INFO("basic", "*** trigger " << OUStringToOString( aMethodToRun, RTL_TEXTENCODING_UTF8 ).getStr() << " ***");
2466 // Search method
2467 SbxVariable* pMeth = SbObjModule::Find( aMethodToRun, SbxCLASS_METHOD );
2468 if( pMeth )
2470 if ( aArguments.getLength() > 0 ) // Setup parameters
2472 SbxArrayRef xArray = new SbxArray;
2473 xArray->Put( pMeth, 0 ); // Method as parameter 0
2475 for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2477 SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
2478 unoToSbxValue( static_cast< SbxVariable* >( xSbxVar ), aArguments[i] );
2479 xArray->Put( xSbxVar, static_cast< sal_uInt16 >( i ) + 1 );
2481 // Enable passing by ref
2482 if ( xSbxVar->GetType() != SbxVARIANT )
2483 xSbxVar->SetFlag( SBX_FIXED );
2485 pMeth->SetParameters( xArray );
2487 SbxValues aVals;
2488 pMeth->Get( aVals );
2490 for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2492 aArguments[i] = sbxToUnoValue( xArray->Get( static_cast< sal_uInt16 >(i) + 1) );
2494 pMeth->SetParameters( NULL );
2496 else
2498 SbxValues aVals;
2499 pMeth->Get( aVals );
2504 void SbUserFormModule::triggerActivateEvent( void )
2506 SAL_INFO("basic", "**** entering SbUserFormModule::triggerActivate");
2507 triggerMethod( "UserForm_Activate" );
2508 SAL_INFO("basic", "**** leaving SbUserFormModule::triggerActivate");
2511 void SbUserFormModule::triggerDeactivateEvent( void )
2513 SAL_INFO("basic", "**** SbUserFormModule::triggerDeactivate");
2514 triggerMethod( "Userform_Deactivate" );
2517 void SbUserFormModule::triggerInitializeEvent( void )
2519 if ( mbInit )
2520 return;
2521 SAL_INFO("basic", "**** SbUserFormModule::triggerInitializeEvent");
2522 static OUString aInitMethodName( "Userform_Initialize");
2523 triggerMethod( aInitMethodName );
2524 mbInit = true;
2527 void SbUserFormModule::triggerTerminateEvent( void )
2529 SAL_INFO("basic", "**** SbUserFormModule::triggerTerminateEvent");
2530 static OUString aTermMethodName( "Userform_Terminate" );
2531 triggerMethod( aTermMethodName );
2532 mbInit=false;
2535 void SbUserFormModule::triggerLayoutEvent( void )
2537 static OUString aMethodName( "Userform_Layout" );
2538 triggerMethod( aMethodName );
2541 void SbUserFormModule::triggerResizeEvent( void )
2543 static OUString aMethodName("Userform_Resize");
2544 triggerMethod( aMethodName );
2547 SbUserFormModuleInstance* SbUserFormModule::CreateInstance()
2549 SbUserFormModuleInstance* pInstance = new SbUserFormModuleInstance( this, GetName(), m_mInfo, IsVBACompat() );
2550 return pInstance;
2553 SbUserFormModuleInstance::SbUserFormModuleInstance( SbUserFormModule* pParentModule,
2554 const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVBACompat )
2555 : SbUserFormModule( rName, mInfo, bIsVBACompat )
2556 , m_pParentModule( pParentModule )
2560 sal_Bool SbUserFormModuleInstance::IsClass( const OUString& rName ) const
2562 sal_Bool bParentNameMatches = m_pParentModule->GetName().equalsIgnoreAsciiCase( rName );
2563 sal_Bool bRet = bParentNameMatches || SbxObject::IsClass( rName );
2564 return bRet;
2567 SbxVariable* SbUserFormModuleInstance::Find( const OUString& rName, SbxClassType t )
2569 SbxVariable* pVar = m_pParentModule->Find( rName, t );
2570 return pVar;
2574 void SbUserFormModule::Load()
2576 SAL_INFO("basic", "** load() ");
2577 // forces a load
2578 if ( !pDocObject )
2579 InitObject();
2583 void SbUserFormModule::Unload()
2585 SAL_INFO("basic", "** Unload() ");
2587 sal_Int8 nCancel = 0;
2588 sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormCode;
2590 Sequence< Any > aParams;
2591 aParams.realloc(2);
2592 aParams[0] <<= nCancel;
2593 aParams[1] <<= nCloseMode;
2595 triggerMethod( "Userform_QueryClose", aParams);
2597 aParams[0] >>= nCancel;
2598 // basic boolean ( and what the user might use ) can be ambiguous ( e.g. basic true = -1 )
2599 // test agains 0 ( false ) and assume anything else is true
2600 // ( Note: ) this used to work ( something changes somewhere )
2601 if (nCancel != 0)
2603 return;
2606 if ( m_xDialog.is() )
2608 triggerTerminateEvent();
2610 // Search method
2611 SbxVariable* pMeth = SbObjModule::Find( "UnloadObject", SbxCLASS_METHOD );
2612 if( pMeth )
2614 SAL_INFO("basic", "Attempting too run the UnloadObjectMethod");
2615 m_xDialog.clear(); //release ref to the uno object
2616 SbxValues aVals;
2617 bool bWaitForDispose = true; // assume dialog is showing
2618 if ( m_DialogListener.get() )
2620 bWaitForDispose = m_DialogListener->isShowing();
2621 SAL_INFO("basic", "Showing " << bWaitForDispose );
2623 pMeth->Get( aVals);
2624 if ( !bWaitForDispose )
2626 // we've either already got a dispose or we'er never going to get one
2627 ResetApiObj();
2628 } // else wait for dispose
2629 SAL_INFO("basic", "UnloadObject completed ( we hope )");
2634 void registerComponentToBeDisposedForBasic( Reference< XComponent > xComponent, StarBASIC* pBasic );
2636 void SbUserFormModule::InitObject()
2640 OUString aHook("VBAGlobals");
2641 SbUnoObject* pGlobs = (SbUnoObject*)GetParent()->Find( aHook, SbxCLASS_DONTCARE );
2642 if ( m_xModel.is() && pGlobs )
2644 // broadcast INITIALIZE_USERFORM script event before the dialog is created
2645 Reference< script::vba::XVBACompatibility > xVBACompat( getVBACompatibility( m_xModel ), uno::UNO_SET_THROW );
2646 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::INITIALIZE_USERFORM, GetName() );
2647 uno::Reference< lang::XMultiServiceFactory > xVBAFactory( pGlobs->getUnoAny(), uno::UNO_QUERY_THROW );
2648 uno::Reference< uno::XComponentContext > xContext = comphelper::getProcessComponentContext();
2649 OUString sDialogUrl( "vnd.sun.star.script:" );
2650 OUString sProjectName( "Standard" );
2654 Reference< beans::XPropertySet > xProps( m_xModel, UNO_QUERY_THROW );
2655 uno::Reference< script::vba::XVBACompatibility > xVBAMode( xProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY_THROW );
2656 sProjectName = xVBAMode->getProjectName();
2658 catch(const Exception& ) {}
2660 sDialogUrl = sDialogUrl + sProjectName + "." + GetName() + "?location=document";
2662 uno::Reference< awt::XDialogProvider > xProvider = awt::DialogProvider::createWithModel( xContext, m_xModel );
2663 m_xDialog = xProvider->createDialog( sDialogUrl );
2665 // create vba api object
2666 uno::Sequence< uno::Any > aArgs(4);
2667 aArgs[ 0 ] = uno::Any();
2668 aArgs[ 1 ] <<= m_xDialog;
2669 aArgs[ 2 ] <<= m_xModel;
2670 aArgs[ 3 ] <<= OUString( GetParent()->GetName() );
2671 pDocObject = new SbUnoObject( GetName(), uno::makeAny( xVBAFactory->createInstanceWithArguments( "ooo.vba.msforms.UserForm", aArgs ) ) );
2673 uno::Reference< lang::XComponent > xComponent( m_xDialog, uno::UNO_QUERY_THROW );
2675 // the dialog must be disposed at the end!
2676 StarBASIC* pParentBasic = NULL;
2677 SbxObject* pCurObject = this;
2680 SbxObject* pObjParent = pCurObject->GetParent();
2681 pParentBasic = PTR_CAST( StarBASIC, pObjParent );
2682 pCurObject = pObjParent;
2684 while( pParentBasic == NULL && pCurObject != NULL );
2686 SAL_WARN_IF( pParentBasic == NULL, "basic", "pParentBasic == NULL" );
2687 registerComponentToBeDisposedForBasic( xComponent, pParentBasic );
2689 // if old listener object exists, remove it from dialog and document model
2690 if( m_DialogListener.is() )
2691 m_DialogListener->removeListener();
2692 m_DialogListener.set( new FormObjEventListenerImpl( this, xComponent, m_xModel ) );
2694 triggerInitializeEvent();
2697 catch(const uno::Exception& )
2703 SbxVariable*
2704 SbUserFormModule::Find( const OUString& rName, SbxClassType t )
2706 if ( !pDocObject && !GetSbData()->bRunInit && GetSbData()->pInst )
2707 InitObject();
2708 return SbObjModule::Find( rName, t );
2711 SbProperty::SbProperty( const OUString& r, SbxDataType t, SbModule* p )
2712 : SbxProperty( r, t ), pMod( p )
2714 bInvalid = sal_False;
2717 SbProperty::~SbProperty()
2721 SbProcedureProperty::~SbProcedureProperty()
2724 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */