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