Current File : //usr/lib/libreoffice/share/basic/SFDocuments/SF_Register.xba
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
REM === The SFDocuments library is one of the associated libraries. ===
REM === Full documentation is available on https://help.libreoffice.org/ ===
REM =======================================================================================================================
Option Compatible
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_Register
''' ===========
''' The ScriptForge framework includes
''' the master ScriptForge library
''' a number of "associated" libraries SF*
''' any user/contributor extension wanting to fit into the framework
'''
''' The main methods in this module allow the current library to cling to ScriptForge
''' - RegisterScriptServices
''' Register the list of services implemented by the current library
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
REM ================================================================== EXCEPTIONS
REM ================================================================= DEFINITIONS
''' Strategy for management of Form and FormControl events:
''' ------------------------------------------------------
''' At the contrary of Dialogs and DialogControls, which are always started from some code,
''' Forms and FormControls will be initiated most often by the user, even if the SFDocuments library
''' allows to start forms programmatically
'''
''' For Forms started programmatically, the corresponding objects are built top-down
''' Event management of forms and their controls requires to being able to rebuild Form
''' and FormControl objects bottom-up
'''
''' To avoid multiple rebuilds requested by multiple events,
''' 1. The active form objects are cached in a global array of _FormCache types
''' 2. FormControl objects are cached in Form objects
''' 3. The bottom-up rebuild is executed only once, at instance creation
Type _FormCache
Terminated As Boolean
XUnoForm As Object
BasicForm As Object
End Type
REM ============================================================== PUBLIC METHODS
REM -----------------------------------------------------------------------------
Public Sub RegisterScriptServices() As Variant
''' Register into ScriptForge the list of the services implemented by the current library
''' Each library pertaining to the framework must implement its own version of this method
'''
''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods
''' with 2 arguments:
''' ServiceName: the name of the service as a case-insensitive string
''' ServiceReference: the reference as an object
''' If the reference refers to a module, then return the module as an object:
''' GlobalScope.Library.Module
''' If the reference is a class instance, then return a string referring to the method
''' containing the New statement creating the instance
''' "libraryname.modulename.function"
With GlobalScope.ScriptForge.SF_Services
.RegisterService("Document", "SFDocuments.SF_Register._NewDocument") ' Reference to the function initializing the service
.RegisterService("Base", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function
.RegisterService("Calc", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function
.RegisterService("Writer", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function
.RegisterService("FormDocument", "SFDocuments.SF_Register._NewDocument") ' Same reference, distinction is made inside the function
.RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager") ' Reference to the events manager
.RegisterEventManager("FormEvent", "SFDocuments.SF_Register._FormEventManager")' Reference to the form and controls events manager
End With
End Sub ' SFDocuments.SF_Register.RegisterScriptServices
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Private Function _AddFormToCache(ByRef pvUnoForm As Object _
, ByRef pvBasicForm As Object _
) As Long
''' Add a new entry in the cache array with the references of the actual Form
''' If relevant, the last entry of the cache is reused.
''' The cache is located in the global _SF_ variable
''' Args:
''' pvUnoForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
''' pvBasicForm: its corresponding Basic object
''' Returns:
''' The index of the new or modified entry
Dim vCache As New _FormCache ' Entry to be added
Dim lIndex As Long ' UBound of _SF_.SFForms
Dim vCacheArray As Variant ' Alias of _SF_.SFForms
Try:
vCacheArray = _SF_.SFForms
If IsEmpty(vCacheArray) Then vCacheArray = Array()
lIndex = UBound(vCacheArray)
If lIndex < LBound(vCacheArray) Then
ReDim vCacheArray(0 To 0)
lIndex = 0
ElseIf Not vCacheArray(lIndex).Terminated Then ' Often last entry can be reused
lIndex = lIndex + 1
ReDim Preserve vCacheArray(0 To lIndex)
End If
With vCache
.Terminated = False
Set .XUnoForm = pvUnoForm
Set .BasicForm = pvBasicForm
End With
Set vCacheArray(lIndex) = vCache
_SF_.SFForms = vCacheArray
Finally:
_AddFormToCache = lIndex
Exit Function
End Function ' SFDocuments.SF_Register._AddFormToCache
REM -----------------------------------------------------------------------------
Private Sub _CleanCacheEntry(ByVal plIndex As Long)
''' Clean the plIndex-th entry in the Forms cache
''' Args:
''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored
Dim vCache As New _FormCache ' Cleaned entry
With _SF_
If Not IsArray(.SFForms) Then Exit Sub
If plIndex < LBound(.SFForms) Or plIndex > UBound(.SFForms) Then Exit Sub
With vCache
.Terminated = True
Set .XUnoForm = Nothing
Set .BasicForm = Nothing
End With
.SFForms(plIndex) = vCache
End With
Finally:
Exit Sub
End Sub ' SFDocuments.SF_Register._CleanCacheEntry
REM -----------------------------------------------------------------------------
Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object
''' Returns a Document, Calc or Base object corresponding with the active component
''' which triggered the event in argument
''' This method should be triggered only thru the invocation of CreateScriptService
''' Args:
''' pvEvent: com.sun.star.document.DocumentEvent
''' Returns:
''' the output of a Document, Calc, ... service or Nothing
''' Example:
''' Sub TriggeredByEvent(ByRef poEvent As Object)
''' Dim oDoc As Object
''' Set oDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent)
''' If Not IsNull(oDoc) Then
''' ' ... (a valid document has been identified)
''' End Sub
Dim oSource As Object ' Return value
Dim vEvent As Variant ' Alias of pvArgs(0)
' Never abort while an event is processed
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally
Set oSource = Nothing
Check:
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
If UBound(pvArgs) >= 0 Then vEvent = pvArgs(0) Else Set vEvent = Empty
If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
Try:
If ScriptForge.SF_Session.UnoObjectType(vEvent) = "com.sun.star.document.DocumentEvent" Then
Set oSource = SF_Register._NewDocument(vEvent.Source)
End If
Finally:
Set _EventManager = oSource
Exit Function
End Function ' SFDocuments.SF_Register._EventManager
REM -----------------------------------------------------------------------------
Private Function _FindFormInCache(ByRef poForm As Object) As Object
''' Find the Form based on its XUnoForm
''' The Form must not be terminated
''' Returns:
''' The corresponding Basic Form part or Nothing
Dim oBasicForm As Object ' Return value
Dim oCache As _FormCache ' Entry in the cache
Set oBasicForm = Nothing
Try:
With _SF_
If Not IsEmpty(.SFForms) Then
For Each oCache In .SFForms
If EqualUnoObjects(poForm, oCache.XUnoForm) And Not oCache.Terminated Then
Set oBasicForm = oCache.BasicForm
Exit For
End If
Next oCache
End If
End With
Finally:
Set _FindFormInCache = oBasicForm
Exit Function
End Function ' SFDocuments.SF_Register._FindFormInCache
REM -----------------------------------------------------------------------------
Public Function _FormEventManager(Optional ByRef pvArgs As Variant) As Object
''' Returns a Form or FormControl object corresponding with the form or control
''' which triggered the event in argument
''' This method should be triggered only thru the invocation of CreateScriptService
''' Args:
''' pvEvent: com.sun.star.lang.EventObject
''' Returns:
''' the output of a Form, FormControl service or Nothing
''' Example:
''' Sub TriggeredByEvent(ByRef poEvent As Object)
''' Dim oForm As Object
''' Set oForm = CreateScriptService("SFDocuments.FormEvent", poEvent)
''' If Not IsNull(oForm) Then
''' ' ... (a valid form or subform has been identified)
''' End Sub
Dim oSource As Object ' Return value
Dim vEvent As Variant ' Alias of pvArgs(0)
Dim oControlModel As Object ' com.sun.star.awt.XControlModel
Dim oParent As Object ' com.sun.star.form.OGridControlModel or com.sun.star.comp.forms.ODatabaseForm
Dim sParentType As String ' "com.sun.star.form.OGridControlModel" or "com.sun.star.comp.forms.ODatabaseForm"
Dim oSFParent As Object ' The parent as a ScriptForge instance: SF_Form or SF_FormControl
Dim oSFForm As Object ' The grand-parent SF_Form instance
Dim oSession As Object : Set oSession = ScriptForge.SF_Session
' Never abort while an event is processed
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally
Set oSource = Nothing
Check:
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
If UBound(pvArgs) >= 0 Then vEvent = pvArgs(0) Else Set vEvent = Empty
If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
Try:
If oSession.HasUnoProperty(vEvent, "Source") Then
' FORM EVENT
If oSession.UnoObjectType(vEvent.Source) = "com.sun.star.comp.forms.ODatabaseForm" Then
Set oSource = SF_Register._NewForm(vEvent.Source, pbForceInit := True)
' CONTROL EVENT
Else
' A SF_FormControl instance is always created from its parent, either a form, a subform or a table control
Set oControlModel = vEvent.Source.Model ' The event source is a control view com.sun.star.awt.XControl
Set oParent = oControlModel.Parent
sParentType = oSession.UnoObjectType(oParent)
Select Case sParentType
Case "com.sun.star.form.OGridControlModel"
Set oSFForm = SF_Register._NewForm(oParent.Parent, pbForceInit := True)
Set oSFParent = oSFForm.Controls(oParent.Name)
Case "com.sun.star.comp.forms.ODatabaseForm"
Set oSFParent = SF_Register._NewForm(oParent, pbForceInit := True)
End Select
' The final instance is derived from its parent instance
Set oSource = oSFParent.Controls(oControlModel.Name)
End If
End If
Finally:
Set _FormEventManager = oSource
Exit Function
End Function ' SFDocuments.SF_Register._FormEventManager
REM -----------------------------------------------------------------------------
Public Function _GetEventScriptCode(poObject As Object _
, ByVal psEvent As String _
, ByVal psName As String _
) As String
''' Extract from the parent of poObject the Basic script linked to psEvent.
''' Helper function common to forms and form controls
''' Args:
''' poObject: a com.sun.star.form.XForm or XControl object
''' psEvent: the "On..." name of the event
''' psName: the name of the object to be identified from the parent object
''' Returns:
''' The script to trigger when psEvent occurs
''' See Scripting Framework URI Specification : https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
Dim vEvents As Variant ' List of available events in the parent object
' Array of com.sun.star.script.ScriptEventDescriptor
Dim sEvent As String ' The targeted event name
Dim oParent As Object ' The parent object
Dim lIndex As Long ' The index of the targeted event in the events list of the parent object
Dim sName As String ' The corrected UNO event name
Dim i As Long
_GetEventScriptCode = ""
On Local Error GoTo Catch
If Not ScriptForge.SF_Session.HasUnoMethod(poObject, "getParent") Then GoTo Finally
Try:
' Find form index i.e. find control via getByIndex()
' The name is known (= psName) but getByIndex() is not in the same sequence as getElementNames()
Set oParent = poObject.getParent()
lIndex = -1
For i = 0 To oParent.getCount() - 1
sName = oParent.getByIndex(i).Name
If (sName = psName) Then
lIndex = i
Exit For
End If
Next i
If lIndex < 0 Then GoTo Finally ' Not found, should not happen
' Find script triggered by event
vEvents = oParent.getScriptEvents(lIndex) ' Returns an array
' Fix historical typo error
sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured")
For i = 0 To UBound(vEvents)
If vEvents(i).EventMethod = sEvent Then
_GetEventScriptCode = vEvents(i).ScriptCode
Exit For
End If
Next i
Finally:
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Register._GetEventScriptCode
REM -----------------------------------------------------------------------------
Public Function _NewDocument(Optional ByVal pvArgs As Variant) As Object
''' Create a new instance of the (super) SF_Document class or of one of its subclasses (SF_Calc, ...)
' Args:
''' WindowName: see the definition of WindowName in the description of the UI service
''' If absent, the document is presumed to be in the active window
''' If WindowName is an object, it must be a component
''' (com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument)
''' Returns: the instance or Nothing
Dim oDocument As Object ' Return value
Dim oSuperDocument As Object ' Companion superclass document
Dim vWindowName As Variant ' Alias of pvArgs(0)
Dim oEnum As Object ' com.sun.star.container.XEnumeration
Dim oComp As Object ' com.sun.star.lang.XComponent
Dim vWindow As Window ' A single component
Dim oUi As Object ' "UI" service
Dim bFound As Boolean ' True if the document is found on the desktop
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) ' Needed when _NewDocument called from _EventManager
If UBound(pvArgs) >= 0 Then vWindowName = pvArgs(0) Else vWindowName = ""
If Not ScriptForge.SF_Utils._Validate(vWindowName, "WindowName", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
Set oDocument = Nothing
Try:
Set oUi = ScriptForge.SF_Services.CreateScriptService("UI")
Select Case VarType(vWindowName)
Case V_STRING
If Len(vWindowName) > 0 Then
bFound = False
Set oEnum = StarDesktop.Components().createEnumeration
Do While oEnum.hasMoreElements
Set oComp = oEnum.nextElement
vWindow = oUi._IdentifyWindow(oComp)
With vWindow
' Does the current window match the argument ?
If (Len(.WindowFileName) > 0 And .WindowFileName = ScriptForge.SF_FileSystem._ConvertToUrl(vWindowName)) _
Or (Len(.WindowName) > 0 And .WindowName = vWindowName) _
Or (Len(.WindowTitle) > 0 And .WindowTitle = vWindowName) Then
bFound = True
Exit Do
End If
End With
Loop
Else
bFound = True
vWindow = oUi._IdentifyWindow(StarDesktop.CurrentComponent)
End If
Case ScriptForge.V_OBJECT ' com.sun.star.lang.XComponent
bFound = True
vWindow = oUi._IdentifyWindow(vWindowName)
End Select
If bFound And Not IsNull(vWindow.Frame) And Len(vWindow.DocumentType) > 0 Then
' Create the right subclass and associate to it a new instance of the superclass
Select Case vWindow.DocumentType
Case "Base"
Set oDocument = New SF_Base
Set oSuperDocument = New SF_Document
Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
Set oSuperDocument.[_SubClass] = oDocument
Case "Calc"
Set oDocument = New SF_Calc
Set oSuperDocument = New SF_Document
Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
Set oSuperDocument.[_SubClass] = oDocument
Case "FormDocument"
Set oDocument = New SF_FormDocument
Set oSuperDocument = New SF_Document
Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
Set oSuperDocument.[_SubClass] = oDocument
Case "Writer"
Set oDocument = New SF_Writer
Set oSuperDocument = New SF_Document
Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
Set oSuperDocument.[_SubClass] = oDocument
Case Else ' Only superclass
Set oDocument = New SF_Document
Set oSuperDocument = oDocument
End Select
With oDocument ' Initialize attributes of subclass
Set .[Me] = oDocument
Set ._Component = vWindow.Component
' Initialize specific attributes
Select Case vWindow.DocumentType
Case "Base"
Set ._DataSource = ._Component.DataSource
Case "FormDocument"
._Initialize()
Case Else
End Select
End With
With oSuperDocument ' Initialize attributes of superclass
Set .[Me] = oSuperDocument
Set ._Component = vWindow.Component
Set ._Frame = vWindow.Frame
._WindowName = vWindow.WindowName
._WindowTitle = vWindow.WindowTitle
._WindowFileName = vWindow.WindowFileName
._DocumentType = vWindow.DocumentType
End With
End If
Finally:
Set _NewDocument = oDocument
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Register._NewDocument
REM -----------------------------------------------------------------------------
Public Function _NewForm(ByRef poForm As Object _
, Optional pbForceInit As Boolean _
) As Object
''' Returns an existing or a new SF_Form instance based on the argument
''' If the instance is new (not found in cache), the minimal members are initialized
''' Args:
''' poForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
''' pbForceInit: when True, initialize the form instance. Default = False
''' Returns:
''' A SF_Form instance
Dim oForm As Object ' Return value
Try:
Set oForm = SF_Register._FindFormInCache(poForm)
If IsNull(oForm) Then ' Not found
If IsMissing(pbForceInit) Or IsEmpty(pbForceInit) Then pbForceInit = False
Set oForm = New SF_Form
With oForm
._Name = poForm.Name
Set .[Me] = oForm
Set ._Form = poForm
If pbForceInit Then ._Initialize()
End With
End If
Finally:
Set _NewForm = oForm
Exit Function
End Function ' SFDocuments.SF_Register._NewForm
REM -----------------------------------------------------------------------------
Public Function _RegisterEventScript(poObject As Object _
, ByVal psEvent As String _
, ByVal psListener As String _
, ByVal psScriptCode As String _
, ByVal psName As String _
) As Boolean
''' Register a script event (psEvent) to poObject (Form, SubForm or Control)
''' Args:
''' poObject: a com.sun.star.form.XForm or XControl object
''' psEvent: the "On..." name of the event
''' psListener: the listener name corresponding with the event
''' psScriptCode: The script to trigger when psEvent occurs
''' See Scripting Framework URI Specification : https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
''' psName: the name of the object to associate with the event
''' Returns:
''' True when successful
Dim oEvent As Object ' com.sun.star.script.ScriptEventDescriptor
Dim sEvent As String ' The targeted event name
Dim oParent As Object ' The parent object
Dim lIndex As Long ' The index of the targeted event in the events list of the parent object
Dim sName As String ' The corrected UNO event name
Dim i As Long
_RegisterEventScript = False
On Local Error GoTo Catch
If Not ScriptForge.SF_Session.HasUnoMethod(poObject, "getParent") Then GoTo Finally
Try:
' Find object's internal index i.e. how to reach it via getByIndex()
Set oParent = poObject.getParent()
lIndex = -1
For i = 0 To oParent.getCount() - 1
sName = oParent.getByIndex(i).Name
If (sName = psName) Then
lIndex = i
Exit For
End If
Next i
If lIndex < 0 Then GoTo Finally ' Not found, should not happen
' Fix historical typo error
sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured")
' Apply new script code. Erasing it is done with a specific UNO method
If psScriptCode = "" Then
oParent.revokeScriptEvent(lIndex, psListener, sEvent, "")
Else
Set oEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor")
With oEvent
.ListenerType = psListener
.EventMethod = sEvent
.ScriptType = "Script" ' Better than "Basic"
.ScriptCode = psScriptCode
End With
oParent.registerScriptEvent(lIndex, oEvent)
End If
_RegisterEventScript = True
Finally:
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Register._RegisterEventScript
REM ============================================== END OF SFDOCUMENTS.SF_REGISTER
</script:module>
Mini Shell