bump product version to 4.2.0.1
[LibreOffice.git] / basic / source / classes / sbxmod.cxx
blob0ef65e38630b13f613e3fbc80bd1f477f36b4595
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>
87 #include "sbcomp.hxx"
89 typedef ::cppu::WeakImplHelper1< XInvocation > DocObjectWrapper_BASE;
90 typedef ::std::map< sal_Int16, Any, ::std::less< sal_Int16 > > OutParamMap;
92 class DocObjectWrapper : public DocObjectWrapper_BASE
94 Reference< XAggregation > m_xAggProxy;
95 Reference< XInvocation > m_xAggInv;
96 Reference< XTypeProvider > m_xAggregateTypeProv;
97 Sequence< Type > m_Types;
98 SbModule* m_pMod;
99 SbMethodRef getMethod( const OUString& aName ) throw (RuntimeException);
100 SbPropertyRef getProperty( const OUString& aName ) throw (RuntimeException);
101 OUString mName; // for debugging
103 public:
104 DocObjectWrapper( SbModule* pMod );
105 virtual ~DocObjectWrapper();
107 virtual void SAL_CALL acquire() throw();
108 virtual void SAL_CALL release() throw();
110 virtual Sequence< sal_Int8 > SAL_CALL getImplementationId() throw (RuntimeException)
112 if( !m_xAggregateTypeProv.is() )
113 throw RuntimeException();
114 return m_xAggregateTypeProv->getImplementationId();
117 virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection( ) throw (RuntimeException);
119 virtual Any SAL_CALL invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) throw (IllegalArgumentException, CannotConvertException, InvocationTargetException, RuntimeException);
120 virtual void SAL_CALL setValue( const OUString& aPropertyName, const Any& aValue ) throw (UnknownPropertyException, CannotConvertException, InvocationTargetException, RuntimeException);
121 virtual Any SAL_CALL getValue( const OUString& aPropertyName ) throw (UnknownPropertyException, RuntimeException);
122 virtual ::sal_Bool SAL_CALL hasMethod( const OUString& aName ) throw (RuntimeException);
123 virtual ::sal_Bool SAL_CALL hasProperty( const OUString& aName ) throw (RuntimeException);
124 virtual Any SAL_CALL queryInterface( const Type& aType ) throw ( RuntimeException );
126 virtual Sequence< Type > SAL_CALL getTypes() throw ( RuntimeException );
129 DocObjectWrapper::DocObjectWrapper( SbModule* pVar ) : m_pMod( pVar ), mName( pVar->GetName() )
131 SbObjModule* pMod = PTR_CAST(SbObjModule,pVar);
132 if ( pMod )
134 if ( pMod->GetModuleType() == ModuleType::DOCUMENT )
136 // Use proxy factory service to create aggregatable proxy.
137 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,pMod->GetObject() );
138 Reference< XInterface > xIf;
139 if ( pUnoObj )
141 Any aObj = pUnoObj->getUnoAny();
142 aObj >>= xIf;
143 if ( xIf.is() )
145 m_xAggregateTypeProv.set( xIf, UNO_QUERY );
146 m_xAggInv.set( xIf, UNO_QUERY );
149 if ( xIf.is() )
153 Reference< XProxyFactory > xProxyFac = ProxyFactory::create( comphelper::getProcessComponentContext() );
154 m_xAggProxy = xProxyFac->createProxy( xIf );
156 catch(const Exception& )
158 SAL_WARN( "basic", "DocObjectWrapper::DocObjectWrapper: Caught exception!" );
162 if ( m_xAggProxy.is() )
164 osl_atomic_increment( &m_refCount );
166 /* i35609 - Fix crash on Solaris. The setDelegator call needs
167 to be in its own block to ensure that all temporary Reference
168 instances that are acquired during the call are released
169 before m_refCount is decremented again */
171 m_xAggProxy->setDelegator( static_cast< cppu::OWeakObject * >( this ) );
174 osl_atomic_decrement( &m_refCount );
180 void SAL_CALL
181 DocObjectWrapper::acquire() throw ()
183 osl_atomic_increment( &m_refCount );
184 SAL_INFO("basic","DocObjectWrapper::acquire("<< OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr() << ") 0x" << this << " refcount is now " << m_refCount );
186 void SAL_CALL
187 DocObjectWrapper::release() throw ()
189 if ( osl_atomic_decrement( &m_refCount ) == 0 )
191 SAL_INFO("basic","DocObjectWrapper::release("<< OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr() << ") 0x" << this << " refcount is now " << m_refCount );
192 delete this;
194 else
196 SAL_INFO("basic","DocObjectWrapper::release("<< OUStringToOString( mName, RTL_TEXTENCODING_UTF8 ).getStr() << ") 0x" << this << " refcount is now " << m_refCount );
200 DocObjectWrapper::~DocObjectWrapper()
204 Sequence< Type > SAL_CALL DocObjectWrapper::getTypes()
205 throw ( RuntimeException )
207 if ( m_Types.getLength() == 0 )
209 Sequence< Type > sTypes;
210 if ( m_xAggregateTypeProv.is() )
212 sTypes = m_xAggregateTypeProv->getTypes();
214 m_Types.realloc( sTypes.getLength() + 1 );
215 Type* pPtr = m_Types.getArray();
216 for ( int i=0; i<m_Types.getLength(); ++i, ++pPtr )
218 if ( i == 0 )
220 *pPtr = XInvocation::static_type( NULL );
222 else
224 *pPtr = sTypes[ i - 1 ];
228 return m_Types;
231 Reference< XIntrospectionAccess > SAL_CALL
232 DocObjectWrapper::getIntrospection( ) throw (RuntimeException)
234 return NULL;
237 Any SAL_CALL
238 DocObjectWrapper::invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) throw (IllegalArgumentException, CannotConvertException, InvocationTargetException, RuntimeException)
240 if ( m_xAggInv.is() && m_xAggInv->hasMethod( aFunctionName ) )
241 return m_xAggInv->invoke( aFunctionName, aParams, aOutParamIndex, aOutParam );
242 SbMethodRef pMethod = getMethod( aFunctionName );
243 if ( !pMethod )
244 throw RuntimeException();
245 // check number of parameters
246 sal_Int32 nParamsCount = aParams.getLength();
247 SbxInfo* pInfo = pMethod->GetInfo();
248 if ( pInfo )
250 sal_Int32 nSbxOptional = 0;
251 sal_uInt16 n = 1;
252 for ( const SbxParamInfo* pParamInfo = pInfo->GetParam( n ); pParamInfo; pParamInfo = pInfo->GetParam( ++n ) )
254 if ( ( pParamInfo->nFlags & SBX_OPTIONAL ) != 0 )
255 ++nSbxOptional;
256 else
257 nSbxOptional = 0;
259 sal_Int32 nSbxCount = n - 1;
260 if ( nParamsCount < nSbxCount - nSbxOptional )
262 throw RuntimeException( "wrong number of parameters!", Reference< XInterface >() );
265 // set parameters
266 SbxArrayRef xSbxParams;
267 if ( nParamsCount > 0 )
269 xSbxParams = new SbxArray;
270 const Any* pParams = aParams.getConstArray();
271 for ( sal_Int32 i = 0; i < nParamsCount; ++i )
273 SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
274 unoToSbxValue( static_cast< SbxVariable* >( xSbxVar ), pParams[i] );
275 xSbxParams->Put( xSbxVar, static_cast< sal_uInt16 >( i ) + 1 );
277 // Enable passing by ref
278 if ( xSbxVar->GetType() != SbxVARIANT )
279 xSbxVar->SetFlag( SBX_FIXED );
282 if ( xSbxParams.Is() )
283 pMethod->SetParameters( xSbxParams );
285 // call method
286 SbxVariableRef xReturn = new SbxVariable;
288 pMethod->Call( xReturn );
289 Any aReturn;
290 // get output parameters
291 if ( xSbxParams.Is() )
293 SbxInfo* pInfo_ = pMethod->GetInfo();
294 if ( pInfo_ )
296 OutParamMap aOutParamMap;
297 for ( sal_uInt16 n = 1, nCount = xSbxParams->Count(); n < nCount; ++n )
299 const SbxParamInfo* pParamInfo = pInfo_->GetParam( n );
300 if ( pParamInfo && ( pParamInfo->eType & SbxBYREF ) != 0 )
302 SbxVariable* pVar = xSbxParams->Get( n );
303 if ( pVar )
305 SbxVariableRef xVar = pVar;
306 aOutParamMap.insert( OutParamMap::value_type( n - 1, sbxToUnoValue( xVar ) ) );
310 sal_Int32 nOutParamCount = aOutParamMap.size();
311 aOutParamIndex.realloc( nOutParamCount );
312 aOutParam.realloc( nOutParamCount );
313 sal_Int16* pOutParamIndex = aOutParamIndex.getArray();
314 Any* pOutParam = aOutParam.getArray();
315 for ( OutParamMap::iterator aIt = aOutParamMap.begin(); aIt != aOutParamMap.end(); ++aIt, ++pOutParamIndex, ++pOutParam )
317 *pOutParamIndex = aIt->first;
318 *pOutParam = aIt->second;
323 // get return value
324 aReturn = sbxToUnoValue( xReturn );
326 pMethod->SetParameters( NULL );
328 return aReturn;
331 void SAL_CALL
332 DocObjectWrapper::setValue( const OUString& aPropertyName, const Any& aValue ) throw (UnknownPropertyException, CannotConvertException, InvocationTargetException, RuntimeException)
334 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
335 return m_xAggInv->setValue( aPropertyName, aValue );
337 SbPropertyRef pProperty = getProperty( aPropertyName );
338 if ( !pProperty.Is() )
339 throw UnknownPropertyException();
340 unoToSbxValue( (SbxVariable*) pProperty, aValue );
343 Any SAL_CALL
344 DocObjectWrapper::getValue( const OUString& aPropertyName ) throw (UnknownPropertyException, RuntimeException)
346 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
347 return m_xAggInv->getValue( aPropertyName );
349 SbPropertyRef pProperty = getProperty( aPropertyName );
350 if ( !pProperty.Is() )
351 throw UnknownPropertyException();
353 SbxVariable* pProp = ( SbxVariable* ) pProperty;
354 if ( pProp->GetType() == SbxEMPTY )
355 pProperty->Broadcast( SBX_HINT_DATAWANTED );
357 Any aRet = sbxToUnoValue( pProp );
358 return aRet;
361 ::sal_Bool SAL_CALL
362 DocObjectWrapper::hasMethod( const OUString& aName ) throw (RuntimeException)
364 if ( m_xAggInv.is() && m_xAggInv->hasMethod( aName ) )
365 return sal_True;
366 return getMethod( aName ).Is();
369 ::sal_Bool SAL_CALL
370 DocObjectWrapper::hasProperty( const OUString& aName ) throw (RuntimeException)
372 sal_Bool bRes = sal_False;
373 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aName ) )
374 bRes = sal_True;
375 else bRes = getProperty( aName ).Is();
376 return bRes;
379 Any SAL_CALL DocObjectWrapper::queryInterface( const Type& aType )
380 throw ( RuntimeException )
382 Any aRet = DocObjectWrapper_BASE::queryInterface( aType );
383 if ( aRet.hasValue() )
384 return aRet;
385 else if ( m_xAggProxy.is() )
386 aRet = m_xAggProxy->queryAggregation( aType );
387 return aRet;
390 SbMethodRef DocObjectWrapper::getMethod( const OUString& aName ) throw (RuntimeException)
392 SbMethodRef pMethod = NULL;
393 if ( m_pMod )
395 sal_uInt16 nSaveFlgs = m_pMod->GetFlags();
396 // Limit search to this module
397 m_pMod->ResetFlag( SBX_GBLSEARCH );
398 pMethod = (SbMethod*) m_pMod->SbModule::Find( aName, SbxCLASS_METHOD );
399 m_pMod->SetFlags( nSaveFlgs );
402 return pMethod;
405 SbPropertyRef DocObjectWrapper::getProperty( const OUString& aName ) throw (RuntimeException)
407 SbPropertyRef pProperty = NULL;
408 if ( m_pMod )
410 sal_uInt16 nSaveFlgs = m_pMod->GetFlags();
411 // Limit search to this module.
412 m_pMod->ResetFlag( SBX_GBLSEARCH );
413 pProperty = (SbProperty*)m_pMod->SbModule::Find( aName, SbxCLASS_PROPERTY );
414 m_pMod->SetFlag( nSaveFlgs );
417 return pProperty;
420 TYPEINIT1(SbModule,SbxObject)
421 TYPEINIT1(SbMethod,SbxMethod)
422 TYPEINIT1(SbProperty,SbxProperty)
423 TYPEINIT1(SbProcedureProperty,SbxProperty)
424 TYPEINIT1(SbJScriptModule,SbModule)
425 TYPEINIT1(SbJScriptMethod,SbMethod)
426 TYPEINIT1(SbObjModule,SbModule)
427 TYPEINIT1(SbUserFormModule,SbObjModule)
429 uno::Reference< frame::XModel > getDocumentModel( StarBASIC* pb )
431 uno::Reference< frame::XModel > xModel;
432 if( pb && pb->IsDocBasic() )
434 uno::Any aDoc;
435 if( pb->GetUNOConstant( "ThisComponent", aDoc ) )
436 xModel.set( aDoc, uno::UNO_QUERY );
438 return xModel;
441 uno::Reference< vba::XVBACompatibility > getVBACompatibility( const uno::Reference< frame::XModel >& rxModel )
443 uno::Reference< vba::XVBACompatibility > xVBACompat;
446 uno::Reference< beans::XPropertySet > xModelProps( rxModel, uno::UNO_QUERY_THROW );
447 xVBACompat.set( xModelProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY );
449 catch(const uno::Exception& )
452 return xVBACompat;
455 bool getDefaultVBAMode( StarBASIC* pb )
457 uno::Reference< vba::XVBACompatibility > xVBACompat = getVBACompatibility( getDocumentModel( pb ) );
458 return xVBACompat.is() && xVBACompat->getVBACompatibilityMode();
461 class AsyncQuitHandler
463 AsyncQuitHandler() {}
464 AsyncQuitHandler( const AsyncQuitHandler&);
465 public:
466 static AsyncQuitHandler& instance()
468 static AsyncQuitHandler dInst;
469 return dInst;
472 void QuitApplication()
474 uno::Reference< frame::XDesktop2 > xDeskTop = frame::Desktop::create( comphelper::getProcessComponentContext() );
475 xDeskTop->terminate();
477 DECL_LINK( OnAsyncQuit, void* );
480 IMPL_LINK( AsyncQuitHandler, OnAsyncQuit, void*, /*pNull*/ )
482 QuitApplication();
483 return 0L;
486 // A Basic module has set EXTSEARCH, so that the elements, that the modul contains,
487 // could be found from other module.
489 SbModule::SbModule( const OUString& rName, sal_Bool bVBACompat )
490 : SbxObject( "StarBASICModule" ),
491 pImage( NULL ), pBreaks( NULL ), pClassData( NULL ), mbVBACompat( bVBACompat ), pDocObject( NULL ), bIsProxyModule( false )
493 SetName( rName );
494 SetFlag( SBX_EXTSEARCH | SBX_GBLSEARCH );
495 SetModuleType( script::ModuleType::NORMAL );
497 // #i92642: Set name property to intitial name
498 SbxVariable* pNameProp = pProps->Find( "Name", SbxCLASS_PROPERTY );
499 if( pNameProp != NULL )
501 pNameProp->PutString( GetName() );
505 SbModule::~SbModule()
507 SAL_INFO("basic","Module named " << OUStringToOString( GetName(), RTL_TEXTENCODING_UTF8 ).getStr() << " is destructing");
508 delete pImage;
509 delete pBreaks;
510 delete pClassData;
511 mxWrapper = NULL;
514 uno::Reference< script::XInvocation >
515 SbModule::GetUnoModule()
517 if ( !mxWrapper.is() )
518 mxWrapper = new DocObjectWrapper( this );
520 SAL_INFO("basic","Module named " << OUStringToOString( GetName(), RTL_TEXTENCODING_UTF8 ).getStr() << " returning wrapper mxWrapper (0x" << mxWrapper.get() <<")" );
521 return mxWrapper;
524 sal_Bool SbModule::IsCompiled() const
526 return sal_Bool( pImage != 0 );
529 const SbxObject* SbModule::FindType( OUString aTypeName ) const
531 return pImage ? pImage->FindType( aTypeName ) : NULL;
535 // From the code generator: deletion of images and the oposite of validation for entries
537 void SbModule::StartDefinitions()
539 delete pImage; pImage = NULL;
540 if( pClassData )
541 pClassData->clear();
543 // methods and properties persist, but they are invalid;
544 // at least are the information under certain conditions clogged
545 sal_uInt16 i;
546 for( i = 0; i < pMethods->Count(); i++ )
548 SbMethod* p = PTR_CAST(SbMethod,pMethods->Get( i ) );
549 if( p )
550 p->bInvalid = sal_True;
552 for( i = 0; i < pProps->Count(); )
554 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
555 if( p )
556 pProps->Remove( i );
557 else
558 i++;
562 // request/create method
564 SbMethod* SbModule::GetMethod( const OUString& rName, SbxDataType t )
566 SbxVariable* p = pMethods->Find( rName, SbxCLASS_METHOD );
567 SbMethod* pMeth = p ? PTR_CAST(SbMethod,p) : NULL;
568 if( p && !pMeth )
570 pMethods->Remove( p );
572 if( !pMeth )
574 pMeth = new SbMethod( rName, t, this );
575 pMeth->SetParent( this );
576 pMeth->SetFlags( SBX_READ );
577 pMethods->Put( pMeth, pMethods->Count() );
578 StartListening( pMeth->GetBroadcaster(), sal_True );
580 // The method is per default valid, because it could be
581 // created from the compiler (code generator) as well.
582 pMeth->bInvalid = sal_False;
583 pMeth->ResetFlag( SBX_FIXED );
584 pMeth->SetFlag( SBX_WRITE );
585 pMeth->SetType( t );
586 pMeth->ResetFlag( SBX_WRITE );
587 if( t != SbxVARIANT )
589 pMeth->SetFlag( SBX_FIXED );
591 return pMeth;
594 // request/create property
596 SbProperty* SbModule::GetProperty( const OUString& rName, SbxDataType t )
598 SbxVariable* p = pProps->Find( rName, SbxCLASS_PROPERTY );
599 SbProperty* pProp = p ? PTR_CAST(SbProperty,p) : NULL;
600 if( p && !pProp )
602 pProps->Remove( p );
604 if( !pProp )
606 pProp = new SbProperty( rName, t, this );
607 pProp->SetFlag( SBX_READWRITE );
608 pProp->SetParent( this );
609 pProps->Put( pProp, pProps->Count() );
610 StartListening( pProp->GetBroadcaster(), sal_True );
612 return pProp;
615 SbProcedureProperty* SbModule::GetProcedureProperty( const OUString& rName, SbxDataType t )
617 SbxVariable* p = pProps->Find( rName, SbxCLASS_PROPERTY );
618 SbProcedureProperty* pProp = p ? PTR_CAST(SbProcedureProperty,p) : NULL;
619 if( p && !pProp )
621 pProps->Remove( p );
623 if( !pProp )
625 pProp = new SbProcedureProperty( rName, t );
626 pProp->SetFlag( SBX_READWRITE );
627 pProp->SetParent( this );
628 pProps->Put( pProp, pProps->Count() );
629 StartListening( pProp->GetBroadcaster(), sal_True );
631 return pProp;
634 SbIfaceMapperMethod* SbModule::GetIfaceMapperMethod( const OUString& rName, SbMethod* pImplMeth )
636 SbxVariable* p = pMethods->Find( rName, SbxCLASS_METHOD );
637 SbIfaceMapperMethod* pMapperMethod = p ? PTR_CAST(SbIfaceMapperMethod,p) : NULL;
638 if( p && !pMapperMethod )
640 pMethods->Remove( p );
642 if( !pMapperMethod )
644 pMapperMethod = new SbIfaceMapperMethod( rName, pImplMeth );
645 pMapperMethod->SetParent( this );
646 pMapperMethod->SetFlags( SBX_READ );
647 pMethods->Put( pMapperMethod, pMethods->Count() );
649 pMapperMethod->bInvalid = sal_False;
650 return pMapperMethod;
653 SbIfaceMapperMethod::~SbIfaceMapperMethod()
657 TYPEINIT1(SbIfaceMapperMethod,SbMethod)
660 // From the code generator: remove invalid entries
662 void SbModule::EndDefinitions( sal_Bool bNewState )
664 for( sal_uInt16 i = 0; i < pMethods->Count(); )
666 SbMethod* p = PTR_CAST(SbMethod,pMethods->Get( i ) );
667 if( p )
669 if( p->bInvalid )
671 pMethods->Remove( p );
673 else
675 p->bInvalid = bNewState;
676 i++;
679 else
680 i++;
682 SetModified( sal_True );
685 void SbModule::Clear()
687 delete pImage; pImage = NULL;
688 if( pClassData )
689 pClassData->clear();
690 SbxObject::Clear();
694 SbxVariable* SbModule::Find( const OUString& rName, SbxClassType t )
696 // make sure a search in an uninstatiated class module will fail
697 SbxVariable* pRes = SbxObject::Find( rName, t );
698 if ( bIsProxyModule && !GetSbData()->bRunInit )
700 return NULL;
702 if( !pRes && pImage )
704 SbiInstance* pInst = GetSbData()->pInst;
705 if( pInst && pInst->IsCompatibility() )
707 // Put enum types as objects into module,
708 // allows MyEnum.First notation
709 SbxArrayRef xArray = pImage->GetEnums();
710 if( xArray.Is() )
712 SbxVariable* pEnumVar = xArray->Find( rName, SbxCLASS_DONTCARE );
713 SbxObject* pEnumObject = PTR_CAST( SbxObject, pEnumVar );
714 if( pEnumObject )
716 bool bPrivate = pEnumObject->IsSet( SBX_PRIVATE );
717 OUString aEnumName = pEnumObject->GetName();
719 pRes = new SbxVariable( SbxOBJECT );
720 pRes->SetName( aEnumName );
721 pRes->SetParent( this );
722 pRes->SetFlag( SBX_READ );
723 if( bPrivate )
725 pRes->SetFlag( SBX_PRIVATE );
727 pRes->PutObject( pEnumObject );
732 return pRes;
735 const OUString& SbModule::GetSource32() const
737 return aOUSource;
740 const OUString& SbModule::GetSource() const
742 static OUString aRetStr;
743 aRetStr = aOUSource;
744 return aRetStr;
747 // Parent and BASIC are one!
749 void SbModule::SetParent( SbxObject* p )
751 pParent = p;
754 void SbModule::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
755 const SfxHint& rHint, const TypeId& rHintType )
757 const SbxHint* pHint = PTR_CAST(SbxHint,&rHint);
758 if( pHint )
760 SbxVariable* pVar = pHint->GetVar();
761 SbProperty* pProp = PTR_CAST(SbProperty,pVar);
762 SbMethod* pMeth = PTR_CAST(SbMethod,pVar);
763 SbProcedureProperty* pProcProperty = PTR_CAST( SbProcedureProperty, pVar );
764 if( pProcProperty )
767 if( pHint->GetId() == SBX_HINT_DATAWANTED )
769 OUString aProcName("Property Get ");
770 aProcName += pProcProperty->GetName();
772 SbxVariable* pMethVar = Find( aProcName, SbxCLASS_METHOD );
773 if( pMethVar )
775 SbxValues aVals;
776 aVals.eType = SbxVARIANT;
778 SbxArray* pArg = pVar->GetParameters();
779 sal_uInt16 nVarParCount = (pArg != NULL) ? pArg->Count() : 0;
780 if( nVarParCount > 1 )
782 SbxArrayRef xMethParameters = new SbxArray;
783 xMethParameters->Put( pMethVar, 0 ); // Method as parameter 0
784 for( sal_uInt16 i = 1 ; i < nVarParCount ; ++i )
786 SbxVariable* pPar = pArg->Get( i );
787 xMethParameters->Put( pPar, i );
790 pMethVar->SetParameters( xMethParameters );
791 pMethVar->Get( aVals );
792 pMethVar->SetParameters( NULL );
794 else
796 pMethVar->Get( aVals );
799 pVar->Put( aVals );
802 else if( pHint->GetId() == SBX_HINT_DATACHANGED )
804 SbxVariable* pMethVar = NULL;
806 bool bSet = pProcProperty->isSet();
807 if( bSet )
809 pProcProperty->setSet( false );
811 OUString aProcName("Property Set ");
812 aProcName += pProcProperty->GetName();
813 pMethVar = Find( aProcName, SbxCLASS_METHOD );
815 if( !pMethVar ) // Let
817 OUString aProcName("Property Let " );
818 aProcName += pProcProperty->GetName();
819 pMethVar = Find( aProcName, SbxCLASS_METHOD );
822 if( pMethVar )
824 // Setup parameters
825 SbxArrayRef xArray = new SbxArray;
826 xArray->Put( pMethVar, 0 ); // Method as parameter 0
827 xArray->Put( pVar, 1 );
828 pMethVar->SetParameters( xArray );
830 SbxValues aVals;
831 pMethVar->Get( aVals );
832 pMethVar->SetParameters( NULL );
836 if( pProp )
838 if( pProp->GetModule() != this )
839 SetError( SbxERR_BAD_ACTION );
841 else if( pMeth )
843 if( pHint->GetId() == SBX_HINT_DATAWANTED )
845 if( pMeth->bInvalid && !Compile() )
847 // auto compile has not worked!
848 StarBASIC::Error( SbERR_BAD_PROP_VALUE );
850 else
852 // Call of a subprogram
853 SbModule* pOld = GetSbData()->pMod;
854 GetSbData()->pMod = this;
855 Run( (SbMethod*) pVar );
856 GetSbData()->pMod = pOld;
860 else
862 // #i92642: Special handling for name property to avoid
863 // side effects when using name as variable implicitely
864 bool bForwardToSbxObject = true;
866 sal_uIntPtr nId = pHint->GetId();
867 if( (nId == SBX_HINT_DATAWANTED || nId == SBX_HINT_DATACHANGED) &&
868 pVar->GetName().equalsIgnoreAsciiCase( "name" ) )
870 bForwardToSbxObject = false;
872 if( bForwardToSbxObject )
874 SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType );
880 // The setting of the source makes the image invalid
881 // and scans the method definitions newly in
883 void SbModule::SetSource( const OUString& r )
885 SetSource32( r );
888 void SbModule::SetSource32( const OUString& r )
890 // Default basic mode to library container mode, but.. allow Option VBASupport 0/1 override
891 SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) );
892 aOUSource = r;
893 StartDefinitions();
894 SbiTokenizer aTok( r );
895 aTok.SetCompatible( IsVBACompat() );
897 while( !aTok.IsEof() )
899 SbiToken eEndTok = NIL;
901 // Searching for SUB or FUNCTION
902 SbiToken eLastTok = NIL;
903 while( !aTok.IsEof() )
905 // #32385: not by declare
906 SbiToken eCurTok = aTok.Next();
907 if( eLastTok != DECLARE )
909 if( eCurTok == SUB )
911 eEndTok = ENDSUB; break;
913 if( eCurTok == FUNCTION )
915 eEndTok = ENDFUNC; break;
917 if( eCurTok == PROPERTY )
919 eEndTok = ENDPROPERTY; break;
921 if( eCurTok == OPTION )
923 eCurTok = aTok.Next();
924 if( eCurTok == COMPATIBLE )
926 aTok.SetCompatible( true );
928 else if ( ( eCurTok == VBASUPPORT ) && ( aTok.Next() == NUMBER ) )
930 sal_Bool bIsVBA = ( aTok.GetDbl()== 1 );
931 SetVBACompat( bIsVBA );
932 aTok.SetCompatible( bIsVBA );
936 eLastTok = eCurTok;
938 // Definition of the method
939 SbMethod* pMeth = NULL;
940 if( eEndTok != NIL )
942 sal_uInt16 nLine1 = aTok.GetLine();
943 if( aTok.Next() == SYMBOL )
945 OUString aName_( aTok.GetSym() );
946 SbxDataType t = aTok.GetType();
947 if( t == SbxVARIANT && eEndTok == ENDSUB )
949 t = SbxVOID;
951 pMeth = GetMethod( aName_, t );
952 pMeth->nLine1 = pMeth->nLine2 = nLine1;
953 // The method is for a start VALID
954 pMeth->bInvalid = sal_False;
956 else
958 eEndTok = NIL;
961 // Skip up to END SUB/END FUNCTION
962 if( eEndTok != NIL )
964 while( !aTok.IsEof() )
966 if( aTok.Next() == eEndTok )
968 pMeth->nLine2 = aTok.GetLine();
969 break;
972 if( aTok.IsEof() )
974 pMeth->nLine2 = aTok.GetLine();
978 EndDefinitions( sal_True );
981 // Broadcast of a hint to all Basics
983 static void _SendHint( SbxObject* pObj, sal_uIntPtr nId, SbMethod* p )
985 // Self a BASIC?
986 if( pObj->IsA( TYPE(StarBASIC) ) && pObj->IsBroadcaster() )
987 pObj->GetBroadcaster().Broadcast( SbxHint( nId, p ) );
988 // Then ask for the subobjects
989 SbxArray* pObjs = pObj->GetObjects();
990 for( sal_uInt16 i = 0; i < pObjs->Count(); i++ )
992 SbxVariable* pVar = pObjs->Get( i );
993 if( pVar->IsA( TYPE(SbxObject) ) )
994 _SendHint( PTR_CAST(SbxObject,pVar), nId, p );
998 static void SendHint( SbxObject* pObj, sal_uIntPtr nId, SbMethod* p )
1000 while( pObj->GetParent() )
1001 pObj = pObj->GetParent();
1002 _SendHint( pObj, nId, p );
1005 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1006 // at the end of the program, so that nothing were helt.
1007 void ClearUnoObjectsInRTL_Impl_Rek( StarBASIC* pBasic )
1009 // delete the return value of CreateUnoService
1010 static OUString aName("CreateUnoService");
1011 SbxVariable* pVar = pBasic->GetRtl()->Find( aName, SbxCLASS_METHOD );
1012 if( pVar )
1014 pVar->SbxValue::Clear();
1016 // delete the return value of CreateUnoDialog
1017 static OUString aName2("CreateUnoDialog");
1018 pVar = pBasic->GetRtl()->Find( aName2, SbxCLASS_METHOD );
1019 if( pVar )
1021 pVar->SbxValue::Clear();
1023 // delete the return value of CDec
1024 static OUString aName3("CDec");
1025 pVar = pBasic->GetRtl()->Find( aName3, SbxCLASS_METHOD );
1026 if( pVar )
1028 pVar->SbxValue::Clear();
1030 // delete return value of CreateObject
1031 static OUString aName4("CreateObject");
1032 pVar = pBasic->GetRtl()->Find( aName4, SbxCLASS_METHOD );
1033 if( pVar )
1035 pVar->SbxValue::Clear();
1037 // Go over all Sub-Basics
1038 SbxArray* pObjs = pBasic->GetObjects();
1039 sal_uInt16 nCount = pObjs->Count();
1040 for( sal_uInt16 i = 0 ; i < nCount ; i++ )
1042 SbxVariable* pObjVar = pObjs->Get( i );
1043 StarBASIC* pSubBasic = PTR_CAST( StarBASIC, pObjVar );
1044 if( pSubBasic )
1046 ClearUnoObjectsInRTL_Impl_Rek( pSubBasic );
1051 void ClearUnoObjectsInRTL_Impl( StarBASIC* pBasic )
1053 // #67781 Delete return values of the Uno-methods
1054 clearUnoMethods();
1055 clearUnoServiceCtors();
1057 ClearUnoObjectsInRTL_Impl_Rek( pBasic );
1059 // Search for the topmost Basic
1060 SbxObject* p = pBasic;
1061 while( p->GetParent() )
1062 p = p->GetParent();
1063 if( ((StarBASIC*)p) != pBasic )
1064 ClearUnoObjectsInRTL_Impl_Rek( (StarBASIC*)p );
1067 bool SbModule::IsVBACompat() const
1069 return mbVBACompat;
1072 void SbModule::SetVBACompat( bool bCompat )
1074 if( mbVBACompat != bCompat )
1076 mbVBACompat = bCompat;
1077 // initialize VBA document API
1078 if( mbVBACompat ) try
1080 StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
1081 uno::Reference< lang::XMultiServiceFactory > xFactory( getDocumentModel( pBasic ), uno::UNO_QUERY_THROW );
1082 xFactory->createInstance( "ooo.vba.VBAGlobals" );
1084 catch( Exception& )
1090 // Run a Basic-subprogram
1091 sal_uInt16 SbModule::Run( SbMethod* pMeth )
1093 SAL_INFO("basic","About to run " << OUStringToOString( pMeth->GetName(), RTL_TEXTENCODING_UTF8 ).getStr() << ", vba compatmode is " << mbVBACompat );
1094 static sal_uInt16 nMaxCallLevel = 0;
1096 sal_uInt16 nRes = 0;
1097 bool bDelInst = ( GetSbData()->pInst == NULL );
1098 bool bQuit = false;
1099 StarBASICRef xBasic;
1100 uno::Reference< frame::XModel > xModel;
1101 uno::Reference< script::vba::XVBACompatibility > xVBACompat;
1102 if( bDelInst )
1104 // #32779: Hold Basic during the execution
1105 xBasic = (StarBASIC*) GetParent();
1107 GetSbData()->pInst = new SbiInstance( (StarBASIC*) GetParent() );
1109 /* If a VBA script in a document is started, get the VBA compatibility
1110 interface from the document Basic library container, and notify all
1111 VBA script listeners about the started script. */
1112 if( mbVBACompat )
1114 StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
1115 if( pBasic && pBasic->IsDocBasic() ) try
1117 xModel.set( getDocumentModel( pBasic ), uno::UNO_SET_THROW );
1118 xVBACompat.set( getVBACompatibility( xModel ), uno::UNO_SET_THROW );
1119 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STARTED, GetName() );
1121 catch(const uno::Exception& )
1126 // Launcher problem
1127 // i80726 The Find below will genarate an error in Testtool so we reset it unless there was one before already
1128 bool bWasError = SbxBase::GetError() != 0;
1129 SbxVariable* pMSOMacroRuntimeLibVar = Find( "Launcher", SbxCLASS_OBJECT );
1130 if ( !bWasError && (SbxBase::GetError() == SbxERR_PROC_UNDEFINED) )
1131 SbxBase::ResetError();
1132 if( pMSOMacroRuntimeLibVar )
1134 StarBASIC* pMSOMacroRuntimeLib = PTR_CAST(StarBASIC,pMSOMacroRuntimeLibVar);
1135 if( pMSOMacroRuntimeLib )
1137 sal_uInt16 nGblFlag = pMSOMacroRuntimeLib->GetFlags() & SBX_GBLSEARCH;
1138 pMSOMacroRuntimeLib->ResetFlag( SBX_GBLSEARCH );
1139 SbxVariable* pAppSymbol = pMSOMacroRuntimeLib->Find( "Application", SbxCLASS_METHOD );
1140 pMSOMacroRuntimeLib->SetFlag( nGblFlag );
1141 if( pAppSymbol )
1143 pMSOMacroRuntimeLib->SetFlag( SBX_EXTSEARCH ); // Could have been disabled before
1144 GetSbData()->pMSOMacroRuntimLib = pMSOMacroRuntimeLib;
1149 if( nMaxCallLevel == 0 )
1151 #ifdef UNX
1152 struct rlimit rl;
1153 getrlimit ( RLIMIT_STACK, &rl );
1154 #endif
1155 #if defined LINUX
1156 // Empiric value, 900 = needed bytes/Basic call level
1157 // for Linux including 10% safety margin
1158 nMaxCallLevel = rl.rlim_cur / 900;
1159 #elif defined SOLARIS
1160 // Empiric value, 1650 = needed bytes/Basic call level
1161 // for Solaris including 10% safety margin
1162 nMaxCallLevel = rl.rlim_cur / 1650;
1163 #elif defined WIN32
1164 nMaxCallLevel = 5800;
1165 #else
1166 nMaxCallLevel = MAXRECURSION;
1167 #endif
1171 // Recursion to deep?
1172 if( ++GetSbData()->pInst->nCallLvl <= nMaxCallLevel )
1174 // Define a globale variable in all Mods
1175 GlobalRunInit( /* bBasicStart = */ bDelInst );
1177 // Appeared a compiler error? Then we don't launch
1178 if( !GetSbData()->bGlobalInitErr )
1180 if( bDelInst )
1182 SendHint( GetParent(), SBX_HINT_BASICSTART, pMeth );
1184 // 1996-10-16: #31460 New concept for StepInto/Over/Out
1185 // For an explanation see runtime.cxx at SbiInstance::CalcBreakCallLevel()
1186 // Identify the BreakCallLevel
1187 GetSbData()->pInst->CalcBreakCallLevel( pMeth->GetDebugFlags() );
1190 SbModule* pOldMod = GetSbData()->pMod;
1191 GetSbData()->pMod = this;
1192 SbiRuntime* pRt = new SbiRuntime( this, pMeth, pMeth->nStart );
1194 pRt->pNext = GetSbData()->pInst->pRun;
1195 if( pRt->pNext )
1196 pRt->pNext->block();
1197 GetSbData()->pInst->pRun = pRt;
1198 if ( mbVBACompat )
1200 GetSbData()->pInst->EnableCompatibility( sal_True );
1202 while( pRt->Step() ) {}
1203 if( pRt->pNext )
1204 pRt->pNext->unblock();
1206 // #63710 It can happen by an another thread handling at events,
1207 // that the show call returns to an dialog (by closing the
1208 // dialog per UI), before a by an event triggered further call returned,
1209 // which stands in Basic more top in the stack and that had been run on
1210 // a Basic-Breakpoint. Then would the instance below destroyed. And if the Basic,
1211 // that stand still in the call, further runs, there is a GPF.
1212 // Thus here had to be wait until the other call comes back.
1213 if( bDelInst )
1215 // Compare here with 1 instead of 0, because before nCallLvl--
1216 while( GetSbData()->pInst->nCallLvl != 1 )
1217 GetpApp()->Yield();
1220 nRes = sal_True;
1221 GetSbData()->pInst->pRun = pRt->pNext;
1222 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1224 // Exist an higher-ranking runtime instance?
1225 // Then take over SbDEBUG_BREAK, if set
1226 SbiRuntime* pRtNext = pRt->pNext;
1227 if( pRtNext && (pRt->GetDebugFlags() & SbDEBUG_BREAK) )
1228 pRtNext->SetDebugFlags( SbDEBUG_BREAK );
1230 delete pRt;
1231 GetSbData()->pMod = pOldMod;
1232 if( bDelInst )
1234 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1235 // at the end of the program, so that nothing were helt.
1236 ClearUnoObjectsInRTL_Impl( xBasic );
1238 clearNativeObjectWrapperVector();
1240 SAL_WARN_IF(GetSbData()->pInst->nCallLvl != 0,"basic","BASIC-Call-Level > 0");
1241 delete GetSbData()->pInst, GetSbData()->pInst = NULL, bDelInst = false;
1243 // #i30690
1244 SolarMutexGuard aSolarGuard;
1245 SendHint( GetParent(), SBX_HINT_BASICSTOP, pMeth );
1247 GlobalRunDeInit();
1249 #ifdef DBG_UTIL
1250 ResetCapturedAssertions();
1251 #endif
1253 if( xVBACompat.is() )
1255 // notify all VBA script listeners about the stopped script
1258 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STOPPED, GetName() );
1260 catch(const uno::Exception& )
1263 // VBA always ensures screenupdating is enabled after completing
1264 ::basic::vba::lockControllersOfAllDocuments( xModel, sal_False );
1265 ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, sal_True );
1268 #ifdef DBG_TRACE_BASIC
1269 dbg_DeInitTrace();
1270 #endif
1273 else
1274 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1276 else
1278 GetSbData()->pInst->nCallLvl--; // Call-Level down again
1279 StarBASIC::FatalError( SbERR_STACK_OVERFLOW );
1282 StarBASIC* pBasic = PTR_CAST(StarBASIC,GetParent());
1283 if( bDelInst )
1285 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1286 // the end of the program, so that nothing were helt.
1287 ClearUnoObjectsInRTL_Impl( xBasic );
1289 delete GetSbData()->pInst;
1290 GetSbData()->pInst = NULL;
1292 if ( pBasic && pBasic->IsDocBasic() && pBasic->IsQuitApplication() && !GetSbData()->pInst )
1293 bQuit = true;
1294 if ( bQuit )
1296 Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ), NULL );
1299 return nRes;
1302 // Execute of the init method of a module after the loading
1303 // or the compilation
1305 void SbModule::RunInit()
1307 if( pImage
1308 && !pImage->bInit
1309 && pImage->GetFlag( SBIMG_INITCODE ) )
1311 // Set flag, so that RunInit get activ (Testtool)
1312 GetSbData()->bRunInit = true;
1314 SbModule* pOldMod = GetSbData()->pMod;
1315 GetSbData()->pMod = this;
1316 // The init code starts always here
1317 SbiRuntime* pRt = new SbiRuntime( this, NULL, 0 );
1319 pRt->pNext = GetSbData()->pInst->pRun;
1320 GetSbData()->pInst->pRun = pRt;
1321 while( pRt->Step() ) {}
1323 GetSbData()->pInst->pRun = pRt->pNext;
1324 delete pRt;
1325 GetSbData()->pMod = pOldMod;
1326 pImage->bInit = true;
1327 pImage->bFirstInit = false;
1329 // RunInit is not activ anymore
1330 GetSbData()->bRunInit = false;
1334 // Delete with private/dim declared variables
1336 void SbModule::AddVarName( const OUString& aName )
1338 // see if the name is added already
1339 std::vector< OUString >::iterator it_end = mModuleVariableNames.end();
1340 for ( std::vector< OUString >::iterator it = mModuleVariableNames.begin(); it != it_end; ++it )
1342 if ( aName == *it )
1343 return;
1345 mModuleVariableNames.push_back( aName );
1348 void SbModule::RemoveVars()
1350 std::vector< OUString >::iterator it_end = mModuleVariableNames.end();
1351 for ( std::vector< OUString >::iterator it = mModuleVariableNames.begin(); it != it_end; ++it )
1353 // We don't want a Find being called in a derived class ( e.g.
1354 // SbUserform because it could trigger say an initialise event
1355 // 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 )
1356 SbxVariableRef p = SbModule::Find( *it, SbxCLASS_PROPERTY );
1357 if( p.Is() )
1358 Remove (p);
1362 void SbModule::ClearPrivateVars()
1364 for( sal_uInt16 i = 0 ; i < pProps->Count() ; i++ )
1366 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
1367 if( p )
1369 // Delete not the arrays, only their content
1370 if( p->GetType() & SbxARRAY )
1372 SbxArray* pArray = PTR_CAST(SbxArray,p->GetObject());
1373 if( pArray )
1375 for( sal_uInt16 j = 0 ; j < pArray->Count() ; j++ )
1377 SbxVariable* pj = PTR_CAST(SbxVariable,pArray->Get( j ));
1378 pj->SbxValue::Clear();
1382 else
1384 p->SbxValue::Clear();
1390 void SbModule::implClearIfVarDependsOnDeletedBasic( SbxVariable* pVar, StarBASIC* pDeletedBasic )
1392 if( pVar->SbxValue::GetType() != SbxOBJECT || pVar->ISA( SbProcedureProperty ) )
1393 return;
1395 SbxObject* pObj = PTR_CAST(SbxObject,pVar->GetObject());
1396 if( pObj != NULL )
1398 SbxObject* p = pObj;
1400 SbModule* pMod = PTR_CAST( SbModule, p );
1401 if( pMod != NULL )
1402 pMod->ClearVarsDependingOnDeletedBasic( pDeletedBasic );
1404 while( (p = p->GetParent()) != NULL )
1406 StarBASIC* pBasic = PTR_CAST( StarBASIC, p );
1407 if( pBasic != NULL && pBasic == pDeletedBasic )
1409 pVar->SbxValue::Clear();
1410 break;
1416 void SbModule::ClearVarsDependingOnDeletedBasic( StarBASIC* pDeletedBasic )
1418 (void)pDeletedBasic;
1420 for( sal_uInt16 i = 0 ; i < pProps->Count() ; i++ )
1422 SbProperty* p = PTR_CAST(SbProperty,pProps->Get( i ) );
1423 if( p )
1425 if( p->GetType() & SbxARRAY )
1427 SbxArray* pArray = PTR_CAST(SbxArray,p->GetObject());
1428 if( pArray )
1430 for( sal_uInt16 j = 0 ; j < pArray->Count() ; j++ )
1432 SbxVariable* pVar = PTR_CAST(SbxVariable,pArray->Get( j ));
1433 implClearIfVarDependsOnDeletedBasic( pVar, pDeletedBasic );
1437 else
1439 implClearIfVarDependsOnDeletedBasic( p, pDeletedBasic );
1445 void StarBASIC::ClearAllModuleVars( void )
1447 // Initialise the own module
1448 for ( sal_uInt16 nMod = 0; nMod < pModules->Count(); nMod++ )
1450 SbModule* pModule = (SbModule*)pModules->Get( nMod );
1451 // Initialise only, if the startcode was already executed
1452 if( pModule->pImage && pModule->pImage->bInit && !pModule->isProxyModule() && !pModule->ISA(SbObjModule) )
1453 pModule->ClearPrivateVars();
1458 // Execution of the init-code of all module
1459 void SbModule::GlobalRunInit( bool bBasicStart )
1461 // If no Basic-Start, only initialise, if the module is not initialised
1462 if( !bBasicStart )
1463 if( !(pImage && !pImage->bInit) )
1464 return;
1466 // Initialise GlobalInitErr-Flag for Compiler-Error
1467 // With the help of this flags could be located in SbModule::Run() after the call of
1468 // GlobalRunInit, if at the intialising of the module
1469 // an error occurred. Then it will not be launched.
1470 GetSbData()->bGlobalInitErr = false;
1472 // Parent of the module is a Basic
1473 StarBASIC *pBasic = PTR_CAST(StarBASIC,GetParent());
1474 if( pBasic )
1476 pBasic->InitAllModules();
1478 SbxObject* pParent_ = pBasic->GetParent();
1479 if( pParent_ )
1481 StarBASIC * pParentBasic = PTR_CAST(StarBASIC,pParent_);
1482 if( pParentBasic )
1484 pParentBasic->InitAllModules( pBasic );
1486 // #109018 Parent can also have a parent (library in doc)
1487 SbxObject* pParentParent = pParentBasic->GetParent();
1488 if( pParentParent )
1490 StarBASIC * pParentParentBasic = PTR_CAST(StarBASIC,pParentParent);
1491 if( pParentParentBasic )
1492 pParentParentBasic->InitAllModules( pParentBasic );
1499 void SbModule::GlobalRunDeInit( void )
1501 StarBASIC *pBasic = PTR_CAST(StarBASIC,GetParent());
1502 if( pBasic )
1504 pBasic->DeInitAllModules();
1506 SbxObject* pParent_ = pBasic->GetParent();
1507 if( pParent_ )
1508 pBasic = PTR_CAST(StarBASIC,pParent_);
1509 if( pBasic )
1510 pBasic->DeInitAllModules();
1514 // Search for the next STMNT-Command in the code. This was used from the STMNT-
1515 // Opcode to set the endcolumn.
1517 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol ) const
1519 return FindNextStmnt( p, nLine, nCol, sal_False );
1522 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol,
1523 sal_Bool bFollowJumps, const SbiImage* pImg ) const
1525 sal_uInt32 nPC = (sal_uInt32) ( p - (const sal_uInt8*) pImage->GetCode() );
1526 while( nPC < pImage->GetCodeSize() )
1528 SbiOpcode eOp = (SbiOpcode ) ( *p++ );
1529 nPC++;
1530 if( bFollowJumps && eOp == _JUMP && pImg )
1532 SAL_WARN_IF( !pImg, "basic", "FindNextStmnt: pImg==NULL with FollowJumps option" );
1533 sal_uInt32 nOp1 = *p++; nOp1 |= *p++ << 8;
1534 nOp1 |= *p++ << 16; nOp1 |= *p++ << 24;
1535 p = (const sal_uInt8*) pImg->GetCode() + nOp1;
1537 else if( eOp >= SbOP1_START && eOp <= SbOP1_END )
1538 p += 4, nPC += 4;
1539 else if( eOp == _STMNT )
1541 sal_uInt32 nl, nc;
1542 nl = *p++; nl |= *p++ << 8;
1543 nl |= *p++ << 16 ; nl |= *p++ << 24;
1544 nc = *p++; nc |= *p++ << 8;
1545 nc |= *p++ << 16 ; nc |= *p++ << 24;
1546 nLine = (sal_uInt16)nl; nCol = (sal_uInt16)nc;
1547 return p;
1549 else if( eOp >= SbOP2_START && eOp <= SbOP2_END )
1550 p += 8, nPC += 8;
1551 else if( !( eOp >= SbOP0_START && eOp <= SbOP0_END ) )
1553 StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
1554 break;
1557 return NULL;
1560 // Test, if a line contains STMNT-Opcodes
1562 sal_Bool SbModule::IsBreakable( sal_uInt16 nLine ) const
1564 if( !pImage )
1565 return sal_False;
1566 const sal_uInt8* p = (const sal_uInt8* ) pImage->GetCode();
1567 sal_uInt16 nl, nc;
1568 while( ( p = FindNextStmnt( p, nl, nc ) ) != NULL )
1569 if( nl == nLine )
1570 return sal_True;
1571 return sal_False;
1574 sal_Bool SbModule::IsBP( sal_uInt16 nLine ) const
1576 if( pBreaks )
1578 for( size_t i = 0; i < pBreaks->size(); i++ )
1580 sal_uInt16 b = pBreaks->operator[]( i );
1581 if( b == nLine )
1582 return sal_True;
1583 if( b < nLine )
1584 break;
1587 return sal_False;
1590 sal_Bool SbModule::SetBP( sal_uInt16 nLine )
1592 if( !IsBreakable( nLine ) )
1593 return sal_False;
1594 if( !pBreaks )
1595 pBreaks = new SbiBreakpoints;
1596 size_t i;
1597 for( i = 0; i < pBreaks->size(); i++ )
1599 sal_uInt16 b = pBreaks->operator[]( i );
1600 if( b == nLine )
1601 return sal_True;
1602 if( b < nLine )
1603 break;
1605 pBreaks->insert( pBreaks->begin() + i, nLine );
1607 // #38568: Set during runtime as well here SbDEBUG_BREAK
1608 if( GetSbData()->pInst && GetSbData()->pInst->pRun )
1609 GetSbData()->pInst->pRun->SetDebugFlags( SbDEBUG_BREAK );
1611 return IsBreakable( nLine );
1614 sal_Bool SbModule::ClearBP( sal_uInt16 nLine )
1616 sal_Bool bRes = sal_False;
1617 if( pBreaks )
1619 for( size_t i = 0; i < pBreaks->size(); i++ )
1621 sal_uInt16 b = pBreaks->operator[]( i );
1622 if( b == nLine )
1624 pBreaks->erase( pBreaks->begin() + i );
1625 bRes = sal_True;
1626 break;
1628 if( b < nLine )
1629 break;
1631 if( pBreaks->empty() )
1632 delete pBreaks, pBreaks = NULL;
1634 return bRes;
1637 void SbModule::ClearAllBP()
1639 delete pBreaks;
1640 pBreaks = NULL;
1643 void
1644 SbModule::fixUpMethodStart( bool bCvtToLegacy, SbiImage* pImg ) const
1646 if ( !pImg )
1647 pImg = pImage;
1648 for( sal_uInt32 i = 0; i < pMethods->Count(); i++ )
1650 SbMethod* pMeth = PTR_CAST(SbMethod,pMethods->Get( (sal_uInt16)i ) );
1651 if( pMeth )
1653 //fixup method start positions
1654 if ( bCvtToLegacy )
1655 pMeth->nStart = pImg->CalcLegacyOffset( pMeth->nStart );
1656 else
1657 pMeth->nStart = pImg->CalcNewOffset( (sal_uInt16)pMeth->nStart );
1663 sal_Bool SbModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
1665 Clear();
1666 if( !SbxObject::LoadData( rStrm, 1 ) )
1667 return sal_False;
1668 // As a precaution...
1669 SetFlag( SBX_EXTSEARCH | SBX_GBLSEARCH );
1670 sal_uInt8 bImage;
1671 rStrm >> bImage;
1672 if( bImage )
1674 SbiImage* p = new SbiImage;
1675 sal_uInt32 nImgVer = 0;
1677 if( !p->Load( rStrm, nImgVer ) )
1679 delete p;
1680 return sal_False;
1682 // If the image is in old format, we fix up the method start offsets
1683 if ( nImgVer < B_EXT_IMG_VERSION )
1685 fixUpMethodStart( false, p );
1686 p->ReleaseLegacyBuffer();
1688 aComment = p->aComment;
1689 SetName( p->aName );
1690 if( p->GetCodeSize() )
1692 aOUSource = p->aOUSource;
1693 // Old version: image away
1694 if( nVer == 1 )
1696 SetSource32( p->aOUSource );
1697 delete p;
1699 else
1700 pImage = p;
1702 else
1704 SetSource32( p->aOUSource );
1705 delete p;
1708 return sal_True;
1711 sal_Bool SbModule::StoreData( SvStream& rStrm ) const
1713 bool bFixup = ( pImage && !pImage->ExceedsLegacyLimits() );
1714 if ( bFixup )
1715 fixUpMethodStart( true );
1716 sal_Bool bRet = SbxObject::StoreData( rStrm );
1717 if ( !bRet )
1718 return sal_False;
1720 if( pImage )
1722 pImage->aOUSource = aOUSource;
1723 pImage->aComment = aComment;
1724 pImage->aName = GetName();
1725 rStrm << (sal_uInt8) 1;
1726 // # PCode is saved only for legacy formats only
1727 // It should be noted that it probably isn't necessary
1728 // It would be better not to store the image ( more flexible with
1729 // formats )
1730 bool bRes = pImage->Save( rStrm, B_LEGACYVERSION );
1731 if ( bFixup )
1732 fixUpMethodStart( false ); // restore method starts
1733 return bRes;
1736 else
1738 SbiImage aImg;
1739 aImg.aOUSource = aOUSource;
1740 aImg.aComment = aComment;
1741 aImg.aName = GetName();
1742 rStrm << (sal_uInt8) 1;
1743 return aImg.Save( rStrm );
1747 sal_Bool SbModule::ExceedsLegacyModuleSize()
1749 if ( !IsCompiled() )
1750 Compile();
1751 if ( pImage && pImage->ExceedsLegacyLimits() )
1752 return true;
1753 return false;
1756 class ErrorHdlResetter
1758 Link mErrHandler;
1759 bool mbError;
1760 public:
1761 ErrorHdlResetter() : mbError( false )
1763 // save error handler
1764 mErrHandler = StarBASIC::GetGlobalErrorHdl();
1765 // set new error handler
1766 StarBASIC::SetGlobalErrorHdl( LINK( this, ErrorHdlResetter, BasicErrorHdl ) );
1768 ~ErrorHdlResetter()
1770 // restore error handler
1771 StarBASIC::SetGlobalErrorHdl(mErrHandler);
1773 DECL_LINK( BasicErrorHdl, StarBASIC * );
1774 bool HasError() { return mbError; }
1776 IMPL_LINK( ErrorHdlResetter, BasicErrorHdl, StarBASIC *, /*pBasic*/)
1778 mbError = true;
1779 return 0;
1782 void SbModule::GetCodeCompleteDataFromParse(CodeCompleteDataCache& aCache)
1784 ErrorHdlResetter aErrHdl;
1785 SbxBase::ResetError();
1787 SbiParser* pParser = new SbiParser( (StarBASIC*) GetParent(), this );
1788 pParser->SetCodeCompleting(true);
1790 while( pParser->Parse() ) {}
1791 SbiSymPool* pPool = pParser->pPool;
1792 aCache.Clear();
1793 for( sal_uInt16 i = 0; i < pPool->GetSize(); ++i )
1795 SbiSymDef* pSymDef = pPool->Get(i);
1796 //std::cerr << "i: " << i << ", type: " << pSymDef->GetType() << "; name:" << pSymDef->GetName() << std::endl;
1797 if( (pSymDef->GetType() != SbxEMPTY) || (pSymDef->GetType() != SbxNULL) )
1798 aCache.InsertGlobalVar( pSymDef->GetName(), pParser->aGblStrings.Find(pSymDef->GetTypeId()) );
1800 SbiSymPool& pChildPool = pSymDef->GetPool();
1801 for(sal_uInt16 j = 0; j < pChildPool.GetSize(); ++j )
1803 SbiSymDef* pChildSymDef = pChildPool.Get(j);
1804 //std::cerr << "j: " << j << ", type: " << pChildSymDef->GetType() << "; name:" << pChildSymDef->GetName() << std::endl;
1805 if( (pChildSymDef->GetType() != SbxEMPTY) || (pChildSymDef->GetType() != SbxNULL) )
1806 aCache.InsertLocalVar( pSymDef->GetName(), pChildSymDef->GetName(), pParser->aGblStrings.Find(pChildSymDef->GetTypeId()) );
1809 delete pParser;
1812 SbxArrayRef SbModule::GetMethods()
1814 return pMethods;
1817 OUString SbModule::GetKeywordCase( const OUString& sKeyword ) const
1819 return SbiParser::GetKeywordCase( sKeyword );
1822 bool SbModule::HasExeCode()
1824 // And empty Image always has the Global Chain set up
1825 static const unsigned char pEmptyImage[] = { 0x45, 0x0 , 0x0, 0x0, 0x0 };
1826 // lets be stricter for the moment than VBA
1828 if (!IsCompiled())
1830 ErrorHdlResetter aGblErrHdl;
1831 Compile();
1832 if (aGblErrHdl.HasError()) //assume unsafe on compile error
1833 return true;
1836 bool bRes = false;
1837 if (pImage && !(pImage->GetCodeSize() == 5 && (memcmp(pImage->GetCode(), pEmptyImage, pImage->GetCodeSize()) == 0 )))
1838 bRes = true;
1840 return bRes;
1843 // Store only image, no source
1844 sal_Bool SbModule::StoreBinaryData( SvStream& rStrm )
1846 return StoreBinaryData( rStrm, 0 );
1849 sal_Bool SbModule::StoreBinaryData( SvStream& rStrm, sal_uInt16 nVer )
1851 sal_Bool bRet = Compile();
1852 if( bRet )
1854 bool bFixup = ( !nVer && !pImage->ExceedsLegacyLimits() );// save in old image format, fix up method starts
1856 if ( bFixup ) // save in old image format, fix up method starts
1857 fixUpMethodStart( true );
1858 bRet = SbxObject::StoreData( rStrm );
1859 if( bRet )
1861 pImage->aOUSource = OUString();
1862 pImage->aComment = aComment;
1863 pImage->aName = GetName();
1865 rStrm << (sal_uInt8) 1;
1866 if ( nVer )
1867 bRet = pImage->Save( rStrm, B_EXT_IMG_VERSION );
1868 else
1869 bRet = pImage->Save( rStrm, B_LEGACYVERSION );
1870 if ( bFixup )
1871 fixUpMethodStart( false ); // restore method starts
1873 pImage->aOUSource = aOUSource;
1876 return bRet;
1879 // Called for >= OO 1.0 passwd protected libraries only
1881 sal_Bool SbModule::LoadBinaryData( SvStream& rStrm )
1883 OUString aKeepSource = aOUSource;
1884 bool bRet = LoadData( rStrm, 2 );
1885 LoadCompleted();
1886 aOUSource = aKeepSource;
1887 return bRet;
1890 sal_Bool SbModule::LoadCompleted()
1892 SbxArray* p = GetMethods();
1893 sal_uInt16 i;
1894 for( i = 0; i < p->Count(); i++ )
1896 SbMethod* q = PTR_CAST(SbMethod,p->Get( i ) );
1897 if( q )
1898 q->pMod = this;
1900 p = GetProperties();
1901 for( i = 0; i < p->Count(); i++ )
1903 SbProperty* q = PTR_CAST(SbProperty,p->Get( i ) );
1904 if( q )
1905 q->pMod = this;
1907 return sal_True;
1910 void SbModule::handleProcedureProperties( SfxBroadcaster& rBC, const SfxHint& rHint )
1912 bool bDone = false;
1914 const SbxHint* pHint = PTR_CAST(SbxHint,&rHint);
1915 if( pHint )
1917 SbxVariable* pVar = pHint->GetVar();
1918 SbProcedureProperty* pProcProperty = PTR_CAST( SbProcedureProperty, pVar );
1919 if( pProcProperty )
1921 bDone = true;
1923 if( pHint->GetId() == SBX_HINT_DATAWANTED )
1925 OUString aProcName("Property Get ");
1926 aProcName += pProcProperty->GetName();
1928 SbxVariable* pMeth = Find( aProcName, SbxCLASS_METHOD );
1929 if( pMeth )
1931 SbxValues aVals;
1932 aVals.eType = SbxVARIANT;
1934 SbxArray* pArg = pVar->GetParameters();
1935 sal_uInt16 nVarParCount = (pArg != NULL) ? pArg->Count() : 0;
1936 if( nVarParCount > 1 )
1938 SbxArrayRef xMethParameters = new SbxArray;
1939 xMethParameters->Put( pMeth, 0 ); // Method as parameter 0
1940 for( sal_uInt16 i = 1 ; i < nVarParCount ; ++i )
1942 SbxVariable* pPar = pArg->Get( i );
1943 xMethParameters->Put( pPar, i );
1946 pMeth->SetParameters( xMethParameters );
1947 pMeth->Get( aVals );
1948 pMeth->SetParameters( NULL );
1950 else
1952 pMeth->Get( aVals );
1955 pVar->Put( aVals );
1958 else if( pHint->GetId() == SBX_HINT_DATACHANGED )
1960 SbxVariable* pMeth = NULL;
1962 bool bSet = pProcProperty->isSet();
1963 if( bSet )
1965 pProcProperty->setSet( false );
1967 OUString aProcName("Property Set " );
1968 aProcName += pProcProperty->GetName();
1969 pMeth = Find( aProcName, SbxCLASS_METHOD );
1971 if( !pMeth ) // Let
1973 OUString aProcName("Property Let " );
1974 aProcName += pProcProperty->GetName();
1975 pMeth = Find( aProcName, SbxCLASS_METHOD );
1978 if( pMeth )
1980 // Setup parameters
1981 SbxArrayRef xArray = new SbxArray;
1982 xArray->Put( pMeth, 0 ); // Method as parameter 0
1983 xArray->Put( pVar, 1 );
1984 pMeth->SetParameters( xArray );
1986 SbxValues aVals;
1987 pMeth->Get( aVals );
1988 pMeth->SetParameters( NULL );
1994 if( !bDone )
1995 SbModule::Notify( rBC, rHint );
1999 // Implementation SbJScriptModule (Basic module for JavaScript source code)
2000 SbJScriptModule::SbJScriptModule( const OUString& rName )
2001 :SbModule( rName )
2005 sal_Bool SbJScriptModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
2007 (void)nVer;
2009 Clear();
2010 if( !SbxObject::LoadData( rStrm, 1 ) )
2011 return sal_False;
2013 // Get the source string
2014 aOUSource = rStrm.ReadUniOrByteString( osl_getThreadTextEncoding() );
2015 return sal_True;
2018 sal_Bool SbJScriptModule::StoreData( SvStream& rStrm ) const
2020 if( !SbxObject::StoreData( rStrm ) )
2021 return sal_False;
2023 // Write the source string
2024 OUString aTmp = aOUSource;
2025 rStrm.WriteUniOrByteString( aTmp, osl_getThreadTextEncoding() );
2026 return sal_True;
2030 /////////////////////////////////////////////////////////////////////////
2032 SbMethod::SbMethod( const OUString& r, SbxDataType t, SbModule* p )
2033 : SbxMethod( r, t ), pMod( p )
2035 bInvalid = sal_True;
2036 nStart =
2037 nDebugFlags =
2038 nLine1 =
2039 nLine2 = 0;
2040 refStatics = new SbxArray;
2041 mCaller = 0;
2042 // HACK due to 'Referenz could not be saved'
2043 SetFlag( SBX_NO_MODIFY );
2046 SbMethod::SbMethod( const SbMethod& r )
2047 : SvRefBase( r ), SbxMethod( r )
2049 pMod = r.pMod;
2050 bInvalid = r.bInvalid;
2051 nStart = r.nStart;
2052 nDebugFlags = r.nDebugFlags;
2053 nLine1 = r.nLine1;
2054 nLine2 = r.nLine2;
2055 refStatics = r.refStatics;
2056 mCaller = r.mCaller;
2057 SetFlag( SBX_NO_MODIFY );
2060 SbMethod::~SbMethod()
2064 void SbMethod::ClearStatics()
2066 refStatics = new SbxArray;
2069 SbxArray* SbMethod::GetStatics()
2071 return refStatics;
2074 sal_Bool SbMethod::LoadData( SvStream& rStrm, sal_uInt16 nVer )
2076 if( !SbxMethod::LoadData( rStrm, 1 ) )
2077 return sal_False;
2078 sal_Int16 n;
2079 rStrm >> n;
2080 sal_Int16 nTempStart = (sal_Int16)nStart;
2081 if( nVer == 2 )
2082 rStrm >> nLine1 >> nLine2 >> nTempStart >> bInvalid;
2083 // HACK ue to 'Referenz could not be saved'
2084 SetFlag( SBX_NO_MODIFY );
2085 nStart = nTempStart;
2086 return sal_True;
2089 sal_Bool SbMethod::StoreData( SvStream& rStrm ) const
2091 if( !SbxMethod::StoreData( rStrm ) )
2092 return sal_False;
2093 rStrm << (sal_Int16) nDebugFlags
2094 << (sal_Int16) nLine1
2095 << (sal_Int16) nLine2
2096 << (sal_Int16) nStart
2097 << (sal_uInt8) bInvalid;
2098 return sal_True;
2101 void SbMethod::GetLineRange( sal_uInt16& l1, sal_uInt16& l2 )
2103 l1 = nLine1; l2 = nLine2;
2106 // Could later be deleted
2108 SbxInfo* SbMethod::GetInfo()
2110 return pInfo;
2113 // Interface to execute a method of the applications
2114 // With special RefCounting, so that the Basic was not fired of by CloseDocument()
2115 // The return value will be delivered as string.
2116 ErrCode SbMethod::Call( SbxValue* pRet, SbxVariable* pCaller )
2118 if ( pCaller )
2120 SAL_INFO("basic", "SbMethod::Call Have been passed a caller 0x" << pCaller );
2121 mCaller = pCaller;
2123 // RefCount vom Modul hochzaehlen
2124 SbModule* pMod_ = (SbModule*)GetParent();
2125 pMod_->AddRef();
2127 // Increment the RefCount of the Basic
2128 StarBASIC* pBasic = (StarBASIC*)pMod_->GetParent();
2129 pBasic->AddRef();
2131 // Establish the values to get the return value
2132 SbxValues aVals;
2133 aVals.eType = SbxVARIANT;
2135 // #104083: Compile BEFORE get
2136 if( bInvalid && !pMod_->Compile() )
2137 StarBASIC::Error( SbERR_BAD_PROP_VALUE );
2139 Get( aVals );
2140 if ( pRet )
2141 pRet->Put( aVals );
2143 // Was there an error
2144 ErrCode nErr = SbxBase::GetError();
2145 SbxBase::ResetError();
2147 // Release objects
2148 pMod_->ReleaseRef();
2149 pBasic->ReleaseRef();
2150 mCaller = 0;
2151 return nErr;
2155 // #100883 Own Broadcast for SbMethod
2156 void SbMethod::Broadcast( sal_uIntPtr nHintId )
2158 if( pCst && !IsSet( SBX_NO_BROADCAST ) )
2160 // Because the method could be called from outside, test here once again
2161 // the authorisation
2162 if( nHintId & SBX_HINT_DATAWANTED )
2163 if( !CanRead() )
2164 return;
2165 if( nHintId & SBX_HINT_DATACHANGED )
2166 if( !CanWrite() )
2167 return;
2169 if( pMod && !pMod->IsCompiled() )
2170 pMod->Compile();
2172 // Block broadcasts while creating new method
2173 SfxBroadcaster* pSave = pCst;
2174 pCst = NULL;
2175 SbMethod* pThisCopy = new SbMethod( *this );
2176 SbMethodRef xHolder = pThisCopy;
2177 if( mpPar.Is() )
2179 // Enrigister this as element 0, but don't reset the parent!
2180 if( GetType() != SbxVOID )
2181 mpPar->PutDirect( pThisCopy, 0 );
2182 SetParameters( NULL );
2185 pCst = pSave;
2186 pSave->Broadcast( SbxHint( nHintId, pThisCopy ) );
2188 sal_uInt16 nSaveFlags = GetFlags();
2189 SetFlag( SBX_READWRITE );
2190 pCst = NULL;
2191 Put( pThisCopy->GetValues_Impl() );
2192 pCst = pSave;
2193 SetFlags( nSaveFlags );
2198 // Implementation of SbJScriptMethod (method class as a wrapper for JavaScript-functions)
2200 SbJScriptMethod::SbJScriptMethod( const OUString& r, SbxDataType t, SbModule* p )
2201 : SbMethod( r, t, p )
2205 SbJScriptMethod::~SbJScriptMethod()
2209 SbObjModule::SbObjModule( const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVbaCompatible )
2210 : SbModule( rName, bIsVbaCompatible )
2212 SetModuleType( mInfo.ModuleType );
2213 if ( mInfo.ModuleType == script::ModuleType::FORM )
2215 SetClassName( "Form" );
2217 else if ( mInfo.ModuleObject.is() )
2219 SetUnoObject( uno::makeAny( mInfo.ModuleObject ) );
2223 SbObjModule::~SbObjModule()
2227 void
2228 SbObjModule::SetUnoObject( const uno::Any& aObj ) throw ( uno::RuntimeException )
2230 SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxVariable*)pDocObject);
2231 if ( pUnoObj && pUnoObj->getUnoAny() == aObj ) // object is equal, nothing to do
2232 return;
2233 pDocObject = new SbUnoObject( GetName(), uno::makeAny( aObj ) );
2235 com::sun::star::uno::Reference< com::sun::star::lang::XServiceInfo > xServiceInfo( aObj, com::sun::star::uno::UNO_QUERY_THROW );
2236 if( xServiceInfo->supportsService( "ooo.vba.excel.Worksheet" ) )
2238 SetClassName( "Worksheet" );
2240 else if( xServiceInfo->supportsService( "ooo.vba.excel.Workbook" ) )
2242 SetClassName( "Workbook" );
2246 SbxVariable*
2247 SbObjModule::GetObject()
2249 return pDocObject;
2251 SbxVariable*
2252 SbObjModule::Find( const OUString& rName, SbxClassType t )
2254 SbxVariable* pVar = NULL;
2255 if ( pDocObject)
2256 pVar = pDocObject->Find( rName, t );
2257 if ( !pVar )
2258 pVar = SbModule::Find( rName, t );
2259 return pVar;
2262 void SbObjModule::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType,
2263 const SfxHint& rHint, const TypeId& rHintType )
2265 SbModule::handleProcedureProperties( rBC, rHint );
2269 typedef ::cppu::WeakImplHelper3<
2270 awt::XTopWindowListener,
2271 awt::XWindowListener,
2272 document::XEventListener > FormObjEventListener_BASE;
2274 class FormObjEventListenerImpl : public FormObjEventListener_BASE
2276 SbUserFormModule* mpUserForm;
2277 uno::Reference< lang::XComponent > mxComponent;
2278 uno::Reference< frame::XModel > mxModel;
2279 bool mbDisposed;
2280 bool mbOpened;
2281 bool mbActivated;
2282 bool mbShowing;
2284 FormObjEventListenerImpl(const FormObjEventListenerImpl&); // not defined
2285 FormObjEventListenerImpl& operator=(const FormObjEventListenerImpl&); // not defined
2287 public:
2288 FormObjEventListenerImpl( SbUserFormModule* pUserForm, const uno::Reference< lang::XComponent >& xComponent, const uno::Reference< frame::XModel >& xModel ) :
2289 mpUserForm( pUserForm ), mxComponent( xComponent), mxModel( xModel ),
2290 mbDisposed( false ), mbOpened( false ), mbActivated( false ), mbShowing( false )
2292 if ( mxComponent.is() )
2294 SAL_INFO("basic", "*********** Registering the listeners");
2297 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->addTopWindowListener( this );
2299 catch(const uno::Exception& ) {}
2302 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->addWindowListener( this );
2304 catch(const uno::Exception& ) {}
2307 if ( mxModel.is() )
2311 uno::Reference< document::XEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->addEventListener( this );
2313 catch(const uno::Exception& ) {}
2317 virtual ~FormObjEventListenerImpl()
2319 removeListener();
2322 bool isShowing() const { return mbShowing; }
2324 void removeListener()
2326 if ( mxComponent.is() && !mbDisposed )
2328 SAL_INFO("basic", "*********** Removing the listeners");
2331 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeTopWindowListener( this );
2333 catch(const uno::Exception& ) {}
2336 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeWindowListener( this );
2338 catch(const uno::Exception& ) {}
2340 mxComponent.clear();
2342 if ( mxModel.is() && !mbDisposed )
2346 uno::Reference< document::XEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->removeEventListener( this );
2348 catch(const uno::Exception& ) {}
2350 mxModel.clear();
2353 virtual void SAL_CALL windowOpened( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2355 if ( mpUserForm )
2357 mbOpened = true;
2358 mbShowing = true;
2359 if ( mbActivated )
2361 mbOpened = mbActivated = false;
2362 mpUserForm->triggerActivateEvent();
2368 virtual void SAL_CALL windowClosing( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2370 #ifdef IN_THE_FUTURE
2371 uno::Reference< awt::XDialog > xDialog( e.Source, uno::UNO_QUERY );
2372 if ( xDialog.is() )
2374 uno::Reference< awt::XControl > xControl( xDialog, uno::UNO_QUERY );
2375 if ( xControl->getPeer().is() )
2377 uno::Reference< document::XVbaMethodParameter > xVbaMethodParameter( xControl->getPeer(), uno::UNO_QUERY );
2378 if ( xVbaMethodParameter.is() )
2380 sal_Int8 nCancel = 0;
2381 sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormControlMenu;
2383 Sequence< Any > aParams;
2384 aParams.realloc(2);
2385 aParams[0] <<= nCancel;
2386 aParams[1] <<= nCloseMode;
2388 mpUserForm->triggerMethod( "Userform_QueryClose", aParams);
2389 return;
2395 mpUserForm->triggerMethod( "Userform_QueryClose" );
2396 #endif
2400 virtual void SAL_CALL windowClosed( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2402 mbOpened = false;
2403 mbShowing = false;
2406 virtual void SAL_CALL windowMinimized( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2410 virtual void SAL_CALL windowNormalized( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2414 virtual void SAL_CALL windowActivated( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2416 if ( mpUserForm )
2418 mbActivated = true;
2419 if ( mbOpened )
2421 mbOpened = mbActivated = false;
2422 mpUserForm->triggerActivateEvent();
2427 virtual void SAL_CALL windowDeactivated( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2429 if ( mpUserForm )
2430 mpUserForm->triggerDeactivateEvent();
2433 virtual void SAL_CALL windowResized( const awt::WindowEvent& /*e*/ ) throw (uno::RuntimeException)
2435 if ( mpUserForm )
2437 mpUserForm->triggerResizeEvent();
2438 mpUserForm->triggerLayoutEvent();
2442 virtual void SAL_CALL windowMoved( const awt::WindowEvent& /*e*/ ) throw (uno::RuntimeException)
2444 if ( mpUserForm )
2445 mpUserForm->triggerLayoutEvent();
2448 virtual void SAL_CALL windowShown( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2452 virtual void SAL_CALL windowHidden( const lang::EventObject& /*e*/ ) throw (uno::RuntimeException)
2456 virtual void SAL_CALL notifyEvent( const document::EventObject& rEvent ) throw (uno::RuntimeException)
2458 // early dosposing on document event "OnUnload", to be sure Basic still exists when calling VBA "UserForm_Terminate"
2459 if( rEvent.EventName == GlobalEventConfig::GetEventName( STR_EVENT_CLOSEDOC ) )
2461 removeListener();
2462 mbDisposed = true;
2463 if ( mpUserForm )
2464 mpUserForm->ResetApiObj(); // will trigger "UserForm_Terminate"
2468 virtual void SAL_CALL disposing( const lang::EventObject& /*Source*/ ) throw (uno::RuntimeException)
2470 SAL_INFO("basic", "** Userform/Dialog disposing");
2471 removeListener();
2472 mbDisposed = true;
2473 if ( mpUserForm )
2474 mpUserForm->ResetApiObj( false ); // pass false (too late to trigger VBA events here)
2478 SbUserFormModule::SbUserFormModule( const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsCompat )
2479 : SbObjModule( rName, mInfo, bIsCompat )
2480 , m_mInfo( mInfo )
2481 , mbInit( false )
2483 m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW );
2486 SbUserFormModule::~SbUserFormModule()
2490 void SbUserFormModule::ResetApiObj( bool bTriggerTerminateEvent )
2492 SAL_INFO("basic", " SbUserFormModule::ResetApiObj( " << (bTriggerTerminateEvent ? "true )" : "false )") );
2493 if ( bTriggerTerminateEvent && m_xDialog.is() ) // probably someone close the dialog window
2495 triggerTerminateEvent();
2497 pDocObject = NULL;
2498 m_xDialog = NULL;
2501 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun )
2503 Sequence< Any > aArguments;
2504 triggerMethod( aMethodToRun, aArguments );
2507 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun, Sequence< Any >& aArguments )
2509 SAL_INFO("basic", "*** trigger " << OUStringToOString( aMethodToRun, RTL_TEXTENCODING_UTF8 ).getStr() << " ***");
2510 // Search method
2511 SbxVariable* pMeth = SbObjModule::Find( aMethodToRun, SbxCLASS_METHOD );
2512 if( pMeth )
2514 if ( aArguments.getLength() > 0 ) // Setup parameters
2516 SbxArrayRef xArray = new SbxArray;
2517 xArray->Put( pMeth, 0 ); // Method as parameter 0
2519 for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2521 SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
2522 unoToSbxValue( static_cast< SbxVariable* >( xSbxVar ), aArguments[i] );
2523 xArray->Put( xSbxVar, static_cast< sal_uInt16 >( i ) + 1 );
2525 // Enable passing by ref
2526 if ( xSbxVar->GetType() != SbxVARIANT )
2527 xSbxVar->SetFlag( SBX_FIXED );
2529 pMeth->SetParameters( xArray );
2531 SbxValues aVals;
2532 pMeth->Get( aVals );
2534 for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2536 aArguments[i] = sbxToUnoValue( xArray->Get( static_cast< sal_uInt16 >(i) + 1) );
2538 pMeth->SetParameters( NULL );
2540 else
2542 SbxValues aVals;
2543 pMeth->Get( aVals );
2548 void SbUserFormModule::triggerActivateEvent( void )
2550 SAL_INFO("basic", "**** entering SbUserFormModule::triggerActivate");
2551 triggerMethod( "UserForm_Activate" );
2552 SAL_INFO("basic", "**** leaving SbUserFormModule::triggerActivate");
2555 void SbUserFormModule::triggerDeactivateEvent( void )
2557 SAL_INFO("basic", "**** SbUserFormModule::triggerDeactivate");
2558 triggerMethod( "Userform_Deactivate" );
2561 void SbUserFormModule::triggerInitializeEvent( void )
2563 if ( mbInit )
2564 return;
2565 SAL_INFO("basic", "**** SbUserFormModule::triggerInitializeEvent");
2566 static OUString aInitMethodName( "Userform_Initialize");
2567 triggerMethod( aInitMethodName );
2568 mbInit = true;
2571 void SbUserFormModule::triggerTerminateEvent( void )
2573 SAL_INFO("basic", "**** SbUserFormModule::triggerTerminateEvent");
2574 static OUString aTermMethodName( "Userform_Terminate" );
2575 triggerMethod( aTermMethodName );
2576 mbInit=false;
2579 void SbUserFormModule::triggerLayoutEvent( void )
2581 static OUString aMethodName( "Userform_Layout" );
2582 triggerMethod( aMethodName );
2585 void SbUserFormModule::triggerResizeEvent( void )
2587 static OUString aMethodName("Userform_Resize");
2588 triggerMethod( aMethodName );
2591 SbUserFormModuleInstance* SbUserFormModule::CreateInstance()
2593 SbUserFormModuleInstance* pInstance = new SbUserFormModuleInstance( this, GetName(), m_mInfo, IsVBACompat() );
2594 return pInstance;
2597 SbUserFormModuleInstance::SbUserFormModuleInstance( SbUserFormModule* pParentModule,
2598 const OUString& rName, const com::sun::star::script::ModuleInfo& mInfo, bool bIsVBACompat )
2599 : SbUserFormModule( rName, mInfo, bIsVBACompat )
2600 , m_pParentModule( pParentModule )
2604 sal_Bool SbUserFormModuleInstance::IsClass( const OUString& rName ) const
2606 sal_Bool bParentNameMatches = m_pParentModule->GetName().equalsIgnoreAsciiCase( rName );
2607 sal_Bool bRet = bParentNameMatches || SbxObject::IsClass( rName );
2608 return bRet;
2611 SbxVariable* SbUserFormModuleInstance::Find( const OUString& rName, SbxClassType t )
2613 SbxVariable* pVar = m_pParentModule->Find( rName, t );
2614 return pVar;
2618 void SbUserFormModule::Load()
2620 SAL_INFO("basic", "** load() ");
2621 // forces a load
2622 if ( !pDocObject )
2623 InitObject();
2627 void SbUserFormModule::Unload()
2629 SAL_INFO("basic", "** Unload() ");
2631 sal_Int8 nCancel = 0;
2632 sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormCode;
2634 Sequence< Any > aParams;
2635 aParams.realloc(2);
2636 aParams[0] <<= nCancel;
2637 aParams[1] <<= nCloseMode;
2639 triggerMethod( "Userform_QueryClose", aParams);
2641 aParams[0] >>= nCancel;
2642 // basic boolean ( and what the user might use ) can be ambiguous ( e.g. basic true = -1 )
2643 // test agains 0 ( false ) and assume anything else is true
2644 // ( Note: ) this used to work ( something changes somewhere )
2645 if (nCancel != 0)
2647 return;
2650 if ( m_xDialog.is() )
2652 triggerTerminateEvent();
2654 // Search method
2655 SbxVariable* pMeth = SbObjModule::Find( "UnloadObject", SbxCLASS_METHOD );
2656 if( pMeth )
2658 SAL_INFO("basic", "Attempting too run the UnloadObjectMethod");
2659 m_xDialog.clear(); //release ref to the uno object
2660 SbxValues aVals;
2661 bool bWaitForDispose = true; // assume dialog is showing
2662 if ( m_DialogListener.get() )
2664 bWaitForDispose = m_DialogListener->isShowing();
2665 SAL_INFO("basic", "Showing " << bWaitForDispose );
2667 pMeth->Get( aVals);
2668 if ( !bWaitForDispose )
2670 // we've either already got a dispose or we'er never going to get one
2671 ResetApiObj();
2672 } // else wait for dispose
2673 SAL_INFO("basic", "UnloadObject completed ( we hope )");
2678 void registerComponentToBeDisposedForBasic( Reference< XComponent > xComponent, StarBASIC* pBasic );
2680 void SbUserFormModule::InitObject()
2684 OUString aHook("VBAGlobals");
2685 SbUnoObject* pGlobs = (SbUnoObject*)GetParent()->Find( aHook, SbxCLASS_DONTCARE );
2686 if ( m_xModel.is() && pGlobs )
2688 // broadcast INITIALIZE_USERFORM script event before the dialog is created
2689 Reference< script::vba::XVBACompatibility > xVBACompat( getVBACompatibility( m_xModel ), uno::UNO_SET_THROW );
2690 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::INITIALIZE_USERFORM, GetName() );
2691 uno::Reference< lang::XMultiServiceFactory > xVBAFactory( pGlobs->getUnoAny(), uno::UNO_QUERY_THROW );
2692 uno::Reference< uno::XComponentContext > xContext = comphelper::getProcessComponentContext();
2693 OUString sDialogUrl( "vnd.sun.star.script:" );
2694 OUString sProjectName( "Standard" );
2698 Reference< beans::XPropertySet > xProps( m_xModel, UNO_QUERY_THROW );
2699 uno::Reference< script::vba::XVBACompatibility > xVBAMode( xProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY_THROW );
2700 sProjectName = xVBAMode->getProjectName();
2702 catch(const Exception& ) {}
2704 sDialogUrl = sDialogUrl + sProjectName + "." + GetName() + "?location=document";
2706 uno::Reference< awt::XDialogProvider > xProvider = awt::DialogProvider::createWithModel( xContext, m_xModel );
2707 m_xDialog = xProvider->createDialog( sDialogUrl );
2709 // create vba api object
2710 uno::Sequence< uno::Any > aArgs(4);
2711 aArgs[ 0 ] = uno::Any();
2712 aArgs[ 1 ] <<= m_xDialog;
2713 aArgs[ 2 ] <<= m_xModel;
2714 aArgs[ 3 ] <<= OUString( GetParent()->GetName() );
2715 pDocObject = new SbUnoObject( GetName(), uno::makeAny( xVBAFactory->createInstanceWithArguments( "ooo.vba.msforms.UserForm", aArgs ) ) );
2717 uno::Reference< lang::XComponent > xComponent( m_xDialog, uno::UNO_QUERY_THROW );
2719 // the dialog must be disposed at the end!
2720 StarBASIC* pParentBasic = NULL;
2721 SbxObject* pCurObject = this;
2724 SbxObject* pObjParent = pCurObject->GetParent();
2725 pParentBasic = PTR_CAST( StarBASIC, pObjParent );
2726 pCurObject = pObjParent;
2728 while( pParentBasic == NULL && pCurObject != NULL );
2730 SAL_WARN_IF( pParentBasic == NULL, "basic", "pParentBasic == NULL" );
2731 registerComponentToBeDisposedForBasic( xComponent, pParentBasic );
2733 // if old listener object exists, remove it from dialog and document model
2734 if( m_DialogListener.is() )
2735 m_DialogListener->removeListener();
2736 m_DialogListener.set( new FormObjEventListenerImpl( this, xComponent, m_xModel ) );
2738 triggerInitializeEvent();
2741 catch(const uno::Exception& )
2747 SbxVariable*
2748 SbUserFormModule::Find( const OUString& rName, SbxClassType t )
2750 if ( !pDocObject && !GetSbData()->bRunInit && GetSbData()->pInst )
2751 InitObject();
2752 return SbObjModule::Find( rName, t );
2755 SbProperty::SbProperty( const OUString& r, SbxDataType t, SbModule* p )
2756 : SbxProperty( r, t ), pMod( p )
2758 bInvalid = sal_False;
2761 SbProperty::~SbProperty()
2765 SbProcedureProperty::~SbProcedureProperty()
2768 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */