Version 6.4.0.3, tag libreoffice-6.4.0.3
[LibreOffice.git] / basic / source / classes / sbxmod.cxx
blob0596e5ba87d983e2468167a1f0a281a6651eb2fb
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 <vcl/svapp.hxx>
22 #include <tools/stream.hxx>
23 #include <tools/diagnose_ex.h>
24 #include <svl/SfxBroadcaster.hxx>
25 #include <basic/codecompletecache.hxx>
26 #include <basic/sbx.hxx>
27 #include <basic/sbuno.hxx>
28 #include <sbjsmeth.hxx>
29 #include <sbjsmod.hxx>
30 #include <sbintern.hxx>
31 #include <sbprop.hxx>
32 #include <image.hxx>
33 #include <opcodes.hxx>
34 #include <runtime.hxx>
35 #include <token.hxx>
36 #include <sbunoobj.hxx>
38 #include <sal/log.hxx>
40 #include <basic/sberrors.hxx>
41 #include <sbobjmod.hxx>
42 #include <basic/vbahelper.hxx>
43 #include <comphelper/sequence.hxx>
44 #include <cppuhelper/implbase.hxx>
45 #include <unotools/eventcfg.hxx>
46 #include <com/sun/star/lang/XServiceInfo.hpp>
47 #include <com/sun/star/script/ModuleType.hpp>
48 #include <com/sun/star/script/vba/XVBACompatibility.hpp>
49 #include <com/sun/star/script/vba/VBAScriptEventId.hpp>
50 #include <com/sun/star/beans/XPropertySet.hpp>
51 #include <com/sun/star/document/XDocumentEventBroadcaster.hpp>
52 #include <com/sun/star/document/XDocumentEventListener.hpp>
54 #ifdef UNX
55 #include <sys/resource.h>
56 #endif
58 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
59 #include <comphelper/processfactory.hxx>
60 #include <comphelper/asyncquithandler.hxx>
61 #include <map>
62 #include <com/sun/star/reflection/ProxyFactory.hpp>
63 #include <com/sun/star/uno/XAggregation.hpp>
64 #include <com/sun/star/script/XInvocation.hpp>
66 #include <com/sun/star/awt/DialogProvider.hpp>
67 #include <com/sun/star/awt/XTopWindow.hpp>
68 #include <com/sun/star/awt/XWindow.hpp>
69 #include <ooo/vba/VbQueryClose.hpp>
70 #include <memory>
71 #include <sbxmod.hxx>
72 #include <parser.hxx>
74 #include <limits>
76 using namespace com::sun::star;
77 using namespace com::sun::star::lang;
78 using namespace com::sun::star::reflection;
79 using namespace com::sun::star::beans;
80 using namespace com::sun::star::script;
81 using namespace com::sun::star::uno;
83 typedef ::cppu::WeakImplHelper< XInvocation > DocObjectWrapper_BASE;
84 typedef std::map< sal_Int16, Any > OutParamMap;
86 class DocObjectWrapper : public DocObjectWrapper_BASE
88 Reference< XAggregation > m_xAggProxy;
89 Reference< XInvocation > m_xAggInv;
90 Reference< XTypeProvider > m_xAggregateTypeProv;
91 Sequence< Type > m_Types;
92 SbModule* m_pMod;
93 /// @throws css::uno::RuntimeException
94 SbMethodRef getMethod( const OUString& aName );
95 /// @throws css::uno::RuntimeException
96 SbPropertyRef getProperty( const OUString& aName );
98 public:
99 explicit DocObjectWrapper( SbModule* pMod );
101 virtual Sequence< sal_Int8 > SAL_CALL getImplementationId() override
103 return css::uno::Sequence<sal_Int8>();
106 virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection( ) override;
108 virtual Any SAL_CALL invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) override;
109 virtual void SAL_CALL setValue( const OUString& aPropertyName, const Any& aValue ) override;
110 virtual Any SAL_CALL getValue( const OUString& aPropertyName ) override;
111 virtual sal_Bool SAL_CALL hasMethod( const OUString& aName ) override;
112 virtual sal_Bool SAL_CALL hasProperty( const OUString& aName ) override;
113 virtual Any SAL_CALL queryInterface( const Type& aType ) override;
115 virtual Sequence< Type > SAL_CALL getTypes() override;
118 DocObjectWrapper::DocObjectWrapper( SbModule* pVar ) : m_pMod( pVar )
120 SbObjModule* pMod = dynamic_cast<SbObjModule*>( pVar );
121 if ( pMod )
123 if ( pMod->GetModuleType() == ModuleType::DOCUMENT )
125 // Use proxy factory service to create aggregatable proxy.
126 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pMod->GetObject() );
127 Reference< XInterface > xIf;
128 if ( pUnoObj )
130 Any aObj = pUnoObj->getUnoAny();
131 aObj >>= xIf;
132 if ( xIf.is() )
134 m_xAggregateTypeProv.set( xIf, UNO_QUERY );
135 m_xAggInv.set( xIf, UNO_QUERY );
138 if ( xIf.is() )
142 Reference< XProxyFactory > xProxyFac = ProxyFactory::create( comphelper::getProcessComponentContext() );
143 m_xAggProxy = xProxyFac->createProxy( xIf );
145 catch(const Exception& )
147 TOOLS_WARN_EXCEPTION( "basic", "DocObjectWrapper::DocObjectWrapper" );
151 if ( m_xAggProxy.is() )
153 osl_atomic_increment( &m_refCount );
155 /* i35609 - Fix crash on Solaris. The setDelegator call needs
156 to be in its own block to ensure that all temporary Reference
157 instances that are acquired during the call are released
158 before m_refCount is decremented again */
160 m_xAggProxy->setDelegator( static_cast< cppu::OWeakObject * >( this ) );
163 osl_atomic_decrement( &m_refCount );
169 Sequence< Type > SAL_CALL DocObjectWrapper::getTypes()
171 if ( !m_Types.hasElements() )
173 Sequence< Type > sTypes;
174 if ( m_xAggregateTypeProv.is() )
176 sTypes = m_xAggregateTypeProv->getTypes();
178 m_Types = comphelper::concatSequences(sTypes,
179 Sequence { cppu::UnoType<XInvocation>::get() });
181 return m_Types;
184 Reference< XIntrospectionAccess > SAL_CALL
185 DocObjectWrapper::getIntrospection( )
187 return nullptr;
190 Any SAL_CALL
191 DocObjectWrapper::invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam )
193 if ( m_xAggInv.is() && m_xAggInv->hasMethod( aFunctionName ) )
194 return m_xAggInv->invoke( aFunctionName, aParams, aOutParamIndex, aOutParam );
195 SbMethodRef pMethod = getMethod( aFunctionName );
196 if ( !pMethod.is() )
197 throw RuntimeException();
198 // check number of parameters
199 sal_Int32 nParamsCount = aParams.getLength();
200 SbxInfo* pInfo = pMethod->GetInfo();
201 if ( pInfo )
203 sal_Int32 nSbxOptional = 0;
204 sal_uInt16 n = 1;
205 for ( const SbxParamInfo* pParamInfo = pInfo->GetParam( n ); pParamInfo; pParamInfo = pInfo->GetParam( ++n ) )
207 if ( pParamInfo->nFlags & SbxFlagBits::Optional )
208 ++nSbxOptional;
209 else
210 nSbxOptional = 0;
212 sal_Int32 nSbxCount = n - 1;
213 if ( nParamsCount < nSbxCount - nSbxOptional )
215 throw RuntimeException( "wrong number of parameters!" );
218 // set parameters
219 SbxArrayRef xSbxParams;
220 if ( nParamsCount > 0 )
222 xSbxParams = new SbxArray;
223 const Any* pParams = aParams.getConstArray();
224 for ( sal_Int32 i = 0; i < nParamsCount; ++i )
226 SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
227 unoToSbxValue( xSbxVar.get(), pParams[i] );
228 xSbxParams->Put( xSbxVar.get(), static_cast< sal_uInt16 >( i ) + 1 );
230 // Enable passing by ref
231 if ( xSbxVar->GetType() != SbxVARIANT )
232 xSbxVar->SetFlag( SbxFlagBits::Fixed );
235 if ( xSbxParams.is() )
236 pMethod->SetParameters( xSbxParams.get() );
238 // call method
239 SbxVariableRef xReturn = new SbxVariable;
241 pMethod->Call( xReturn.get() );
242 Any aReturn;
243 // get output parameters
244 if ( xSbxParams.is() )
246 SbxInfo* pInfo_ = pMethod->GetInfo();
247 if ( pInfo_ )
249 OutParamMap aOutParamMap;
250 for ( sal_uInt16 n = 1, nCount = xSbxParams->Count(); n < nCount; ++n )
252 const SbxParamInfo* pParamInfo = pInfo_->GetParam( n );
253 if ( pParamInfo && ( pParamInfo->eType & SbxBYREF ) != 0 )
255 SbxVariable* pVar = xSbxParams->Get( n );
256 if ( pVar )
258 SbxVariableRef xVar = pVar;
259 aOutParamMap.emplace( n - 1, sbxToUnoValue( xVar.get() ) );
263 sal_Int32 nOutParamCount = aOutParamMap.size();
264 aOutParamIndex.realloc( nOutParamCount );
265 aOutParam.realloc( nOutParamCount );
266 sal_Int16* pOutParamIndex = aOutParamIndex.getArray();
267 Any* pOutParam = aOutParam.getArray();
268 for (auto const& outParam : aOutParamMap)
270 *pOutParamIndex = outParam.first;
271 *pOutParam = outParam.second;
272 ++pOutParamIndex;
273 ++pOutParam;
278 // get return value
279 aReturn = sbxToUnoValue( xReturn.get() );
281 pMethod->SetParameters( nullptr );
283 return aReturn;
286 void SAL_CALL
287 DocObjectWrapper::setValue( const OUString& aPropertyName, const Any& aValue )
289 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
290 return m_xAggInv->setValue( aPropertyName, aValue );
292 SbPropertyRef pProperty = getProperty( aPropertyName );
293 if ( !pProperty.is() )
294 throw UnknownPropertyException(aPropertyName);
295 unoToSbxValue( pProperty.get(), aValue );
298 Any SAL_CALL
299 DocObjectWrapper::getValue( const OUString& aPropertyName )
301 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
302 return m_xAggInv->getValue( aPropertyName );
304 SbPropertyRef pProperty = getProperty( aPropertyName );
305 if ( !pProperty.is() )
306 throw UnknownPropertyException(aPropertyName);
308 SbxVariable* pProp = pProperty.get();
309 if ( pProp->GetType() == SbxEMPTY )
310 pProperty->Broadcast( SfxHintId::BasicDataWanted );
312 Any aRet = sbxToUnoValue( pProp );
313 return aRet;
316 sal_Bool SAL_CALL
317 DocObjectWrapper::hasMethod( const OUString& aName )
319 if ( m_xAggInv.is() && m_xAggInv->hasMethod( aName ) )
320 return true;
321 return getMethod( aName ).is();
324 sal_Bool SAL_CALL
325 DocObjectWrapper::hasProperty( const OUString& aName )
327 bool bRes = false;
328 if ( m_xAggInv.is() && m_xAggInv->hasProperty( aName ) )
329 bRes = true;
330 else bRes = getProperty( aName ).is();
331 return bRes;
334 Any SAL_CALL DocObjectWrapper::queryInterface( const Type& aType )
336 Any aRet = DocObjectWrapper_BASE::queryInterface( aType );
337 if ( aRet.hasValue() )
338 return aRet;
339 else if ( m_xAggProxy.is() )
340 aRet = m_xAggProxy->queryAggregation( aType );
341 return aRet;
344 SbMethodRef DocObjectWrapper::getMethod( const OUString& aName )
346 SbMethodRef pMethod;
347 if ( m_pMod )
349 SbxFlagBits nSaveFlgs = m_pMod->GetFlags();
350 // Limit search to this module
351 m_pMod->ResetFlag( SbxFlagBits::GlobalSearch );
352 pMethod = dynamic_cast<SbMethod*>(m_pMod->SbModule::Find(aName, SbxClassType::Method));
353 m_pMod->SetFlags( nSaveFlgs );
356 return pMethod;
359 SbPropertyRef DocObjectWrapper::getProperty( const OUString& aName )
361 SbPropertyRef pProperty;
362 if ( m_pMod )
364 SbxFlagBits nSaveFlgs = m_pMod->GetFlags();
365 // Limit search to this module.
366 m_pMod->ResetFlag( SbxFlagBits::GlobalSearch );
367 pProperty = dynamic_cast<SbProperty*>(m_pMod->SbModule::Find(aName, SbxClassType::Property));
368 m_pMod->SetFlag( nSaveFlgs );
371 return pProperty;
375 uno::Reference< frame::XModel > getDocumentModel( StarBASIC* pb )
377 uno::Reference< frame::XModel > xModel;
378 if( pb && pb->IsDocBasic() )
380 uno::Any aDoc;
381 if( pb->GetUNOConstant( "ThisComponent", aDoc ) )
382 xModel.set( aDoc, uno::UNO_QUERY );
384 return xModel;
387 static uno::Reference< vba::XVBACompatibility > getVBACompatibility( const uno::Reference< frame::XModel >& rxModel )
389 uno::Reference< vba::XVBACompatibility > xVBACompat;
392 uno::Reference< beans::XPropertySet > xModelProps( rxModel, uno::UNO_QUERY_THROW );
393 xVBACompat.set( xModelProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY );
395 catch(const uno::Exception& )
398 return xVBACompat;
401 static bool getDefaultVBAMode( StarBASIC* pb )
403 uno::Reference< frame::XModel > xModel( getDocumentModel( pb ) );
404 if (!xModel.is())
405 return false;
406 uno::Reference< vba::XVBACompatibility > xVBACompat = getVBACompatibility( xModel );
407 return xVBACompat.is() && xVBACompat->getVBACompatibilityMode();
410 // A Basic module has set EXTSEARCH, so that the elements, that the module contains,
411 // could be found from other module.
413 SbModule::SbModule( const OUString& rName, bool bVBACompat )
414 : SbxObject( "StarBASICModule" ),
415 pImage(nullptr), pBreaks(nullptr), mbVBACompat( bVBACompat ), bIsProxyModule( false )
417 SetName( rName );
418 SetFlag( SbxFlagBits::ExtSearch | SbxFlagBits::GlobalSearch );
419 SetModuleType( script::ModuleType::NORMAL );
421 // #i92642: Set name property to initial name
422 SbxVariable* pNameProp = pProps->Find( "Name", SbxClassType::Property );
423 if( pNameProp != nullptr )
425 pNameProp->PutString( GetName() );
429 SbModule::~SbModule()
431 SAL_INFO("basic","Module named " << GetName() << " is destructing");
432 delete pImage;
433 delete pBreaks;
434 pClassData.reset();
435 mxWrapper = nullptr;
438 uno::Reference< script::XInvocation > const &
439 SbModule::GetUnoModule()
441 if ( !mxWrapper.is() )
442 mxWrapper = new DocObjectWrapper( this );
444 SAL_INFO("basic","Module named " << GetName() << " returning wrapper mxWrapper (0x" << mxWrapper.get() <<")" );
445 return mxWrapper;
448 bool SbModule::IsCompiled() const
450 return pImage != nullptr;
453 const SbxObject* SbModule::FindType( const OUString& aTypeName ) const
455 return pImage ? pImage->FindType( aTypeName ) : nullptr;
459 // From the code generator: deletion of images and the opposite of validation for entries
461 void SbModule::StartDefinitions()
463 delete pImage; pImage = nullptr;
464 if( pClassData )
465 pClassData->clear();
467 // methods and properties persist, but they are invalid;
468 // at least are the information under certain conditions clogged
469 sal_uInt16 i;
470 for( i = 0; i < pMethods->Count(); i++ )
472 SbMethod* p = dynamic_cast<SbMethod*>( pMethods->Get( i ) );
473 if( p )
474 p->bInvalid = true;
476 for( i = 0; i < pProps->Count(); )
478 SbProperty* p = dynamic_cast<SbProperty*>( pProps->Get( i ) );
479 if( p )
480 pProps->Remove( i );
481 else
482 i++;
486 // request/create method
488 SbMethod* SbModule::GetMethod( const OUString& rName, SbxDataType t )
490 SbxVariable* p = pMethods->Find( rName, SbxClassType::Method );
491 SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
492 if( p && !pMeth )
494 pMethods->Remove( p );
496 if( !pMeth )
498 pMeth = new SbMethod( rName, t, this );
499 pMeth->SetParent( this );
500 pMeth->SetFlags( SbxFlagBits::Read );
501 pMethods->Put( pMeth, pMethods->Count() );
502 StartListening(pMeth->GetBroadcaster(), DuplicateHandling::Prevent);
504 // The method is per default valid, because it could be
505 // created from the compiler (code generator) as well.
506 pMeth->bInvalid = false;
507 pMeth->ResetFlag( SbxFlagBits::Fixed );
508 pMeth->SetFlag( SbxFlagBits::Write );
509 pMeth->SetType( t );
510 pMeth->ResetFlag( SbxFlagBits::Write );
511 if( t != SbxVARIANT )
513 pMeth->SetFlag( SbxFlagBits::Fixed );
515 return pMeth;
518 SbMethod* SbModule::FindMethod( const OUString& rName, SbxClassType t )
520 return dynamic_cast<SbMethod*> (pMethods->Find( rName, t ));
524 // request/create property
526 SbProperty* SbModule::GetProperty( const OUString& rName, SbxDataType t )
528 SbxVariable* p = pProps->Find( rName, SbxClassType::Property );
529 SbProperty* pProp = dynamic_cast<SbProperty*>( p );
530 if( p && !pProp )
532 pProps->Remove( p );
534 if( !pProp )
536 pProp = new SbProperty( rName, t, this );
537 pProp->SetFlag( SbxFlagBits::ReadWrite );
538 pProp->SetParent( this );
539 pProps->Put( pProp, pProps->Count() );
540 StartListening(pProp->GetBroadcaster(), DuplicateHandling::Prevent);
542 return pProp;
545 void SbModule::GetProcedureProperty( const OUString& rName, SbxDataType t )
547 SbxVariable* p = pProps->Find( rName, SbxClassType::Property );
548 SbProcedureProperty* pProp = dynamic_cast<SbProcedureProperty*>( p );
549 if( p && !pProp )
551 pProps->Remove( p );
553 if( !pProp )
555 pProp = new SbProcedureProperty( rName, t );
556 pProp->SetFlag( SbxFlagBits::ReadWrite );
557 pProp->SetParent( this );
558 pProps->Put( pProp, pProps->Count() );
559 StartListening(pProp->GetBroadcaster(), DuplicateHandling::Prevent);
563 void SbModule::GetIfaceMapperMethod( const OUString& rName, SbMethod* pImplMeth )
565 SbxVariable* p = pMethods->Find( rName, SbxClassType::Method );
566 SbIfaceMapperMethod* pMapperMethod = dynamic_cast<SbIfaceMapperMethod*>( p );
567 if( p && !pMapperMethod )
569 pMethods->Remove( p );
571 if( !pMapperMethod )
573 pMapperMethod = new SbIfaceMapperMethod( rName, pImplMeth );
574 pMapperMethod->SetParent( this );
575 pMapperMethod->SetFlags( SbxFlagBits::Read );
576 pMethods->Put( pMapperMethod, pMethods->Count() );
578 pMapperMethod->bInvalid = false;
581 SbIfaceMapperMethod::~SbIfaceMapperMethod()
586 // From the code generator: remove invalid entries
588 void SbModule::EndDefinitions( bool bNewState )
590 for( sal_uInt16 i = 0; i < pMethods->Count(); )
592 SbMethod* p = dynamic_cast<SbMethod*>( pMethods->Get( i ) );
593 if( p )
595 if( p->bInvalid )
597 pMethods->Remove( p );
599 else
601 p->bInvalid = bNewState;
602 i++;
605 else
606 i++;
608 SetModified( true );
611 void SbModule::Clear()
613 delete pImage; pImage = nullptr;
614 if( pClassData )
615 pClassData->clear();
616 SbxObject::Clear();
620 SbxVariable* SbModule::Find( const OUString& rName, SbxClassType t )
622 // make sure a search in an uninstantiated class module will fail
623 SbxVariable* pRes = SbxObject::Find( rName, t );
624 if ( bIsProxyModule && !GetSbData()->bRunInit )
626 return nullptr;
628 if( !pRes && pImage )
630 SbiInstance* pInst = GetSbData()->pInst;
631 if( pInst && pInst->IsCompatibility() )
633 // Put enum types as objects into module,
634 // allows MyEnum.First notation
635 SbxArrayRef xArray = pImage->GetEnums();
636 if( xArray.is() )
638 SbxVariable* pEnumVar = xArray->Find( rName, SbxClassType::DontCare );
639 SbxObject* pEnumObject = dynamic_cast<SbxObject*>( pEnumVar );
640 if( pEnumObject )
642 bool bPrivate = pEnumObject->IsSet( SbxFlagBits::Private );
643 OUString aEnumName = pEnumObject->GetName();
645 pRes = new SbxVariable( SbxOBJECT );
646 pRes->SetName( aEnumName );
647 pRes->SetParent( this );
648 pRes->SetFlag( SbxFlagBits::Read );
649 if( bPrivate )
651 pRes->SetFlag( SbxFlagBits::Private );
653 pRes->PutObject( pEnumObject );
658 return pRes;
662 const OUString& SbModule::GetSource() const
664 return aOUSource;
667 // Parent and BASIC are one!
669 void SbModule::SetParent( SbxObject* p )
671 pParent = p;
674 void SbModule::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
676 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
677 if( pHint )
679 SbxVariable* pVar = pHint->GetVar();
680 SbProperty* pProp = dynamic_cast<SbProperty*>( pVar );
681 SbMethod* pMeth = dynamic_cast<SbMethod*>( pVar );
682 SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( pVar );
683 if( pProcProperty )
686 if( pHint->GetId() == SfxHintId::BasicDataWanted )
688 OUString aProcName = "Property Get "
689 + pProcProperty->GetName();
691 SbxVariable* pMethVar = Find( aProcName, SbxClassType::Method );
692 if( pMethVar )
694 SbxValues aVals;
695 aVals.eType = SbxVARIANT;
697 SbxArray* pArg = pVar->GetParameters();
698 sal_uInt16 nVarParCount = (pArg != nullptr) ? pArg->Count() : 0;
699 if( nVarParCount > 1 )
701 auto xMethParameters = tools::make_ref<SbxArray>();
702 xMethParameters->Put( pMethVar, 0 ); // Method as parameter 0
703 for( sal_uInt16 i = 1 ; i < nVarParCount ; ++i )
705 SbxVariable* pPar = pArg->Get( i );
706 xMethParameters->Put( pPar, i );
709 pMethVar->SetParameters( xMethParameters.get() );
710 pMethVar->Get( aVals );
711 pMethVar->SetParameters( nullptr );
713 else
715 pMethVar->Get( aVals );
718 pVar->Put( aVals );
721 else if( pHint->GetId() == SfxHintId::BasicDataChanged )
723 SbxVariable* pMethVar = nullptr;
725 bool bSet = pProcProperty->isSet();
726 if( bSet )
728 pProcProperty->setSet( false );
730 OUString aProcName = "Property Set "
731 + pProcProperty->GetName();
732 pMethVar = Find( aProcName, SbxClassType::Method );
734 if( !pMethVar ) // Let
736 OUString aProcName = "Property Let "
737 + pProcProperty->GetName();
738 pMethVar = Find( aProcName, SbxClassType::Method );
741 if( pMethVar )
743 // Setup parameters
744 SbxArrayRef xArray = new SbxArray;
745 xArray->Put( pMethVar, 0 ); // Method as parameter 0
746 xArray->Put( pVar, 1 );
747 pMethVar->SetParameters( xArray.get() );
749 SbxValues aVals;
750 pMethVar->Get( aVals );
751 pMethVar->SetParameters( nullptr );
755 if( pProp )
757 if( pProp->GetModule() != this )
758 SetError( ERRCODE_BASIC_BAD_ACTION );
760 else if( pMeth )
762 if( pHint->GetId() == SfxHintId::BasicDataWanted )
764 if( pMeth->bInvalid && !Compile() )
766 // auto compile has not worked!
767 StarBASIC::Error( ERRCODE_BASIC_BAD_PROP_VALUE );
769 else
771 // Call of a subprogram
772 SbModule* pOld = GetSbData()->pMod;
773 GetSbData()->pMod = this;
774 Run( static_cast<SbMethod*>(pVar) );
775 GetSbData()->pMod = pOld;
779 else
781 // #i92642: Special handling for name property to avoid
782 // side effects when using name as variable implicitly
783 bool bForwardToSbxObject = true;
785 const SfxHintId nId = pHint->GetId();
786 if( (nId == SfxHintId::BasicDataWanted || nId == SfxHintId::BasicDataChanged) &&
787 pVar->GetName().equalsIgnoreAsciiCase( "name" ) )
789 bForwardToSbxObject = false;
791 if( bForwardToSbxObject )
793 SbxObject::Notify( rBC, rHint );
799 // The setting of the source makes the image invalid
800 // and scans the method definitions newly in
802 void SbModule::SetSource32( const OUString& r )
804 // Default basic mode to library container mode, but... allow Option VBASupport 0/1 override
805 SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) );
806 aOUSource = r;
807 StartDefinitions();
808 SbiTokenizer aTok( r );
809 aTok.SetCompatible( IsVBACompat() );
811 while( !aTok.IsEof() )
813 SbiToken eEndTok = NIL;
815 // Searching for SUB or FUNCTION
816 SbiToken eLastTok = NIL;
817 while( !aTok.IsEof() )
819 // #32385: not by declare
820 SbiToken eCurTok = aTok.Next();
821 if( eLastTok != DECLARE )
823 if( eCurTok == SUB )
825 eEndTok = ENDSUB; break;
827 if( eCurTok == FUNCTION )
829 eEndTok = ENDFUNC; break;
831 if( eCurTok == PROPERTY )
833 eEndTok = ENDPROPERTY; break;
835 if( eCurTok == OPTION )
837 eCurTok = aTok.Next();
838 if( eCurTok == COMPATIBLE )
840 aTok.SetCompatible( true );
842 else if ( ( eCurTok == VBASUPPORT ) && ( aTok.Next() == NUMBER ) )
844 bool bIsVBA = ( aTok.GetDbl()== 1 );
845 SetVBACompat( bIsVBA );
846 aTok.SetCompatible( bIsVBA );
850 eLastTok = eCurTok;
852 // Definition of the method
853 SbMethod* pMeth = nullptr;
854 if( eEndTok != NIL )
856 sal_uInt16 nLine1 = aTok.GetLine();
857 if( aTok.Next() == SYMBOL )
859 OUString aName_( aTok.GetSym() );
860 SbxDataType t = aTok.GetType();
861 if( t == SbxVARIANT && eEndTok == ENDSUB )
863 t = SbxVOID;
865 pMeth = GetMethod( aName_, t );
866 pMeth->nLine1 = pMeth->nLine2 = nLine1;
867 // The method is for a start VALID
868 pMeth->bInvalid = false;
870 else
872 eEndTok = NIL;
875 // Skip up to END SUB/END FUNCTION
876 if( eEndTok != NIL )
878 while( !aTok.IsEof() )
880 if( aTok.Next() == eEndTok )
882 pMeth->nLine2 = aTok.GetLine();
883 break;
886 if( aTok.IsEof() )
888 pMeth->nLine2 = aTok.GetLine();
892 EndDefinitions( true );
895 // Broadcast of a hint to all Basics
897 static void SendHint_( SbxObject* pObj, SfxHintId nId, SbMethod* p )
899 // Self a BASIC?
900 if( dynamic_cast<const StarBASIC *>(pObj) != nullptr && pObj->IsBroadcaster() )
901 pObj->GetBroadcaster().Broadcast( SbxHint( nId, p ) );
902 // Then ask for the subobjects
903 SbxArray* pObjs = pObj->GetObjects();
904 for( sal_uInt16 i = 0; i < pObjs->Count(); i++ )
906 SbxVariable* pVar = pObjs->Get( i );
907 if( dynamic_cast<const SbxObject *>(pVar) != nullptr )
908 SendHint_( dynamic_cast<SbxObject*>( pVar), nId, p );
912 static void SendHint( SbxObject* pObj, SfxHintId nId, SbMethod* p )
914 while( pObj->GetParent() )
915 pObj = pObj->GetParent();
916 SendHint_( pObj, nId, p );
919 // #57841 Clear Uno-Objects, which were helt in RTL functions,
920 // at the end of the program, so that nothing were helt.
921 static void ClearUnoObjectsInRTL_Impl_Rek( StarBASIC* pBasic )
923 // delete the return value of CreateUnoService
924 SbxVariable* pVar = pBasic->GetRtl()->Find( "CreateUnoService", SbxClassType::Method );
925 if( pVar )
927 pVar->SbxValue::Clear();
929 // delete the return value of CreateUnoDialog
930 pVar = pBasic->GetRtl()->Find( "CreateUnoDialog", SbxClassType::Method );
931 if( pVar )
933 pVar->SbxValue::Clear();
935 // delete the return value of CDec
936 pVar = pBasic->GetRtl()->Find( "CDec", SbxClassType::Method );
937 if( pVar )
939 pVar->SbxValue::Clear();
941 // delete return value of CreateObject
942 pVar = pBasic->GetRtl()->Find( "CreateObject", SbxClassType::Method );
943 if( pVar )
945 pVar->SbxValue::Clear();
947 // Go over all Sub-Basics
948 SbxArray* pObjs = pBasic->GetObjects();
949 sal_uInt16 nCount = pObjs->Count();
950 for( sal_uInt16 i = 0 ; i < nCount ; i++ )
952 SbxVariable* pObjVar = pObjs->Get( i );
953 StarBASIC* pSubBasic = dynamic_cast<StarBASIC*>( pObjVar );
954 if( pSubBasic )
956 ClearUnoObjectsInRTL_Impl_Rek( pSubBasic );
961 static void ClearUnoObjectsInRTL_Impl( StarBASIC* pBasic )
963 // #67781 Delete return values of the Uno-methods
964 clearUnoMethods();
966 ClearUnoObjectsInRTL_Impl_Rek( pBasic );
968 // Search for the topmost Basic
969 SbxObject* p = pBasic;
970 while( p->GetParent() )
971 p = p->GetParent();
972 if( static_cast<StarBASIC*>(p) != pBasic )
973 ClearUnoObjectsInRTL_Impl_Rek( static_cast<StarBASIC*>(p) );
977 void SbModule::SetVBACompat( bool bCompat )
979 if( mbVBACompat != bCompat )
981 mbVBACompat = bCompat;
982 // initialize VBA document API
983 if( mbVBACompat ) try
985 StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
986 uno::Reference< lang::XMultiServiceFactory > xFactory( getDocumentModel( pBasic ), uno::UNO_QUERY_THROW );
987 xFactory->createInstance( "ooo.vba.VBAGlobals" );
989 catch( Exception& )
995 // Run a Basic-subprogram
996 void SbModule::Run( SbMethod* pMeth )
998 SAL_INFO("basic","About to run " << pMeth->GetName() << ", vba compatmode is " << mbVBACompat );
1000 static sal_uInt16 nMaxCallLevel = 0;
1002 SbiGlobals* pSbData = GetSbData();
1004 bool bDelInst = pSbData->pInst == nullptr;
1005 bool bQuit = false;
1006 StarBASICRef xBasic;
1007 uno::Reference< frame::XModel > xModel;
1008 uno::Reference< script::vba::XVBACompatibility > xVBACompat;
1009 if( bDelInst )
1011 // #32779: Hold Basic during the execution
1012 xBasic = static_cast<StarBASIC*>( GetParent() );
1014 pSbData->pInst = new SbiInstance( static_cast<StarBASIC*>(GetParent()) );
1016 /* If a VBA script in a document is started, get the VBA compatibility
1017 interface from the document Basic library container, and notify all
1018 VBA script listeners about the started script. */
1019 if( mbVBACompat )
1021 StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
1022 if( pBasic && pBasic->IsDocBasic() ) try
1024 xModel.set( getDocumentModel( pBasic ), uno::UNO_SET_THROW );
1025 xVBACompat.set( getVBACompatibility( xModel ), uno::UNO_SET_THROW );
1026 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STARTED, GetName() );
1028 catch(const uno::Exception& )
1033 // Launcher problem
1034 // i80726 The Find below will generate an error in Testtool so we reset it unless there was one before already
1035 bool bWasError = SbxBase::GetError() != ERRCODE_NONE;
1036 SbxVariable* pMSOMacroRuntimeLibVar = Find( "Launcher", SbxClassType::Object );
1037 if ( !bWasError && (SbxBase::GetError() == ERRCODE_BASIC_PROC_UNDEFINED) )
1038 SbxBase::ResetError();
1039 if( pMSOMacroRuntimeLibVar )
1041 StarBASIC* pMSOMacroRuntimeLib = dynamic_cast<StarBASIC*>( pMSOMacroRuntimeLibVar );
1042 if( pMSOMacroRuntimeLib )
1044 SbxFlagBits nGblFlag = pMSOMacroRuntimeLib->GetFlags() & SbxFlagBits::GlobalSearch;
1045 pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::GlobalSearch );
1046 SbxVariable* pAppSymbol = pMSOMacroRuntimeLib->Find( "Application", SbxClassType::Method );
1047 pMSOMacroRuntimeLib->SetFlag( nGblFlag );
1048 if( pAppSymbol )
1050 pMSOMacroRuntimeLib->SetFlag( SbxFlagBits::ExtSearch ); // Could have been disabled before
1051 pSbData->pMSOMacroRuntimLib = pMSOMacroRuntimeLib;
1056 if( nMaxCallLevel == 0 )
1058 #ifdef UNX
1059 struct rlimit rl;
1060 getrlimit ( RLIMIT_STACK, &rl );
1061 #endif
1062 #if defined LINUX
1063 // Empiric value, 900 = needed bytes/Basic call level
1064 // for Linux including 10% safety margin
1065 nMaxCallLevel = rl.rlim_cur / 900;
1066 #elif defined __sun
1067 // Empiric value, 1650 = needed bytes/Basic call level
1068 // for Solaris including 10% safety margin
1069 nMaxCallLevel = rl.rlim_cur / 1650;
1070 #elif defined _WIN32
1071 nMaxCallLevel = 5800;
1072 #else
1073 nMaxCallLevel = MAXRECURSION;
1074 #endif
1078 // Recursion to deep?
1079 if( ++pSbData->pInst->nCallLvl <= nMaxCallLevel )
1081 // Define a globale variable in all Mods
1082 GlobalRunInit( /* bBasicStart = */ bDelInst );
1084 // Appeared a compiler error? Then we don't launch
1085 if( !pSbData->bGlobalInitErr )
1087 if( bDelInst )
1089 SendHint( GetParent(), SfxHintId::BasicStart, pMeth );
1091 // 1996-10-16: #31460 New concept for StepInto/Over/Out
1092 // For an explanation see runtime.cxx at SbiInstance::CalcBreakCallLevel()
1093 // Identify the BreakCallLevel
1094 pSbData->pInst->CalcBreakCallLevel( pMeth->GetDebugFlags() );
1097 SbModule* pOldMod = pSbData->pMod;
1098 pSbData->pMod = this;
1099 std::unique_ptr<SbiRuntime> pRt(new SbiRuntime( this, pMeth, pMeth->nStart ));
1101 pRt->pNext = pSbData->pInst->pRun;
1102 if( pRt->pNext )
1103 pRt->pNext->block();
1104 pSbData->pInst->pRun = pRt.get();
1105 if ( mbVBACompat )
1107 pSbData->pInst->EnableCompatibility( true );
1110 while( pRt->Step() ) {}
1112 if( pRt->pNext )
1113 pRt->pNext->unblock();
1115 // #63710 It can happen by an another thread handling at events,
1116 // that the show call returns to a dialog (by closing the
1117 // dialog per UI), before a by an event triggered further call returned,
1118 // which stands in Basic more top in the stack and that had been run on
1119 // a Basic-Breakpoint. Then would the instance below destroyed. And if the Basic,
1120 // that stand still in the call, further runs, there is a GPF.
1121 // Thus here had to be wait until the other call comes back.
1122 if( bDelInst )
1124 // Compare here with 1 instead of 0, because before nCallLvl--
1125 while (pSbData->pInst->nCallLvl != 1)
1126 Application::Yield();
1129 pSbData->pInst->pRun = pRt->pNext;
1130 pSbData->pInst->nCallLvl--; // Call-Level down again
1132 // Exist an higher-ranking runtime instance?
1133 // Then take over BasicDebugFlags::Break, if set
1134 SbiRuntime* pRtNext = pRt->pNext;
1135 if( pRtNext && (pRt->GetDebugFlags() & BasicDebugFlags::Break) )
1136 pRtNext->SetDebugFlags( BasicDebugFlags::Break );
1138 pRt.reset();
1139 pSbData->pMod = pOldMod;
1140 if( bDelInst )
1142 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1143 // at the end of the program, so that nothing were helt.
1144 ClearUnoObjectsInRTL_Impl( xBasic.get() );
1146 clearNativeObjectWrapperVector();
1148 SAL_WARN_IF(pSbData->pInst->nCallLvl != 0,"basic","BASIC-Call-Level > 0");
1149 delete pSbData->pInst;
1150 pSbData->pInst = nullptr;
1151 bDelInst = false;
1153 // #i30690
1154 SolarMutexGuard aSolarGuard;
1155 SendHint( GetParent(), SfxHintId::BasicStop, pMeth );
1157 GlobalRunDeInit();
1159 if( xVBACompat.is() )
1161 // notify all VBA script listeners about the stopped script
1164 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STOPPED, GetName() );
1166 catch(const uno::Exception& )
1169 // VBA always ensures screenupdating is enabled after completing
1170 ::basic::vba::lockControllersOfAllDocuments( xModel, false );
1171 ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, true );
1175 else
1176 pSbData->pInst->nCallLvl--; // Call-Level down again
1178 else
1180 pSbData->pInst->nCallLvl--; // Call-Level down again
1181 StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW );
1184 StarBASIC* pBasic = dynamic_cast<StarBASIC*>( GetParent() );
1185 if( bDelInst )
1187 // #57841 Clear Uno-Objects, which were helt in RTL functions,
1188 // the end of the program, so that nothing were helt.
1189 ClearUnoObjectsInRTL_Impl( xBasic.get() );
1191 delete pSbData->pInst;
1192 pSbData->pInst = nullptr;
1194 if ( pBasic && pBasic->IsDocBasic() && pBasic->IsQuitApplication() && !pSbData->pInst )
1195 bQuit = true;
1196 if ( bQuit )
1198 Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ) );
1202 namespace
1204 class SbiRuntimeGuard
1206 private:
1207 std::unique_ptr<SbiRuntime> m_xRt;
1208 SbiGlobals* m_pSbData;
1209 SbModule* m_pOldMod;
1210 public:
1211 SbiRuntimeGuard(SbModule* pModule, SbiGlobals* pSbData)
1212 : m_xRt(new SbiRuntime(pModule, nullptr, 0))
1213 , m_pSbData(pSbData)
1214 , m_pOldMod(pSbData->pMod)
1216 m_xRt->pNext = pSbData->pInst->pRun;
1217 m_pSbData->pMod = pModule;
1218 m_pSbData->pInst->pRun = m_xRt.get();
1220 void run()
1222 while (m_xRt->Step()) {}
1224 ~SbiRuntimeGuard()
1226 m_pSbData->pInst->pRun = m_xRt->pNext;
1227 m_pSbData->pMod = m_pOldMod;
1228 m_xRt.reset();
1233 // Execute of the init method of a module after the loading
1234 // or the compilation
1235 void SbModule::RunInit()
1237 if( pImage
1238 && !pImage->bInit
1239 && pImage->IsFlag( SbiImageFlags::INITCODE ) )
1241 SbiGlobals* pSbData = GetSbData();
1243 // Set flag, so that RunInit get active (Testtool)
1244 pSbData->bRunInit = true;
1246 // The init code starts always here
1247 auto xRuntimeGuard(std::make_unique<SbiRuntimeGuard>(this, pSbData));
1248 xRuntimeGuard->run();
1249 xRuntimeGuard.reset();
1251 pImage->bInit = true;
1252 pImage->bFirstInit = false;
1254 // RunInit is not active anymore
1255 pSbData->bRunInit = false;
1259 // Delete with private/dim declared variables
1261 void SbModule::AddVarName( const OUString& aName )
1263 // see if the name is added already
1264 for ( const auto& rModuleVariableName: mModuleVariableNames )
1266 if ( aName == rModuleVariableName )
1267 return;
1269 mModuleVariableNames.push_back( aName );
1272 void SbModule::RemoveVars()
1274 for ( const auto& rModuleVariableName: mModuleVariableNames )
1276 // We don't want a Find being called in a derived class ( e.g.
1277 // SbUserform because it could trigger say an initialise event
1278 // 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 )
1279 SbxVariableRef p = SbModule::Find( rModuleVariableName, SbxClassType::Property );
1280 if( p.is() )
1281 Remove( p.get() );
1285 void SbModule::ClearPrivateVars()
1287 for( sal_uInt16 i = 0 ; i < pProps->Count() ; i++ )
1289 SbProperty* p = dynamic_cast<SbProperty*>( pProps->Get( i ) );
1290 if( p )
1292 // Delete not the arrays, only their content
1293 if( p->GetType() & SbxARRAY )
1295 SbxArray* pArray = dynamic_cast<SbxArray*>( p->GetObject() );
1296 if( pArray )
1298 for( sal_uInt16 j = 0 ; j < pArray->Count() ; j++ )
1300 SbxVariable* pj = pArray->Get( j );
1301 pj->SbxValue::Clear();
1305 else
1307 p->SbxValue::Clear();
1313 void SbModule::implClearIfVarDependsOnDeletedBasic( SbxVariable* pVar, StarBASIC* pDeletedBasic )
1315 if( pVar->SbxValue::GetType() != SbxOBJECT || dynamic_cast<const SbProcedureProperty*>( pVar) != nullptr )
1316 return;
1318 SbxObject* pObj = dynamic_cast<SbxObject*>( pVar->GetObject() );
1319 if( pObj != nullptr )
1321 SbxObject* p = pObj;
1323 SbModule* pMod = dynamic_cast<SbModule*>( p );
1324 if( pMod != nullptr )
1325 pMod->ClearVarsDependingOnDeletedBasic( pDeletedBasic );
1327 while( (p = p->GetParent()) != nullptr )
1329 StarBASIC* pBasic = dynamic_cast<StarBASIC*>( p );
1330 if( pBasic != nullptr && pBasic == pDeletedBasic )
1332 pVar->SbxValue::Clear();
1333 break;
1339 void SbModule::ClearVarsDependingOnDeletedBasic( StarBASIC* pDeletedBasic )
1341 for( sal_uInt16 i = 0 ; i < pProps->Count() ; i++ )
1343 SbProperty* p = dynamic_cast<SbProperty*>( pProps->Get( i ) );
1344 if( p )
1346 if( p->GetType() & SbxARRAY )
1348 SbxArray* pArray = dynamic_cast<SbxArray*>( p->GetObject() );
1349 if( pArray )
1351 for( sal_uInt16 j = 0 ; j < pArray->Count() ; j++ )
1353 SbxVariable* pVar = pArray->Get( j );
1354 implClearIfVarDependsOnDeletedBasic( pVar, pDeletedBasic );
1358 else
1360 implClearIfVarDependsOnDeletedBasic( p, pDeletedBasic );
1366 void StarBASIC::ClearAllModuleVars()
1368 // Initialise the own module
1369 for (const auto& rModule: pModules)
1371 // Initialise only, if the startcode was already executed
1372 if( rModule->pImage && rModule->pImage->bInit && !rModule->isProxyModule() && dynamic_cast<const SbObjModule*>( rModule.get()) == nullptr )
1373 rModule->ClearPrivateVars();
1378 // Execution of the init-code of all module
1379 void SbModule::GlobalRunInit( bool bBasicStart )
1381 // If no Basic-Start, only initialise, if the module is not initialised
1382 if( !bBasicStart )
1383 if( !(pImage && !pImage->bInit) )
1384 return;
1386 // Initialise GlobalInitErr-Flag for Compiler-Error
1387 // With the help of this flags could be located in SbModule::Run() after the call of
1388 // GlobalRunInit, if at the initialising of the module
1389 // an error occurred. Then it will not be launched.
1390 GetSbData()->bGlobalInitErr = false;
1392 // Parent of the module is a Basic
1393 StarBASIC *pBasic = dynamic_cast<StarBASIC*>( GetParent() );
1394 if( pBasic )
1396 pBasic->InitAllModules();
1398 SbxObject* pParent_ = pBasic->GetParent();
1399 if( pParent_ )
1401 StarBASIC * pParentBasic = dynamic_cast<StarBASIC*>( pParent_ );
1402 if( pParentBasic )
1404 pParentBasic->InitAllModules( pBasic );
1406 // #109018 Parent can also have a parent (library in doc)
1407 SbxObject* pParentParent = pParentBasic->GetParent();
1408 if( pParentParent )
1410 StarBASIC * pParentParentBasic = dynamic_cast<StarBASIC*>( pParentParent );
1411 if( pParentParentBasic )
1412 pParentParentBasic->InitAllModules( pParentBasic );
1419 void SbModule::GlobalRunDeInit()
1421 StarBASIC *pBasic = dynamic_cast<StarBASIC*>( GetParent() );
1422 if( pBasic )
1424 pBasic->DeInitAllModules();
1426 SbxObject* pParent_ = pBasic->GetParent();
1427 if( pParent_ )
1428 pBasic = dynamic_cast<StarBASIC*>( pParent_ );
1429 if( pBasic )
1430 pBasic->DeInitAllModules();
1434 // Search for the next STMNT-Command in the code. This was used from the STMNT-
1435 // Opcode to set the endcolumn.
1437 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol ) const
1439 return FindNextStmnt( p, nLine, nCol, false );
1442 const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol,
1443 bool bFollowJumps, const SbiImage* pImg ) const
1445 sal_uInt32 nPC = static_cast<sal_uInt32>( p - reinterpret_cast<const sal_uInt8*>(pImage->GetCode()) );
1446 while( nPC < pImage->GetCodeSize() )
1448 SbiOpcode eOp = static_cast<SbiOpcode>( *p++ );
1449 nPC++;
1450 if( bFollowJumps && eOp == SbiOpcode::JUMP_ && pImg )
1452 SAL_WARN_IF( !pImg, "basic", "FindNextStmnt: pImg==NULL with FollowJumps option" );
1453 sal_uInt32 nOp1 = *p++; nOp1 |= *p++ << 8;
1454 nOp1 |= *p++ << 16; nOp1 |= *p++ << 24;
1455 p = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
1457 else if( eOp >= SbiOpcode::SbOP1_START && eOp <= SbiOpcode::SbOP1_END )
1459 p += 4;
1460 nPC += 4;
1462 else if( eOp == SbiOpcode::STMNT_ )
1464 sal_uInt32 nl, nc;
1465 nl = *p++; nl |= *p++ << 8;
1466 nl |= *p++ << 16 ; nl |= *p++ << 24;
1467 nc = *p++; nc |= *p++ << 8;
1468 nc |= *p++ << 16 ; nc |= *p++ << 24;
1469 nLine = static_cast<sal_uInt16>(nl); nCol = static_cast<sal_uInt16>(nc);
1470 return p;
1472 else if( eOp >= SbiOpcode::SbOP2_START && eOp <= SbiOpcode::SbOP2_END )
1474 p += 8;
1475 nPC += 8;
1477 else if( !( eOp >= SbiOpcode::SbOP0_START && eOp <= SbiOpcode::SbOP0_END ) )
1479 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
1480 break;
1483 return nullptr;
1486 // Test, if a line contains STMNT-Opcodes
1488 bool SbModule::IsBreakable( sal_uInt16 nLine ) const
1490 if( !pImage )
1491 return false;
1492 const sal_uInt8* p = reinterpret_cast<const sal_uInt8*>(pImage->GetCode());
1493 sal_uInt16 nl, nc;
1494 while( ( p = FindNextStmnt( p, nl, nc ) ) != nullptr )
1495 if( nl == nLine )
1496 return true;
1497 return false;
1500 bool SbModule::IsBP( sal_uInt16 nLine ) const
1502 if( pBreaks )
1504 for( size_t i = 0; i < pBreaks->size(); i++ )
1506 sal_uInt16 b = pBreaks->operator[]( i );
1507 if( b == nLine )
1508 return true;
1509 if( b < nLine )
1510 break;
1513 return false;
1516 bool SbModule::SetBP( sal_uInt16 nLine )
1518 if( !IsBreakable( nLine ) )
1519 return false;
1520 if( !pBreaks )
1521 pBreaks = new SbiBreakpoints;
1522 auto it = std::find_if(pBreaks->begin(), pBreaks->end(),
1523 [&nLine](const sal_uInt16 b) { return b <= nLine; });
1524 if (it != pBreaks->end() && *it == nLine)
1525 return true;
1526 pBreaks->insert( it, nLine );
1528 // #38568: Set during runtime as well here BasicDebugFlags::Break
1529 if( GetSbData()->pInst && GetSbData()->pInst->pRun )
1530 GetSbData()->pInst->pRun->SetDebugFlags( BasicDebugFlags::Break );
1532 return IsBreakable( nLine );
1535 bool SbModule::ClearBP( sal_uInt16 nLine )
1537 bool bRes = false;
1538 if( pBreaks )
1540 auto it = std::find_if(pBreaks->begin(), pBreaks->end(),
1541 [&nLine](const sal_uInt16 b) { return b <= nLine; });
1542 bRes = (it != pBreaks->end()) && (*it == nLine);
1543 if (bRes)
1545 pBreaks->erase(it);
1547 if( pBreaks->empty() )
1549 delete pBreaks;
1550 pBreaks = nullptr;
1553 return bRes;
1556 void SbModule::ClearAllBP()
1558 delete pBreaks;
1559 pBreaks = nullptr;
1562 void
1563 SbModule::fixUpMethodStart( bool bCvtToLegacy, SbiImage* pImg ) const
1565 if ( !pImg )
1566 pImg = pImage;
1567 for( sal_uInt32 i = 0; i < pMethods->Count(); i++ )
1569 SbMethod* pMeth = dynamic_cast<SbMethod*>( pMethods->Get( static_cast<sal_uInt16>(i) ) );
1570 if( pMeth )
1572 //fixup method start positions
1573 if ( bCvtToLegacy )
1574 pMeth->nStart = pImg->CalcLegacyOffset( pMeth->nStart );
1575 else
1576 pMeth->nStart = pImg->CalcNewOffset( static_cast<sal_uInt16>(pMeth->nStart) );
1582 bool SbModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
1584 Clear();
1585 if( !SbxObject::LoadData( rStrm, 1 ) )
1586 return false;
1587 // As a precaution...
1588 SetFlag( SbxFlagBits::ExtSearch | SbxFlagBits::GlobalSearch );
1589 sal_uInt8 bImage;
1590 rStrm.ReadUChar( bImage );
1591 if( bImage )
1593 SbiImage* p = new SbiImage;
1594 sal_uInt32 nImgVer = 0;
1596 if( !p->Load( rStrm, nImgVer ) )
1598 delete p;
1599 return false;
1601 // If the image is in old format, we fix up the method start offsets
1602 if ( nImgVer < B_EXT_IMG_VERSION )
1604 fixUpMethodStart( false, p );
1605 p->ReleaseLegacyBuffer();
1607 aComment = p->aComment;
1608 SetName( p->aName );
1609 if( p->GetCodeSize() )
1611 aOUSource = p->aOUSource;
1612 // Old version: image away
1613 if( nVer == 1 )
1615 SetSource32( p->aOUSource );
1616 delete p;
1618 else
1619 pImage = p;
1621 else
1623 SetSource32( p->aOUSource );
1624 delete p;
1627 return true;
1630 bool SbModule::StoreData( SvStream& rStrm ) const
1632 bool bFixup = ( pImage && !pImage->ExceedsLegacyLimits() );
1633 if ( bFixup )
1634 fixUpMethodStart( true );
1635 bool bRet = SbxObject::StoreData( rStrm );
1636 if ( !bRet )
1637 return false;
1639 if( pImage )
1641 pImage->aOUSource = aOUSource;
1642 pImage->aComment = aComment;
1643 pImage->aName = GetName();
1644 rStrm.WriteUChar( 1 );
1645 // # PCode is saved only for legacy formats only
1646 // It should be noted that it probably isn't necessary
1647 // It would be better not to store the image ( more flexible with
1648 // formats )
1649 bool bRes = pImage->Save( rStrm, B_LEGACYVERSION );
1650 if ( bFixup )
1651 fixUpMethodStart( false ); // restore method starts
1652 return bRes;
1655 else
1657 SbiImage aImg;
1658 aImg.aOUSource = aOUSource;
1659 aImg.aComment = aComment;
1660 aImg.aName = GetName();
1661 rStrm.WriteUChar( 1 );
1662 return aImg.Save( rStrm );
1666 bool SbModule::ExceedsLegacyModuleSize()
1668 if ( !IsCompiled() )
1669 Compile();
1670 return pImage && pImage->ExceedsLegacyLimits();
1673 class ErrorHdlResetter
1675 Link<StarBASIC*,bool> mErrHandler;
1676 bool mbError;
1677 public:
1678 ErrorHdlResetter()
1679 : mErrHandler(StarBASIC::GetGlobalErrorHdl()) // save error handler
1680 , mbError( false )
1682 // set new error handler
1683 StarBASIC::SetGlobalErrorHdl( LINK( this, ErrorHdlResetter, BasicErrorHdl ) );
1685 ~ErrorHdlResetter()
1687 // restore error handler
1688 StarBASIC::SetGlobalErrorHdl(mErrHandler);
1690 DECL_LINK( BasicErrorHdl, StarBASIC *, bool );
1691 bool HasError() const { return mbError; }
1694 IMPL_LINK( ErrorHdlResetter, BasicErrorHdl, StarBASIC *, /*pBasic*/, bool)
1696 mbError = true;
1697 return false;
1700 void SbModule::GetCodeCompleteDataFromParse(CodeCompleteDataCache& aCache)
1702 ErrorHdlResetter aErrHdl;
1703 SbxBase::ResetError();
1705 std::unique_ptr<SbiParser> pParser(new SbiParser( static_cast<StarBASIC*>(GetParent()), this ));
1706 pParser->SetCodeCompleting(true);
1708 while( pParser->Parse() ) {}
1709 SbiSymPool* pPool = pParser->pPool;
1710 aCache.Clear();
1711 for( sal_uInt16 i = 0; i < pPool->GetSize(); ++i )
1713 SbiSymDef* pSymDef = pPool->Get(i);
1714 //std::cerr << "i: " << i << ", type: " << pSymDef->GetType() << "; name:" << pSymDef->GetName() << std::endl;
1715 if( (pSymDef->GetType() != SbxEMPTY) && (pSymDef->GetType() != SbxNULL) )
1716 aCache.InsertGlobalVar( pSymDef->GetName(), pParser->aGblStrings.Find(pSymDef->GetTypeId()) );
1718 SbiSymPool& rChildPool = pSymDef->GetPool();
1719 for(sal_uInt16 j = 0; j < rChildPool.GetSize(); ++j )
1721 SbiSymDef* pChildSymDef = rChildPool.Get(j);
1722 //std::cerr << "j: " << j << ", type: " << pChildSymDef->GetType() << "; name:" << pChildSymDef->GetName() << std::endl;
1723 if( (pChildSymDef->GetType() != SbxEMPTY) && (pChildSymDef->GetType() != SbxNULL) )
1724 aCache.InsertLocalVar( pSymDef->GetName(), pChildSymDef->GetName(), pParser->aGblStrings.Find(pChildSymDef->GetTypeId()) );
1730 OUString SbModule::GetKeywordCase( const OUString& sKeyword )
1732 return SbiParser::GetKeywordCase( sKeyword );
1735 bool SbModule::HasExeCode()
1737 // And empty Image always has the Global Chain set up
1738 static const unsigned char pEmptyImage[] = { 0x45, 0x0 , 0x0, 0x0, 0x0 };
1739 // lets be stricter for the moment than VBA
1741 if (!IsCompiled())
1743 ErrorHdlResetter aGblErrHdl;
1744 Compile();
1745 if (aGblErrHdl.HasError()) //assume unsafe on compile error
1746 return true;
1749 bool bRes = false;
1750 if (pImage && !(pImage->GetCodeSize() == 5 && (memcmp(pImage->GetCode(), pEmptyImage, pImage->GetCodeSize()) == 0 )))
1751 bRes = true;
1753 return bRes;
1756 // Store only image, no source
1757 void SbModule::StoreBinaryData( SvStream& rStrm )
1759 if (!Compile())
1760 return;
1762 if (!SbxObject::StoreData(rStrm))
1763 return;
1765 pImage->aOUSource.clear();
1766 pImage->aComment = aComment;
1767 pImage->aName = GetName();
1769 rStrm.WriteUChar(1);
1770 pImage->Save(rStrm);
1772 pImage->aOUSource = aOUSource;
1775 // Called for >= OO 1.0 passwd protected libraries only
1777 void SbModule::LoadBinaryData( SvStream& rStrm )
1779 OUString aKeepSource = aOUSource;
1780 LoadData( rStrm, 2 );
1781 LoadCompleted();
1782 aOUSource = aKeepSource;
1785 bool SbModule::LoadCompleted()
1787 SbxArray* p = GetMethods().get();
1788 sal_uInt16 i;
1789 for( i = 0; i < p->Count(); i++ )
1791 SbMethod* q = dynamic_cast<SbMethod*>( p->Get( i ) );
1792 if( q )
1793 q->pMod = this;
1795 p = GetProperties();
1796 for( i = 0; i < p->Count(); i++ )
1798 SbProperty* q = dynamic_cast<SbProperty*>( p->Get( i ) );
1799 if( q )
1800 q->pMod = this;
1802 return true;
1805 void SbModule::handleProcedureProperties( SfxBroadcaster& rBC, const SfxHint& rHint )
1807 bool bDone = false;
1809 const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
1810 if( pHint )
1812 SbxVariable* pVar = pHint->GetVar();
1813 SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( pVar );
1814 if( pProcProperty )
1816 bDone = true;
1818 if( pHint->GetId() == SfxHintId::BasicDataWanted )
1820 OUString aProcName = "Property Get "
1821 + pProcProperty->GetName();
1823 SbxVariable* pMeth = Find( aProcName, SbxClassType::Method );
1824 if( pMeth )
1826 SbxValues aVals;
1827 aVals.eType = SbxVARIANT;
1829 SbxArray* pArg = pVar->GetParameters();
1830 sal_uInt16 nVarParCount = (pArg != nullptr) ? pArg->Count() : 0;
1831 if( nVarParCount > 1 )
1833 SbxArrayRef xMethParameters = new SbxArray;
1834 xMethParameters->Put( pMeth, 0 ); // Method as parameter 0
1835 for( sal_uInt16 i = 1 ; i < nVarParCount ; ++i )
1837 SbxVariable* pPar = pArg->Get( i );
1838 xMethParameters->Put( pPar, i );
1841 pMeth->SetParameters( xMethParameters.get() );
1842 pMeth->Get( aVals );
1843 pMeth->SetParameters( nullptr );
1845 else
1847 pMeth->Get( aVals );
1850 pVar->Put( aVals );
1853 else if( pHint->GetId() == SfxHintId::BasicDataChanged )
1855 SbxVariable* pMeth = nullptr;
1857 bool bSet = pProcProperty->isSet();
1858 if( bSet )
1860 pProcProperty->setSet( false );
1862 OUString aProcName = "Property Set "
1863 + pProcProperty->GetName();
1864 pMeth = Find( aProcName, SbxClassType::Method );
1866 if( !pMeth ) // Let
1868 OUString aProcName = "Property Let "
1869 + pProcProperty->GetName();
1870 pMeth = Find( aProcName, SbxClassType::Method );
1873 if( pMeth )
1875 // Setup parameters
1876 SbxArrayRef xArray = new SbxArray;
1877 xArray->Put( pMeth, 0 ); // Method as parameter 0
1878 xArray->Put( pVar, 1 );
1879 pMeth->SetParameters( xArray.get() );
1881 SbxValues aVals;
1882 pMeth->Get( aVals );
1883 pMeth->SetParameters( nullptr );
1889 if( !bDone )
1890 SbModule::Notify( rBC, rHint );
1894 // Implementation SbJScriptModule (Basic module for JavaScript source code)
1895 SbJScriptModule::SbJScriptModule()
1896 :SbModule( "" )
1900 bool SbJScriptModule::LoadData( SvStream& rStrm, sal_uInt16 )
1902 Clear();
1903 if( !SbxObject::LoadData( rStrm, 1 ) )
1904 return false;
1906 // Get the source string
1907 aOUSource = rStrm.ReadUniOrByteString( osl_getThreadTextEncoding() );
1908 return true;
1911 bool SbJScriptModule::StoreData( SvStream& rStrm ) const
1913 if( !SbxObject::StoreData( rStrm ) )
1914 return false;
1916 // Write the source string
1917 OUString aTmp = aOUSource;
1918 rStrm.WriteUniOrByteString( aTmp, osl_getThreadTextEncoding() );
1919 return true;
1923 SbMethod::SbMethod( const OUString& r, SbxDataType t, SbModule* p )
1924 : SbxMethod( r, t ), pMod( p )
1926 bInvalid = true;
1927 nStart = 0;
1928 nDebugFlags = BasicDebugFlags::NONE;
1929 nLine1 = 0;
1930 nLine2 = 0;
1931 refStatics = new SbxArray;
1932 mCaller = nullptr;
1933 // HACK due to 'Reference could not be saved'
1934 SetFlag( SbxFlagBits::NoModify );
1937 SbMethod::SbMethod( const SbMethod& r )
1938 : SvRefBase( r ), SbxMethod( r )
1940 pMod = r.pMod;
1941 bInvalid = r.bInvalid;
1942 nStart = r.nStart;
1943 nDebugFlags = r.nDebugFlags;
1944 nLine1 = r.nLine1;
1945 nLine2 = r.nLine2;
1946 refStatics = r.refStatics;
1947 mCaller = r.mCaller;
1948 SetFlag( SbxFlagBits::NoModify );
1951 SbMethod::~SbMethod()
1955 void SbMethod::ClearStatics()
1957 refStatics = new SbxArray;
1960 SbxArray* SbMethod::GetStatics()
1962 return refStatics.get();
1965 bool SbMethod::LoadData( SvStream& rStrm, sal_uInt16 nVer )
1967 if( !SbxMethod::LoadData( rStrm, 1 ) )
1968 return false;
1970 sal_uInt16 nFlag;
1971 rStrm.ReadUInt16( nFlag );
1973 sal_Int16 nTempStart = static_cast<sal_Int16>(nStart);
1975 if( nVer == 2 )
1977 rStrm.ReadUInt16( nLine1 ).ReadUInt16( nLine2 ).ReadInt16( nTempStart ).ReadCharAsBool( bInvalid );
1978 //tdf#94617
1979 if (nFlag & 0x8000)
1981 sal_uInt16 nMult = nFlag & 0x7FFF;
1982 sal_Int16 const nMax = std::numeric_limits<sal_Int16>::max();
1983 nStart = nMult * nMax + nTempStart;
1985 else
1987 nStart = nTempStart;
1990 else
1992 nStart = nTempStart;
1995 // HACK due to 'Reference could not be saved'
1996 SetFlag( SbxFlagBits::NoModify );
1998 return true;
2001 bool SbMethod::StoreData( SvStream& rStrm ) const
2003 if( !SbxMethod::StoreData( rStrm ) )
2004 return false;
2006 //tdf#94617
2007 sal_Int16 nMax = std::numeric_limits<sal_Int16>::max();
2008 sal_Int16 nStartTemp = nStart % nMax;
2009 sal_uInt16 nDebugFlagsTemp = nStart / nMax;
2010 nDebugFlagsTemp |= 0x8000;
2012 rStrm.WriteUInt16( nDebugFlagsTemp )
2013 .WriteInt16( nLine1 )
2014 .WriteInt16( nLine2 )
2015 .WriteInt16( nStartTemp )
2016 .WriteBool( bInvalid );
2018 return true;
2021 void SbMethod::GetLineRange( sal_uInt16& l1, sal_uInt16& l2 )
2023 l1 = nLine1; l2 = nLine2;
2026 // Could later be deleted
2028 SbxInfo* SbMethod::GetInfo()
2030 return pInfo.get();
2033 // Interface to execute a method of the applications
2034 // With special RefCounting, so that the Basic was not fired of by CloseDocument()
2035 // The return value will be delivered as string.
2036 ErrCode SbMethod::Call( SbxValue* pRet, SbxVariable* pCaller )
2038 if ( pCaller )
2040 SAL_INFO("basic", "SbMethod::Call Have been passed a caller 0x" << pCaller );
2041 mCaller = pCaller;
2043 // Increment the RefCount of the module
2044 tools::SvRef<SbModule> pMod_ = static_cast<SbModule*>(GetParent());
2046 tools::SvRef<StarBASIC> pBasic = static_cast<StarBASIC*>(pMod_->GetParent());
2048 // Establish the values to get the return value
2049 SbxValues aVals;
2050 aVals.eType = SbxVARIANT;
2052 // #104083: Compile BEFORE get
2053 if( bInvalid && !pMod_->Compile() )
2054 StarBASIC::Error( ERRCODE_BASIC_BAD_PROP_VALUE );
2056 Get( aVals );
2057 if ( pRet )
2058 pRet->Put( aVals );
2060 // Was there an error
2061 ErrCode nErr = SbxBase::GetError();
2062 SbxBase::ResetError();
2064 mCaller = nullptr;
2065 return nErr;
2069 // #100883 Own Broadcast for SbMethod
2070 void SbMethod::Broadcast( SfxHintId nHintId )
2072 if( mpBroadcaster && !IsSet( SbxFlagBits::NoBroadcast ) )
2074 // Because the method could be called from outside, test here once again
2075 // the authorisation
2076 if( nHintId == SfxHintId::BasicDataWanted )
2077 if( !CanRead() )
2078 return;
2079 if( nHintId == SfxHintId::BasicDataChanged )
2080 if( !CanWrite() )
2081 return;
2083 if( pMod && !pMod->IsCompiled() )
2084 pMod->Compile();
2086 // Block broadcasts while creating new method
2087 std::unique_ptr<SfxBroadcaster> pSaveBroadcaster = std::move(mpBroadcaster);
2088 SbMethod* pThisCopy = new SbMethod( *this );
2089 SbMethodRef xHolder = pThisCopy;
2090 if( mpPar.is() )
2092 // Enregister this as element 0, but don't reset the parent!
2093 if( GetType() != SbxVOID ) {
2094 mpPar->PutDirect( pThisCopy, 0 );
2096 SetParameters( nullptr );
2099 mpBroadcaster = std::move(pSaveBroadcaster);
2100 mpBroadcaster->Broadcast( SbxHint( nHintId, pThisCopy ) );
2102 SbxFlagBits nSaveFlags = GetFlags();
2103 SetFlag( SbxFlagBits::ReadWrite );
2104 pSaveBroadcaster = std::move(mpBroadcaster);
2105 Put( pThisCopy->GetValues_Impl() );
2106 mpBroadcaster = std::move(pSaveBroadcaster);
2107 SetFlags( nSaveFlags );
2112 // Implementation of SbJScriptMethod (method class as a wrapper for JavaScript-functions)
2114 SbJScriptMethod::SbJScriptMethod( SbxDataType t )
2115 : SbMethod( "", t, nullptr )
2119 SbJScriptMethod::~SbJScriptMethod()
2123 SbObjModule::SbObjModule( const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsVbaCompatible )
2124 : SbModule( rName, bIsVbaCompatible )
2126 SetModuleType( mInfo.ModuleType );
2127 if ( mInfo.ModuleType == script::ModuleType::FORM )
2129 SetClassName( "Form" );
2131 else if ( mInfo.ModuleObject.is() )
2133 SetUnoObject( uno::Any( mInfo.ModuleObject ) );
2137 SbObjModule::~SbObjModule()
2141 void
2142 SbObjModule::SetUnoObject( const uno::Any& aObj )
2144 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pDocObject.get() );
2145 if ( pUnoObj && pUnoObj->getUnoAny() == aObj ) // object is equal, nothing to do
2146 return;
2147 pDocObject = new SbUnoObject( GetName(), aObj );
2149 css::uno::Reference< css::lang::XServiceInfo > xServiceInfo( aObj, css::uno::UNO_QUERY_THROW );
2150 if( xServiceInfo->supportsService( "ooo.vba.excel.Worksheet" ) )
2152 SetClassName( "Worksheet" );
2154 else if( xServiceInfo->supportsService( "ooo.vba.excel.Workbook" ) )
2156 SetClassName( "Workbook" );
2160 SbxVariable*
2161 SbObjModule::GetObject()
2163 return pDocObject.get();
2165 SbxVariable*
2166 SbObjModule::Find( const OUString& rName, SbxClassType t )
2168 SbxVariable* pVar = nullptr;
2169 if ( pDocObject.get() )
2170 pVar = pDocObject->Find( rName, t );
2171 if ( !pVar )
2172 pVar = SbModule::Find( rName, t );
2173 return pVar;
2176 void SbObjModule::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
2178 SbModule::handleProcedureProperties( rBC, rHint );
2182 typedef ::cppu::WeakImplHelper<
2183 awt::XTopWindowListener,
2184 awt::XWindowListener,
2185 document::XDocumentEventListener > FormObjEventListener_BASE;
2187 class FormObjEventListenerImpl:
2188 public FormObjEventListener_BASE
2190 SbUserFormModule* mpUserForm;
2191 uno::Reference< lang::XComponent > mxComponent;
2192 uno::Reference< frame::XModel > mxModel;
2193 bool mbDisposed;
2194 bool mbOpened;
2195 bool mbActivated;
2196 bool mbShowing;
2198 public:
2199 FormObjEventListenerImpl(const FormObjEventListenerImpl&) = delete;
2200 const FormObjEventListenerImpl& operator=(const FormObjEventListenerImpl&) = delete;
2201 FormObjEventListenerImpl( SbUserFormModule* pUserForm, const uno::Reference< lang::XComponent >& xComponent, const uno::Reference< frame::XModel >& xModel ) :
2202 mpUserForm( pUserForm ), mxComponent( xComponent), mxModel( xModel ),
2203 mbDisposed( false ), mbOpened( false ), mbActivated( false ), mbShowing( false )
2205 if ( mxComponent.is() )
2209 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->addTopWindowListener( this );
2211 catch(const uno::Exception& ) {}
2214 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->addWindowListener( this );
2216 catch(const uno::Exception& ) {}
2219 if ( mxModel.is() )
2223 uno::Reference< document::XDocumentEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->addDocumentEventListener( this );
2225 catch(const uno::Exception& ) {}
2229 virtual ~FormObjEventListenerImpl() override
2231 removeListener();
2234 bool isShowing() const { return mbShowing; }
2236 void removeListener()
2238 if ( mxComponent.is() && !mbDisposed )
2242 uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeTopWindowListener( this );
2244 catch(const uno::Exception& ) {}
2247 uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeWindowListener( this );
2249 catch(const uno::Exception& ) {}
2251 mxComponent.clear();
2253 if ( mxModel.is() && !mbDisposed )
2257 uno::Reference< document::XDocumentEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->removeDocumentEventListener( this );
2259 catch(const uno::Exception& ) {}
2261 mxModel.clear();
2264 virtual void SAL_CALL windowOpened( const lang::EventObject& /*e*/ ) override
2266 if ( mpUserForm )
2268 mbOpened = true;
2269 mbShowing = true;
2270 if ( mbActivated )
2272 mbOpened = mbActivated = false;
2273 mpUserForm->triggerActivateEvent();
2279 virtual void SAL_CALL windowClosing( const lang::EventObject& /*e*/ ) override
2281 #ifdef IN_THE_FUTURE
2282 uno::Reference< awt::XDialog > xDialog( e.Source, uno::UNO_QUERY );
2283 if ( xDialog.is() )
2285 uno::Reference< awt::XControl > xControl( xDialog, uno::UNO_QUERY );
2286 if ( xControl->getPeer().is() )
2288 uno::Reference< document::XVbaMethodParameter > xVbaMethodParameter( xControl->getPeer(), uno::UNO_QUERY );
2289 if ( xVbaMethodParameter.is() )
2291 sal_Int8 nCancel = 0;
2292 sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormControlMenu;
2294 Sequence< Any > aParams;
2295 aParams.realloc(2);
2296 aParams[0] <<= nCancel;
2297 aParams[1] <<= nCloseMode;
2299 mpUserForm->triggerMethod( "Userform_QueryClose", aParams);
2300 return;
2306 mpUserForm->triggerMethod( "Userform_QueryClose" );
2307 #endif
2311 virtual void SAL_CALL windowClosed( const lang::EventObject& /*e*/ ) override
2313 mbOpened = false;
2314 mbShowing = false;
2317 virtual void SAL_CALL windowMinimized( const lang::EventObject& /*e*/ ) override
2321 virtual void SAL_CALL windowNormalized( const lang::EventObject& /*e*/ ) override
2325 virtual void SAL_CALL windowActivated( const lang::EventObject& /*e*/ ) override
2327 if ( mpUserForm )
2329 mbActivated = true;
2330 if ( mbOpened )
2332 mbOpened = mbActivated = false;
2333 mpUserForm->triggerActivateEvent();
2338 virtual void SAL_CALL windowDeactivated( const lang::EventObject& /*e*/ ) override
2340 if ( mpUserForm )
2341 mpUserForm->triggerDeactivateEvent();
2344 virtual void SAL_CALL windowResized( const awt::WindowEvent& /*e*/ ) override
2346 if ( mpUserForm )
2348 mpUserForm->triggerResizeEvent();
2349 mpUserForm->triggerLayoutEvent();
2353 virtual void SAL_CALL windowMoved( const awt::WindowEvent& /*e*/ ) override
2355 if ( mpUserForm )
2356 mpUserForm->triggerLayoutEvent();
2359 virtual void SAL_CALL windowShown( const lang::EventObject& /*e*/ ) override
2363 virtual void SAL_CALL windowHidden( const lang::EventObject& /*e*/ ) override
2367 virtual void SAL_CALL documentEventOccured( const document::DocumentEvent& rEvent ) override
2369 // early disposing on document event "OnUnload", to be sure Basic still exists when calling VBA "UserForm_Terminate"
2370 if( rEvent.EventName == GlobalEventConfig::GetEventName( GlobalEventId::CLOSEDOC ) )
2372 removeListener();
2373 mbDisposed = true;
2374 if ( mpUserForm )
2375 mpUserForm->ResetApiObj(); // will trigger "UserForm_Terminate"
2379 virtual void SAL_CALL disposing( const lang::EventObject& /*Source*/ ) override
2381 removeListener();
2382 mbDisposed = true;
2383 if ( mpUserForm )
2384 mpUserForm->ResetApiObj( false ); // pass false (too late to trigger VBA events here)
2388 SbUserFormModule::SbUserFormModule( const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsCompat )
2389 : SbObjModule( rName, mInfo, bIsCompat )
2390 , m_mInfo( mInfo )
2391 , mbInit( false )
2393 m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW );
2396 SbUserFormModule::~SbUserFormModule()
2400 void SbUserFormModule::ResetApiObj( bool bTriggerTerminateEvent )
2402 SAL_INFO("basic", " SbUserFormModule::ResetApiObj( " << (bTriggerTerminateEvent ? "true )" : "false )") );
2403 if ( bTriggerTerminateEvent && m_xDialog.is() ) // probably someone close the dialog window
2405 triggerTerminateEvent();
2407 pDocObject = nullptr;
2408 m_xDialog = nullptr;
2411 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun )
2413 Sequence< Any > aArguments;
2414 triggerMethod( aMethodToRun, aArguments );
2417 void SbUserFormModule::triggerMethod( const OUString& aMethodToRun, Sequence< Any >& aArguments )
2419 SAL_INFO("basic", "trigger " << aMethodToRun);
2420 // Search method
2421 SbxVariable* pMeth = SbObjModule::Find( aMethodToRun, SbxClassType::Method );
2422 if( pMeth )
2424 if ( aArguments.hasElements() ) // Setup parameters
2426 auto xArray = tools::make_ref<SbxArray>();
2427 xArray->Put( pMeth, 0 ); // Method as parameter 0
2429 for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2431 auto xSbxVar = tools::make_ref<SbxVariable>( SbxVARIANT );
2432 unoToSbxValue( xSbxVar.get(), aArguments[i] );
2433 xArray->Put( xSbxVar.get(), static_cast< sal_uInt16 >( i ) + 1 );
2435 // Enable passing by ref
2436 if ( xSbxVar->GetType() != SbxVARIANT )
2437 xSbxVar->SetFlag( SbxFlagBits::Fixed );
2439 pMeth->SetParameters( xArray.get() );
2441 SbxValues aVals;
2442 pMeth->Get( aVals );
2444 for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
2446 aArguments[i] = sbxToUnoValue( xArray->Get( static_cast< sal_uInt16 >(i) + 1) );
2448 pMeth->SetParameters( nullptr );
2450 else
2452 SbxValues aVals;
2453 pMeth->Get( aVals );
2458 void SbUserFormModule::triggerActivateEvent()
2460 triggerMethod( "UserForm_Activate" );
2463 void SbUserFormModule::triggerDeactivateEvent()
2465 triggerMethod( "Userform_Deactivate" );
2468 void SbUserFormModule::triggerInitializeEvent()
2470 if ( mbInit )
2471 return;
2472 triggerMethod("Userform_Initialize");
2473 mbInit = true;
2476 void SbUserFormModule::triggerTerminateEvent()
2478 triggerMethod("Userform_Terminate");
2479 mbInit=false;
2482 void SbUserFormModule::triggerLayoutEvent()
2484 triggerMethod("Userform_Layout");
2487 void SbUserFormModule::triggerResizeEvent()
2489 triggerMethod("Userform_Resize");
2492 SbUserFormModuleInstance* SbUserFormModule::CreateInstance()
2494 SbUserFormModuleInstance* pInstance = new SbUserFormModuleInstance( this, GetName(), m_mInfo, IsVBACompat() );
2495 return pInstance;
2498 SbUserFormModuleInstance::SbUserFormModuleInstance( SbUserFormModule* pParentModule,
2499 const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsVBACompat )
2500 : SbUserFormModule( rName, mInfo, bIsVBACompat )
2501 , m_pParentModule( pParentModule )
2505 bool SbUserFormModuleInstance::IsClass( const OUString& rName ) const
2507 bool bParentNameMatches = m_pParentModule->GetName().equalsIgnoreAsciiCase( rName );
2508 bool bRet = bParentNameMatches || SbxObject::IsClass( rName );
2509 return bRet;
2512 SbxVariable* SbUserFormModuleInstance::Find( const OUString& rName, SbxClassType t )
2514 SbxVariable* pVar = m_pParentModule->Find( rName, t );
2515 return pVar;
2519 void SbUserFormModule::Load()
2521 // forces a load
2522 if ( !pDocObject.is() )
2523 InitObject();
2527 void SbUserFormModule::Unload()
2529 sal_Int8 nCancel = 0;
2531 Sequence< Any > aParams;
2532 aParams.realloc(2);
2533 aParams[0] <<= nCancel;
2534 aParams[1] <<= sal_Int8(::ooo::vba::VbQueryClose::vbFormCode);
2536 triggerMethod( "Userform_QueryClose", aParams);
2538 aParams[0] >>= nCancel;
2539 // basic boolean ( and what the user might use ) can be ambiguous ( e.g. basic true = -1 )
2540 // test against 0 ( false ) and assume anything else is true
2541 // ( Note: ) this used to work ( something changes somewhere )
2542 if (nCancel != 0)
2544 return;
2547 if ( m_xDialog.is() )
2549 triggerTerminateEvent();
2551 // Search method
2552 SbxVariable* pMeth = SbObjModule::Find( "UnloadObject", SbxClassType::Method );
2553 if( pMeth )
2555 SAL_INFO("basic", "Attempting to run the UnloadObjectMethod");
2556 m_xDialog.clear(); //release ref to the uno object
2557 SbxValues aVals;
2558 bool bWaitForDispose = true; // assume dialog is showing
2559 if (m_DialogListener)
2561 bWaitForDispose = m_DialogListener->isShowing();
2562 SAL_INFO("basic", "Showing " << bWaitForDispose );
2564 pMeth->Get( aVals);
2565 if ( !bWaitForDispose )
2567 // we've either already got a dispose or we are never going to get one
2568 ResetApiObj();
2569 } // else wait for dispose
2570 SAL_INFO("basic", "UnloadObject completed (we hope)");
2575 void SbUserFormModule::InitObject()
2579 SbUnoObject* pGlobs = static_cast<SbUnoObject*>(GetParent()->Find( "VBAGlobals", SbxClassType::DontCare ));
2580 if ( m_xModel.is() && pGlobs )
2582 // broadcast INITIALIZE_USERFORM script event before the dialog is created
2583 Reference< script::vba::XVBACompatibility > xVBACompat( getVBACompatibility( m_xModel ), uno::UNO_SET_THROW );
2584 xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::INITIALIZE_USERFORM, GetName() );
2585 uno::Reference< lang::XMultiServiceFactory > xVBAFactory( pGlobs->getUnoAny(), uno::UNO_QUERY_THROW );
2586 uno::Reference< uno::XComponentContext > xContext = comphelper::getProcessComponentContext();
2587 OUString sDialogUrl( "vnd.sun.star.script:" );
2588 OUString sProjectName( "Standard" );
2592 Reference< beans::XPropertySet > xProps( m_xModel, UNO_QUERY_THROW );
2593 uno::Reference< script::vba::XVBACompatibility > xVBAMode( xProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY_THROW );
2594 sProjectName = xVBAMode->getProjectName();
2596 catch(const Exception& ) {}
2598 sDialogUrl += sProjectName + "." + GetName() + "?location=document";
2600 uno::Reference< awt::XDialogProvider > xProvider = awt::DialogProvider::createWithModel( xContext, m_xModel );
2601 m_xDialog = xProvider->createDialog( sDialogUrl );
2603 // create vba api object
2604 uno::Sequence< uno::Any > aArgs(4);
2605 aArgs[ 0 ] = uno::Any();
2606 aArgs[ 1 ] <<= m_xDialog;
2607 aArgs[ 2 ] <<= m_xModel;
2608 aArgs[ 3 ] <<= GetParent()->GetName();
2609 pDocObject = new SbUnoObject( GetName(), uno::Any( xVBAFactory->createInstanceWithArguments( "ooo.vba.msforms.UserForm", aArgs ) ) );
2611 uno::Reference< lang::XComponent > xComponent( m_xDialog, uno::UNO_QUERY_THROW );
2613 // the dialog must be disposed at the end!
2614 StarBASIC* pParentBasic = nullptr;
2615 SbxObject* pCurObject = this;
2618 SbxObject* pObjParent = pCurObject->GetParent();
2619 pParentBasic = dynamic_cast<StarBASIC*>( pObjParent );
2620 pCurObject = pObjParent;
2622 while( pParentBasic == nullptr && pCurObject != nullptr );
2624 SAL_WARN_IF( pParentBasic == nullptr, "basic", "pParentBasic == NULL" );
2625 registerComponentToBeDisposedForBasic( xComponent, pParentBasic );
2627 // if old listener object exists, remove it from dialog and document model
2628 if( m_DialogListener.is() )
2629 m_DialogListener->removeListener();
2630 m_DialogListener.set( new FormObjEventListenerImpl( this, xComponent, m_xModel ) );
2632 triggerInitializeEvent();
2635 catch(const uno::Exception& )
2641 SbxVariable*
2642 SbUserFormModule::Find( const OUString& rName, SbxClassType t )
2644 if ( !pDocObject.is() && !GetSbData()->bRunInit && GetSbData()->pInst )
2645 InitObject();
2646 return SbObjModule::Find( rName, t );
2649 SbProperty::SbProperty( const OUString& r, SbxDataType t, SbModule* p )
2650 : SbxProperty( r, t ), pMod( p )
2654 SbProperty::~SbProperty()
2658 SbProcedureProperty::~SbProcedureProperty()
2661 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */