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