| blob | c2a58bc61a8db78762dabf021098d3d7f239df1f |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDocuments library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option Explicit
12 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
13 ''' SF_Register
14 ''' ===========
15 ''' The ScriptForge framework includes
16 ''' the master ScriptForge library
18 ''' any user/contributor extension wanting to fit into the framework
19 '''
20 ''' The main methods in this module allow the current library to cling to ScriptForge
21 ''' - RegisterScriptServices
22 ''' Register the list of services implemented by the current library
23 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
25 REM ================================================================== EXCEPTIONS
27 REM ================================================================= DEFINITIONS
29 ''' Strategy for management of Form and FormControl events:
30 ''' ------------------------------------------------------
31 ''' At the contrary of Dialogs and DialogControls, which are always started from some code,
32 ''' Forms and FormControls will be initiated most often by the user, even if the SFDocuments library
33 ''' allows to start forms programmatically
34 '''
35 ''' For Forms started programmatically, the corresponding objects are built top-down
36 ''' Event management of forms and their controls requires to being able to rebuild Form
37 ''' and FormControl objects bottom-up
38 '''
39 ''' To avoid multiple rebuilds requested by multiple events,
44 Type _FormCache
45 Terminated As Boolean
46 XUnoForm As Object
47 BasicForm As Object
48 End Type
50 REM ============================================================== PUBLIC METHODS
52 REM -----------------------------------------------------------------------------
53 Public Sub RegisterScriptServices() As Variant
54 ''' Register into ScriptForge the list of the services implemented by the current library
55 ''' Each library pertaining to the framework must implement its own version of this method
56 '''
57 ''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods
59 ''' ServiceName: the name of the service as a case-insensitive string
60 ''' ServiceReference: the reference as an object
61 ''' If the reference refers to a module, then return the module as an object:
62 ''' GlobalScope.Library.Module
63 ''' If the reference is a class instance, then return a string referring to the method
64 ''' containing the New statement creating the instance
67 With GlobalScope.ScriptForge.SF_Services
68 .RegisterService("Document", "SFDocuments.SF_Register._NewDocument") ' Reference to the function initializing the service
69 .RegisterService("Base", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function
70 .RegisterService("Calc", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function
71 .RegisterService("Writer", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function
72 .RegisterService("FormDocument", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function
73 .RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager") ' Reference to the events manager
74 .RegisterEventManager("FormEvent", "SFDocuments.SF_Register._FormEventManager")' Reference to the form and controls events manager
75 End With
77 End Sub ' SFDocuments.SF_Register.RegisterScriptServices
79 REM =========================================================== PRIVATE FUNCTIONS
81 REM -----------------------------------------------------------------------------
82 Private Function _AddFormToCache(ByRef pvUnoForm As Object _
83 , ByRef pvBasicForm As Object _
84 ) As Long
85 ''' Add a new entry in the cache array with the references of the actual Form
86 ''' If relevant, the last entry of the cache is reused.
87 ''' The cache is located in the global _SF_ variable
88 ''' Args:
89 ''' pvUnoForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
90 ''' pvBasicForm: its corresponding Basic object
91 ''' Returns:
92 ''' The index of the new or modified entry
94 Dim vCache As New _FormCache ' Entry to be added
95 Dim lIndex As Long ' UBound of _SF_.SFForms
96 Dim vCacheArray As Variant ' Alias of _SF_.SFForms
98 Try:
99 vCacheArray = _SF_.SFForms
101 If IsEmpty(vCacheArray) Then vCacheArray = Array()
102 lIndex = UBound(vCacheArray)
103 If lIndex < LBound(vCacheArray) Then
105 lIndex = 0
106 ElseIf Not vCacheArray(lIndex).Terminated Then ' Often last entry can be reused
107 lIndex = lIndex + 1
108 ReDim Preserve vCacheArray(0 To lIndex)
109 End If
111 With vCache
112 .Terminated = False
113 Set .XUnoForm = pvUnoForm
114 Set .BasicForm = pvBasicForm
115 End With
116 Set vCacheArray(lIndex) = vCache
118 _SF_.SFForms = vCacheArray
120 Finally:
121 _AddFormToCache = lIndex
122 Exit Function
123 End Function ' SFDocuments.SF_Register._AddFormToCache
125 REM -----------------------------------------------------------------------------
126 Private Sub _CleanCacheEntry(ByVal plIndex As Long)
127 ''' Clean the plIndex-th entry in the Forms cache
128 ''' Args:
129 ''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored
131 Dim vCache As New _FormCache ' Cleaned entry
133 With _SF_
134 If Not IsArray(.SFForms) Then Exit Sub
137 With vCache
138 .Terminated = True
139 Set .XUnoForm = Nothing
140 Set .BasicForm = Nothing
141 End With
142 .SFForms(plIndex) = vCache
143 End With
145 Finally:
146 Exit Sub
147 End Sub ' SFDocuments.SF_Register._CleanCacheEntry
149 REM -----------------------------------------------------------------------------
150 Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object
151 ''' Returns a Document, Calc or Base object corresponding with the active component
152 ''' which triggered the event in argument
153 ''' This method should be triggered only thru the invocation of CreateScriptService
154 ''' Args:
155 ''' pvEvent: com.sun.star.document.DocumentEvent
156 ''' Returns:
157 ''' the output of a Document, Calc, ... service or Nothing
158 ''' Example:
159 ''' Sub TriggeredByEvent(ByRef poEvent As Object)
160 ''' Dim oDoc As Object
161 ''' Set oDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent)
162 ''' If Not IsNull(oDoc) Then
163 ''' ' ... (a valid document has been identified)
164 ''' End Sub
166 Dim oSource As Object ' Return value
169 ' Never abort while an event is processed
170 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally
171 Set oSource = Nothing
173 Check:
174 If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
176 If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
178 Try:
179 If ScriptForge.SF_Session.UnoObjectType(vEvent) = "com.sun.star.document.DocumentEvent" Then
180 Set oSource = SF_Register._NewDocument(vEvent.Source)
181 End If
183 Finally:
184 Set _EventManager = oSource
185 Exit Function
186 End Function ' SFDocuments.SF_Register._EventManager
188 REM -----------------------------------------------------------------------------
189 Private Function _FindFormInCache(ByRef poForm As Object) As Object
190 ''' Find the Form based on its XUnoForm
191 ''' The Form must not be terminated
192 ''' Returns:
193 ''' The corresponding Basic Form part or Nothing
195 Dim oBasicForm As Object ' Return value
196 Dim oCache As _FormCache ' Entry in the cache
198 Set oBasicForm = Nothing
200 Try:
201 With _SF_
202 If Not IsEmpty(.SFForms) Then
203 For Each oCache In .SFForms
204 If EqualUnoObjects(poForm, oCache.XUnoForm) And Not oCache.Terminated Then
205 Set oBasicForm = oCache.BasicForm
206 Exit For
207 End If
208 Next oCache
209 End If
210 End With
212 Finally:
213 Set _FindFormInCache = oBasicForm
214 Exit Function
215 End Function ' SFDocuments.SF_Register._FindFormInCache
217 REM -----------------------------------------------------------------------------
218 Public Function _FormEventManager(Optional ByRef pvArgs As Variant) As Object
219 ''' Returns a Form or FormControl object corresponding with the form or control
220 ''' which triggered the event in argument
221 ''' This method should be triggered only thru the invocation of CreateScriptService
222 ''' Args:
223 ''' pvEvent: com.sun.star.lang.EventObject
224 ''' Returns:
225 ''' the output of a Form, FormControl service or Nothing
226 ''' Example:
227 ''' Sub TriggeredByEvent(ByRef poEvent As Object)
228 ''' Dim oForm As Object
230 ''' If Not IsNull(oForm) Then
231 ''' ' ... (a valid form or subform has been identified)
232 ''' End Sub
234 Dim oSource As Object ' Return value
236 Dim oControlModel As Object ' com.sun.star.awt.XControlModel
237 Dim oParent As Object ' com.sun.star.form.OGridControlModel or com.sun.star.comp.forms.ODatabaseForm
238 Dim sParentType As String ' "com.sun.star.form.OGridControlModel" or "com.sun.star.comp.forms.ODatabaseForm"
239 Dim oSFParent As Object ' The parent as a ScriptForge instance: SF_Form or SF_FormControl
240 Dim oSFForm As Object ' The grand-parent SF_Form instance
241 Dim oSession As Object : Set oSession = ScriptForge.SF_Session
243 ' Never abort while an event is processed
244 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally
245 Set oSource = Nothing
247 Check:
248 If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
250 If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
252 Try:
255 ' FORM EVENT
256 If oSession.UnoObjectType(vEvent.Source) = "com.sun.star.comp.forms.ODatabaseForm" Then
257 Set oSource = SF_Register._NewForm(vEvent.Source, pbForceInit := True)
259 ' CONTROL EVENT
260 Else
261 ' A SF_FormControl instance is always created from its parent, either a form, a subform or a table control
262 Set oControlModel = vEvent.Source.Model ' The event source is a control view com.sun.star.awt.XControl
263 Set oParent = oControlModel.Parent
264 sParentType = oSession.UnoObjectType(oParent)
265 Select Case sParentType
267 Set oSFForm = SF_Register._NewForm(oParent.Parent, pbForceInit := True)
268 Set oSFParent = oSFForm.Controls(oParent.Name)
270 Set oSFParent = SF_Register._NewForm(oParent, pbForceInit := True)
271 End Select
272 ' The final instance is derived from its parent instance
273 Set oSource = oSFParent.Controls(oControlModel.Name)
275 End If
277 End If
279 Finally:
280 Set _FormEventManager = oSource
281 Exit Function
282 End Function ' SFDocuments.SF_Register._FormEventManager
284 REM -----------------------------------------------------------------------------
285 Public Function _GetEventScriptCode(poObject As Object _
286 , ByVal psEvent As String _
287 , ByVal psName As String _
288 ) As String
289 ''' Extract from the parent of poObject the Basic script linked to psEvent.
290 ''' Helper function common to forms and form controls
291 ''' Args:
292 ''' poObject: a com.sun.star.form.XForm or XControl object
294 ''' psName: the name of the object to be identified from the parent object
295 ''' Returns:
296 ''' The script to trigger when psEvent occurs
297 ''' See Scripting Framework URI Specification : https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
299 Dim vEvents As Variant ' List of available events in the parent object
300 ' Array of com.sun.star.script.ScriptEventDescriptor
301 Dim sEvent As String ' The targeted event name
302 Dim oParent As Object ' The parent object
303 Dim lIndex As Long ' The index of the targeted event in the events list of the parent object
304 Dim sName As String ' The corrected UNO event name
305 Dim i As Long
307 _GetEventScriptCode = ""
308 On Local Error GoTo Catch
311 Try:
312 ' Find form index i.e. find control via getByIndex()
313 ' The name is known (= psName) but getByIndex() is not in the same sequence as getElementNames()
314 Set oParent = poObject.getParent()
315 lIndex = -1
317 sName = oParent.getByIndex(i).Name
318 If (sName = psName) Then
319 lIndex = i
320 Exit For
321 End If
322 Next i
325 ' Find script triggered by event
326 vEvents = oParent.getScriptEvents(lIndex) ' Returns an array
327 ' Fix historical typo error
328 sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured")
329 For i = 0 To UBound(vEvents)
330 If vEvents(i).EventMethod = sEvent Then
331 _GetEventScriptCode = vEvents(i).ScriptCode
332 Exit For
333 End If
334 Next i
336 Finally:
337 Exit Function
338 Catch:
339 GoTo Finally
340 End Function ' SFDocuments.SF_Register._GetEventScriptCode
342 REM -----------------------------------------------------------------------------
343 Public Function _NewDocument(Optional ByVal pvArgs As Variant) As Object
344 ''' Create a new instance of the (super) SF_Document class or of one of its subclasses (SF_Calc, ...)
345 ' Args:
346 ''' WindowName: see the definition of WindowName in the description of the UI service
347 ''' If absent, the document is presumed to be in the active window
348 ''' If WindowName is an object, it must be a component
349 ''' (com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument)
350 ''' Returns: the instance or Nothing
352 Dim oDocument As Object ' Return value
353 Dim oSuperDocument As Object ' Companion superclass document
355 Dim oEnum As Object ' com.sun.star.container.XEnumeration
356 Dim oComp As Object ' com.sun.star.lang.XComponent
357 Dim vWindow As Window ' A single component
359 Dim bFound As Boolean ' True if the document is found on the desktop
361 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
363 Check:
364 If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
365 If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) ' Needed when _NewDocument called from _EventManager
367 If Not ScriptForge.SF_Utils._Validate(vWindowName, "WindowName", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
368 Set oDocument = Nothing
370 Try:
372 Select Case VarType(vWindowName)
373 Case V_STRING
375 bFound = False
376 Set oEnum = StarDesktop.Components().createEnumeration
377 Do While oEnum.hasMoreElements
378 Set oComp = oEnum.nextElement
379 vWindow = oUi._IdentifyWindow(oComp)
380 With vWindow
381 ' Does the current window match the argument ?
382 If (Len(.WindowFileName) > 0 And .WindowFileName = ScriptForge.SF_FileSystem._ConvertToUrl(vWindowName)) _
385 bFound = True
386 Exit Do
387 End If
388 End With
389 Loop
390 Else
391 bFound = True
392 vWindow = oUi._IdentifyWindow(StarDesktop.CurrentComponent)
393 End If
394 Case ScriptForge.V_OBJECT ' com.sun.star.lang.XComponent
395 bFound = True
396 vWindow = oUi._IdentifyWindow(vWindowName)
397 End Select
400 ' Create the right subclass and associate to it a new instance of the superclass
401 Select Case vWindow.DocumentType
403 Set oDocument = New SF_Base
404 Set oSuperDocument = New SF_Document
405 Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
406 Set oSuperDocument.[_SubClass] = oDocument
408 Set oDocument = New SF_Calc
409 Set oSuperDocument = New SF_Document
410 Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
411 Set oSuperDocument.[_SubClass] = oDocument
413 Set oDocument = New SF_FormDocument
414 Set oSuperDocument = New SF_Document
415 Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
416 Set oSuperDocument.[_SubClass] = oDocument
418 Set oDocument = New SF_Writer
419 Set oSuperDocument = New SF_Document
420 Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
421 Set oSuperDocument.[_SubClass] = oDocument
422 Case Else ' Only superclass
423 Set oDocument = New SF_Document
424 Set oSuperDocument = oDocument
425 End Select
426 With oDocument ' Initialize attributes of subclass
427 Set .[Me] = oDocument
428 Set ._Component = vWindow.Component
429 ' Initialize specific attributes
430 Select Case vWindow.DocumentType
432 Set ._DataSource = ._Component.DataSource
434 ._Initialize()
435 Case Else
436 End Select
437 End With
438 With oSuperDocument ' Initialize attributes of superclass
439 Set .[Me] = oSuperDocument
440 Set ._Component = vWindow.Component
441 Set ._Frame = vWindow.Frame
442 ._WindowName = vWindow.WindowName
443 ._WindowTitle = vWindow.WindowTitle
444 ._WindowFileName = vWindow.WindowFileName
445 ._DocumentType = vWindow.DocumentType
446 End With
447 End If
449 Finally:
450 Set _NewDocument = oDocument
451 Exit Function
452 Catch:
453 GoTo Finally
454 End Function ' SFDocuments.SF_Register._NewDocument
456 REM -----------------------------------------------------------------------------
457 Public Function _NewForm(ByRef poForm As Object _
458 , Optional pbForceInit As Boolean _
459 ) As Object
460 ''' Returns an existing or a new SF_Form instance based on the argument
461 ''' If the instance is new (not found in cache), the minimal members are initialized
462 ''' Args:
463 ''' poForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
464 ''' pbForceInit: when True, initialize the form instance. Default = False
465 ''' Returns:
466 ''' A SF_Form instance
468 Dim oForm As Object ' Return value
470 Try:
471 Set oForm = SF_Register._FindFormInCache(poForm)
472 If IsNull(oForm) Then ' Not found
473 If IsMissing(pbForceInit) Or IsEmpty(pbForceInit) Then pbForceInit = False
474 Set oForm = New SF_Form
475 With oForm
476 ._Name = poForm.Name
477 Set .[Me] = oForm
478 Set ._Form = poForm
479 If pbForceInit Then ._Initialize()
480 End With
481 End If
483 Finally:
484 Set _NewForm = oForm
485 Exit Function
486 End Function ' SFDocuments.SF_Register._NewForm
488 REM -----------------------------------------------------------------------------
489 Public Function _RegisterEventScript(poObject As Object _
490 , ByVal psEvent As String _
491 , ByVal psListener As String _
492 , ByVal psScriptCode As String _
493 , ByVal psName As String _
494 ) As Boolean
495 ''' Register a script event (psEvent) to poObject (Form, SubForm or Control)
496 ''' Args:
497 ''' poObject: a com.sun.star.form.XForm or XControl object
499 ''' psListener: the listener name corresponding with the event
500 ''' psScriptCode: The script to trigger when psEvent occurs
501 ''' See Scripting Framework URI Specification : https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
502 ''' psName: the name of the object to associate with the event
503 ''' Returns:
504 ''' True when successful
506 Dim oEvent As Object ' com.sun.star.script.ScriptEventDescriptor
507 Dim sEvent As String ' The targeted event name
508 Dim oParent As Object ' The parent object
509 Dim lIndex As Long ' The index of the targeted event in the events list of the parent object
510 Dim sName As String ' The corrected UNO event name
511 Dim i As Long
513 _RegisterEventScript = False
514 On Local Error GoTo Catch
517 Try:
519 Set oParent = poObject.getParent()
520 lIndex = -1
522 sName = oParent.getByIndex(i).Name
523 If (sName = psName) Then
524 lIndex = i
525 Exit For
526 End If
527 Next i
530 ' Fix historical typo error
531 sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured")
532 ' Apply new script code. Erasing it is done with a specific UNO method
533 If psScriptCode = "" Then
534 oParent.revokeScriptEvent(lIndex, psListener, sEvent, "")
535 Else
537 With oEvent
538 .ListenerType = psListener
539 .EventMethod = sEvent
541 .ScriptCode = psScriptCode
542 End With
543 oParent.registerScriptEvent(lIndex, oEvent)
544 End If
545 _RegisterEventScript = True
547 Finally:
548 Exit Function
549 Catch:
550 GoTo Finally
551 End Function ' SFDocuments.SF_Register._RegisterEventScript
553 REM ============================================== END OF SFDOCUMENTS.SF_REGISTER
554 </script:module>