| blob | 5baf37afb484df567334d0fc52ad137bc0d1381e |
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 .RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager") ' Reference to the events manager
73 .RegisterEventManager("FormEvent", "SFDocuments.SF_Register._FormEventManager")' Reference to the form and controls events manager
74 End With
76 End Sub ' SFDocuments.SF_Register.RegisterScriptServices
78 REM =========================================================== PRIVATE FUNCTIONS
80 REM -----------------------------------------------------------------------------
81 Private Function _AddFormToCache(ByRef pvUnoForm As Object _
82 , ByRef pvBasicForm As Object _
83 ) As Long
84 ''' Add a new entry in the cache array with the references of the actual Form
85 ''' If relevant, the last entry of the cache is reused.
86 ''' The cache is located in the global _SF_ variable
87 ''' Args:
88 ''' pvUnoForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
89 ''' pvBasicForm: its corresponding Basic object
90 ''' Returns:
91 ''' The index of the new or modified entry
93 Dim vCache As New _FormCache ' Entry to be added
94 Dim lIndex As Long ' UBound of _SF_.SFForms
95 Dim vCacheArray As Variant ' Alias of _SF_.SFForms
97 Try:
98 vCacheArray = _SF_.SFForms
100 If IsEmpty(vCacheArray) Then vCacheArray = Array()
101 lIndex = UBound(vCacheArray)
102 If lIndex < LBound(vCacheArray) Then
104 lIndex = 0
105 ElseIf Not vCacheArray(lIndex).Terminated Then ' Often last entry can be reused
106 lIndex = lIndex + 1
107 ReDim Preserve vCacheArray(0 To lIndex)
108 End If
110 With vCache
111 .Terminated = False
112 Set .XUnoForm = pvUnoForm
113 Set .BasicForm = pvBasicForm
114 End With
115 Set vCacheArray(lIndex) = vCache
117 _SF_.SFForms = vCacheArray
119 Finally:
120 _AddFormToCache = lIndex
121 Exit Function
122 End Function ' SFDocuments.SF_Register._AddFormToCache
124 REM -----------------------------------------------------------------------------
125 Private Sub _CleanCacheEntry(ByVal plIndex As Long)
126 ''' Clean the plIndex-th entry in the Forms cache
127 ''' Args:
128 ''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored
130 Dim vCache As New _FormCache ' Cleaned entry
132 With _SF_
133 If Not IsArray(.SFForms) Then Exit Sub
136 With vCache
137 .Terminated = True
138 Set .XUnoForm = Nothing
139 Set .BasicForm = Nothing
140 End With
141 .SFForms(plIndex) = vCache
142 End With
144 Finally:
145 Exit Sub
146 End Sub ' SFDocuments.SF_Register._CleanCacheEntry
148 REM -----------------------------------------------------------------------------
149 Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object
150 ''' Returns a Document, Calc or Base object corresponding with the active component
151 ''' which triggered the event in argument
152 ''' This method should be triggered only thru the invocation of CreateScriptService
153 ''' Args:
154 ''' pvEvent: com.sun.star.document.DocumentEvent
155 ''' Returns:
156 ''' the output of a Document, Calc, ... service or Nothing
157 ''' Example:
158 ''' Sub TriggeredByEvent(ByRef poEvent As Object)
159 ''' Dim oDoc As Object
160 ''' Set oDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent)
161 ''' If Not IsNull(oDoc) Then
162 ''' ' ... (a valid document has been identified)
163 ''' End Sub
165 Dim oSource As Object ' Return value
168 ' Never abort while an event is processed
169 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally
170 Set oSource = Nothing
172 Check:
173 If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
175 If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
177 Try:
178 If ScriptForge.SF_Session.UnoObjectType(vEvent) = "com.sun.star.document.DocumentEvent" Then
179 Set oSource = SF_Register._NewDocument(vEvent.Source)
180 End If
182 Finally:
183 Set _EventManager = oSource
184 Exit Function
185 End Function ' SFDocuments.SF_Register._EventManager
187 REM -----------------------------------------------------------------------------
188 Private Function _FindFormInCache(ByRef poForm As Object) As Object
189 ''' Find the Form based on its XUnoForm
190 ''' The Form must not be terminated
191 ''' Returns:
192 ''' The corresponding Basic Form part or Nothing
194 Dim oBasicForm As Object ' Return value
195 Dim oCache As _FormCache ' Entry in the cache
197 Set oBasicForm = Nothing
199 Try:
200 With _SF_
201 If Not IsEmpty(.SFForms) Then
202 For Each oCache In .SFForms
203 If EqualUnoObjects(poForm, oCache.XUnoForm) And Not oCache.Terminated Then
204 Set oBasicForm = oCache.BasicForm
205 Exit For
206 End If
207 Next oCache
208 End If
209 End With
211 Finally:
212 Set _FindFormInCache = oBasicForm
213 Exit Function
214 End Function ' SFDocuments.SF_Register._FindFormInCache
216 REM -----------------------------------------------------------------------------
217 Public Function _FormEventManager(Optional ByRef pvArgs As Variant) As Object
218 ''' Returns a Form or FormControl object corresponding with the form or control
219 ''' which triggered the event in argument
220 ''' This method should be triggered only thru the invocation of CreateScriptService
221 ''' Args:
222 ''' pvEvent: com.sun.star.lang.EventObject
223 ''' Returns:
224 ''' the output of a Form, FormControl service or Nothing
225 ''' Example:
226 ''' Sub TriggeredByEvent(ByRef poEvent As Object)
227 ''' Dim oForm As Object
229 ''' If Not IsNull(oForm) Then
230 ''' ' ... (a valid form or subform has been identified)
231 ''' End Sub
233 Dim oSource As Object ' Return value
235 Dim oControlModel As Object ' com.sun.star.awt.XControlModel
236 Dim oParent As Object ' com.sun.star.form.OGridControlModel or com.sun.star.comp.forms.ODatabaseForm
237 Dim sParentType As String ' "com.sun.star.form.OGridControlModel" or "com.sun.star.comp.forms.ODatabaseForm"
238 Dim oSFParent As Object ' The parent as a ScriptForge instance: SF_Form or SF_FormControl
239 Dim oSFForm As Object ' The grand-parent SF_Form instance
240 Dim oSession As Object : Set oSession = ScriptForge.SF_Session
242 ' Never abort while an event is processed
243 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally
244 Set oSource = Nothing
246 Check:
247 If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
249 If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
251 Try:
254 ' FORM EVENT
255 If oSession.UnoObjectType(vEvent.Source) = "com.sun.star.comp.forms.ODatabaseForm" Then
256 Set oSource = SF_Register._NewForm(vEvent.Source, pbForceInit := True)
258 ' CONTROL EVENT
259 Else
260 ' A SF_FormControl instance is always created from its parent, either a form, a subform or a table control
261 Set oControlModel = vEvent.Source.Model ' The event source is a control view com.sun.star.awt.XControl
262 Set oParent = oControlModel.Parent
263 sParentType = oSession.UnoObjectType(oParent)
264 Select Case sParentType
266 Set oSFForm = SF_Register._NewForm(oParent.Parent, pbForceInit := True)
267 Set oSFParent = oSFForm.Controls(oParent.Name)
269 Set oSFParent = SF_Register._NewForm(oParent, pbForceInit := True)
270 End Select
271 ' The final instance is derived from its parent instance
272 Set oSource = oSFParent.Controls(oControlModel.Name)
274 End If
276 End If
278 Finally:
279 Set _FormEventManager = oSource
280 Exit Function
281 End Function ' SFDocuments.SF_Register._FormEventManager
283 REM -----------------------------------------------------------------------------
284 Public Function _GetEventScriptCode(poObject As Object _
285 , ByVal psEvent As String _
286 , ByVal psName As String _
287 ) As String
288 ''' Extract from the parent of poObject the Basic script linked to psEvent.
289 ''' Helper function common to forms and form controls
290 ''' Args:
291 ''' poObject: a com.sun.star.form.XForm or XControl object
293 ''' psName: the name of the object to be identified from the parent object
294 ''' Returns:
295 ''' The script to trigger when psEvent occurs
296 ''' See Scripting Framework URI Specification : https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
298 Dim vEvents As Variant ' List of available events in the parent object
299 ' Array of com.sun.star.script.ScriptEventDescriptor
300 Dim sEvent As String ' The targeted event name
301 Dim oParent As Object ' The parent object
302 Dim lIndex As Long ' The index of the targeted event in the events list of the parent object
303 Dim sName As String ' The corrected UNO event name
304 Dim i As Long
306 _GetEventScriptCode = ""
307 On Local Error GoTo Catch
310 Try:
311 ' Find form index i.e. find control via getByIndex()
312 ' The name is known (= psName) but getByIndex() is not in the same sequence as getElementNames()
313 Set oParent = poObject.getParent()
314 lIndex = -1
316 sName = oParent.getByIndex(i).Name
317 If (sName = psName) Then
318 lIndex = i
319 Exit For
320 End If
321 Next i
324 ' Find script triggered by event
325 vEvents = oParent.getScriptEvents(lIndex) ' Returns an array
326 ' Fix historical typo error
327 sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured")
328 For i = 0 To UBound(vEvents)
329 If vEvents(i).EventMethod = sEvent Then
330 _GetEventScriptCode = vEvents(i).ScriptCode
331 Exit For
332 End If
333 Next i
335 Finally:
336 Exit Function
337 Catch:
338 GoTo Finally
339 End Function ' SFDocuments.SF_Register._GetEventScriptCode
341 REM -----------------------------------------------------------------------------
342 Public Function _NewDocument(Optional ByVal pvArgs As Variant) As Object
343 ''' Create a new instance of the (super) SF_Document class or of one of its subclasses (SF_Calc, ...)
344 ' Args:
345 ''' WindowName: see the definition of WindowName in the description of the UI service
346 ''' If absent, the document is presumed to be in the active window
347 ''' If WindowName is an object, it must be a component
348 ''' (com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument)
349 ''' Returns: the instance or Nothing
351 Dim oDocument As Object ' Return value
352 Dim oSuperDocument As Object ' Companion superclass document
354 Dim oEnum As Object ' com.sun.star.container.XEnumeration
355 Dim oComp As Object ' com.sun.star.lang.XComponent
356 Dim vWindow As Window ' A single component
358 Dim bFound As Boolean ' True if the document is found on the desktop
360 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
362 Check:
363 If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
364 If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) ' Needed when _NewDocument called from _EventManager
366 If Not ScriptForge.SF_Utils._Validate(vWindowName, "WindowName", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
367 Set oDocument = Nothing
369 Try:
371 Select Case VarType(vWindowName)
372 Case V_STRING
374 bFound = False
375 Set oEnum = StarDesktop.Components().createEnumeration
376 Do While oEnum.hasMoreElements
377 Set oComp = oEnum.nextElement
378 vWindow = oUi._IdentifyWindow(oComp)
379 With vWindow
380 ' Does the current window match the argument ?
381 If (Len(.WindowFileName) > 0 And .WindowFileName = ScriptForge.SF_FileSystem._ConvertToUrl(vWindowName)) _
384 bFound = True
385 Exit Do
386 End If
387 End With
388 Loop
389 Else
390 bFound = True
391 vWindow = oUi._IdentifyWindow(StarDesktop.CurrentComponent)
392 End If
393 Case ScriptForge.V_OBJECT ' com.sun.star.lang.XComponent
394 bFound = True
395 vWindow = oUi._IdentifyWindow(vWindowName)
396 End Select
399 ' Create the right subclass and associate to it a new instance of the superclass
400 Select Case vWindow.DocumentType
402 Set oDocument = New SF_Base
403 Set oSuperDocument = New SF_Document
404 Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
405 Set oSuperDocument.[_SubClass] = oDocument
407 Set oDocument = New SF_Calc
408 Set oSuperDocument = New SF_Document
409 Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
410 Set oSuperDocument.[_SubClass] = oDocument
412 Set oDocument = New SF_Writer
413 Set oSuperDocument = New SF_Document
414 Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
415 Set oSuperDocument.[_SubClass] = oDocument
416 Case Else ' Only superclass
417 Set oDocument = New SF_Document
418 Set oSuperDocument = oDocument
419 End Select
420 With oDocument ' Initialize attributes of subclass
421 Set .[Me] = oDocument
422 Set ._Component = vWindow.Component
423 ' Initialize specific attributes
424 Select Case vWindow.DocumentType
426 Set ._DataSource = ._Component.DataSource
427 Case Else
428 End Select
429 End With
430 With oSuperDocument ' Initialize attributes of superclass
431 Set .[Me] = oSuperDocument
432 Set ._Component = vWindow.Component
433 Set ._Frame = vWindow.Frame
434 ._WindowName = vWindow.WindowName
435 ._WindowTitle = vWindow.WindowTitle
436 ._WindowFileName = vWindow.WindowFileName
437 ._DocumentType = vWindow.DocumentType
438 End With
439 End If
441 Finally:
442 Set _NewDocument = oDocument
443 Exit Function
444 Catch:
445 GoTo Finally
446 End Function ' SFDocuments.SF_Register._NewDocument
448 REM -----------------------------------------------------------------------------
449 Public Function _NewForm(ByRef poForm As Object _
450 , Optional pbForceInit As Boolean _
451 ) As Object
452 ''' Returns an existing or a new SF_Form instance based on the argument
453 ''' If the instance is new (not found in cache), the minimal members are initialized
454 ''' Args:
455 ''' poForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
456 ''' pbForceInit: when True, initialize the form instance. Default = False
457 ''' Returns:
458 ''' A SF_Form instance
460 Dim oForm As Object ' Return value
462 Try:
463 Set oForm = SF_Register._FindFormInCache(poForm)
464 If IsNull(oForm) Then ' Not found
465 If IsMissing(pbForceInit) Or IsEmpty(pbForceInit) Then pbForceInit = False
466 Set oForm = New SF_Form
467 With oForm
468 ._Name = poForm.Name
469 Set .[Me] = oForm
470 Set ._Form = poForm
471 If pbForceInit Then ._Initialize()
472 End With
473 End If
475 Finally:
476 Set _NewForm = oForm
477 Exit Function
478 End Function ' SFDocuments.SF_Register._NewForm
480 REM -----------------------------------------------------------------------------
481 Public Function _RegisterEventScript(poObject As Object _
482 , ByVal psEvent As String _
483 , ByVal psListener As String _
484 , ByVal psScriptCode As String _
485 , ByVal psName As String _
486 ) As Boolean
487 ''' Register a script event (psEvent) to poObject (Form, SubForm or Control)
488 ''' Args:
489 ''' poObject: a com.sun.star.form.XForm or XControl object
491 ''' psListener: the listener name corresponding with the event
492 ''' psScriptCode: The script to trigger when psEvent occurs
493 ''' See Scripting Framework URI Specification : https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
494 ''' psName: the name of the object to associate with the event
495 ''' Returns:
496 ''' True when successful
498 Dim oEvent As Object ' com.sun.star.script.ScriptEventDescriptor
499 Dim sEvent As String ' The targeted event name
500 Dim oParent As Object ' The parent object
501 Dim lIndex As Long ' The index of the targeted event in the events list of the parent object
502 Dim sName As String ' The corrected UNO event name
503 Dim i As Long
505 _RegisterEventScript = False
506 On Local Error GoTo Catch
509 Try:
511 Set oParent = poObject.getParent()
512 lIndex = -1
514 sName = oParent.getByIndex(i).Name
515 If (sName = psName) Then
516 lIndex = i
517 Exit For
518 End If
519 Next i
522 ' Fix historical typo error
523 sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured")
524 ' Apply new script code. Erasing it is done with a specific UNO method
525 If psScriptCode = "" Then
526 oParent.revokeScriptEvent(lIndex, psListener, sEvent, "")
527 Else
529 With oEvent
530 .ListenerType = psListener
531 .EventMethod = sEvent
533 .ScriptCode = psScriptCode
534 End With
535 oParent.registerScriptEvent(lIndex, oEvent)
536 End If
537 _RegisterEventScript = True
539 Finally:
540 Exit Function
541 Catch:
542 GoTo Finally
543 End Function ' SFDocuments.SF_Register._RegisterEventScript
545 REM ============================================== END OF SFDOCUMENTS.SF_REGISTER
546 </script:module>