REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === The SFDialogs 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 ================================================================= DEFINITIONS ''' Event management of dialogs requires to being able to rebuild a Dialog object ''' from its com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl UNO instance ''' For that purpose, the started dialogs are buffered in a global array of _DialogCache types Type _DialogCache Terminated As Boolean XUnoDialog As Object BasicDialog As Object End Type REM ================================================================== EXCEPTIONS Private Const DIALOGNOTFOUNDERROR = "DIALOGNOTFOUNDERROR" 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("Dialog", "SFDialogs.SF_Register._NewDialog") ' Reference to the function initializing the service .RegisterEventManager("DialogEvent", "SFDialogs.SF_Register._EventManager") ' Reference to the events manager 'TODO End With End Sub ' SFDialogs.SF_Register.RegisterScriptServices REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Private Function _AddDialogToCache(ByRef pvUnoDialog As Object _ , ByRef pvBasicDialog As Object _ ) As Long ''' Add a new entry in the cache array with the references of the actual dialog ''' If relevant, the last entry of the cache is reused. ''' The cache is located in the global _SF_ variable ''' Args: ''' pvUnoDialog: the com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl of the dialog box ''' pvBasicDialog: its corresponding Basic object ''' Returns: ''' The index of the new or modified entry Dim vCache As New _DialogCache ' Entry to be added Dim lIndex As Long ' UBound of _SF_.SFDialogs Dim vCacheArray As Variant ' Alias of _SF_.SFDialogs Try: vCacheArray = _SF_.SFDialogs 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 .XUnoDialog = pvUnoDialog Set .BasicDialog = pvBasicDialog End With vCacheArray(lIndex) = vCache _SF_.SFDialogs = vCacheArray Finally: _AddDialogToCache = lIndex Exit Function End Function ' SFDialogs.SF_Register._AddDialogToCache REM ----------------------------------------------------------------------------- Private Sub _CleanCacheEntry(ByVal plIndex As Long) ''' Clean the plIndex-th entry in the dialogs cache ''' Args: ''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored Dim vCache As New _DialogCache ' Cleaned entry With _SF_ If Not IsArray(.SFDialogs) Then Exit Sub If plIndex < LBound(.SFDialogs) Or plIndex > UBound(.SFDialogs) Then Exit Sub With vCache .Terminated = True Set .XUnoDialog = Nothing Set .BasicDialog = Nothing End With .SFDialogs(plIndex) = vCache End With Finally: Exit Sub End Sub ' SFDialogs.SF_Register._CleanCacheEntry REM ----------------------------------------------------------------------------- Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object ''' Returns a Dialog or DialogControl object corresponding with the Basic dialog ''' which triggered the event in argument ''' This method should be triggered only thru the invocation of CreateScriptService ''' Args: ''' pvEvent: com.sun.star.xxx ''' Returns: ''' the output of a Dialog or DialogControl service or Nothing ''' Example: ''' Sub TriggeredByEvent(ByRef poEvent As Object) ''' Dim oDlg As Object ''' Set oDlg = CreateScriptService("SFDialogs.DialogEvent", poEvent) ''' If Not IsNull(oDlg) Then ''' ' ... (a valid dialog or one of its controls has been identified) ''' End Sub Dim oSource As Object ' Return value Dim oEventSource As Object ' Event UNO source Dim vEvent As Variant ' Alias of pvArgs(0) Dim sSourceType As String ' Implementation name of event source Dim oDialog As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl Dim bControl As Boolean ' True when control event ' 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 vEvent = Empty If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally If Not ScriptForge.SF_Session.HasUnoProperty(vEvent, "Source") Then GoTo Finally Try: Set oEventSource = vEvent.Source sSourceType = ScriptForge.SF_Session.UnoObjectType(oEventSource) Set oDialog = Nothing Select Case True Case sSourceType = "stardiv.Toolkit.UnoDialogControl" ' A dialog ' Search the dialog in the cache Set oDialog = _FindDialogInCache(oEventSource) bControl = False Case Left(sSourceType, 16) = "stardiv.Toolkit." ' A dialog control Set oDialog = _FindDialogInCache(oEventSource.Context) bControl = True Case Else End Select If Not IsNull(oDialog) Then If bControl Then Set oSource = oDialog.Controls(oEventSource.Model.Name) Else Set oSource = oDialog End If Finally: Set _EventManager = oSource Exit Function End Function ' SFDialogs.SF_Register._EventManager REM ----------------------------------------------------------------------------- Private Function _FindDialogInCache(ByRef poDialog As Object) As Object ''' Find the dialog based on its XUnoDialog ''' The dialog must not be terminated ''' Returns: ''' The corresponding Basic dialog part or Nothing Dim oBasicDialog As Object ' Return value Dim oCache As _DialogCache ' Entry in the cache Set oBasicDialog = Nothing Try: For Each oCache In _SF_.SFDialogs If EqualUnoObjects(poDialog, oCache.XUnoDialog) And Not oCache.Terminated Then Set oBasicDialog = oCache.BasicDialog Exit For End If Next oCache Finally: Set _FindDialogInCache = oBasicDialog Exit Function End Function ' SFDialogs.SF_Register._FindDialogInCache REM ----------------------------------------------------------------------------- Public Function _NewDialog(Optional ByVal pvArgs As Variant) As Object ''' Create a new instance of the SF_Dialog class ''' Args: ''' Container: either "GlobalScope" or a WindowName. Default = the active window ''' see the definition of WindowName in the description of the UI service ''' Library: the name of the library hosting the dialog. Default = "Standard" ''' DialogName: The name of the dialog ''' Library and dialog names are case-sensitive ''' Context: When called from Python, the context must be provided : XSCRIPTCONTEXT ''' Returns: the instance or Nothing Dim oDialog As Object ' Return value Dim vContainer As Variant ' Alias of pvArgs(0) Dim vLibrary As Variant ' Alias of pvArgs(1) Dim vDialogName As Variant ' Alias of pvArgs(2) Dim oLibraries As Object ' com.sun.star.comp.sfx2.DialogLibraryContainer Dim vContext As Variant ' com.sun.star.uno.XComponentContext Dim oDialogProvider As Object ' com.sun.star.io.XInputStreamProvider Dim oEnum As Object ' com.sun.star.container.XEnumeration Dim oComp As Object ' com.sun.star.lang.XComponent Dim oDialogControl As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl Dim vWindow As Window ' A single component Dim sScope As String ' "application" or "document" Dim sURI As String ' URI of the targeted dialog Dim oUi As Object ' "UI" service Dim bFound As Boolean ' True if WindowName is found on the desktop Const cstService = "SFDialogs.Dialog" Const cstGlobal = "GlobalScope" 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 _NewDialog called from _EventManager If UBound(pvArgs) >= 0 Then vContainer = pvArgs(0) Else vContainer = "" If UBound(pvArgs) >= 1 Then vLibrary = pvArgs(1) If IsEmpty(vLibrary) Then vLibrary = "Standard" If UBound(pvArgs) >= 2 Then vDialogName = pvArgs(2) Else vDialogName = Empty ' Use Empty to force mandatory status If Not ScriptForge.SF_Utils._Validate(vContainer, "Container", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(vLibrary, "Library", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(vDialogName, "DialogName", V_STRING) Then GoTo Finally If UBound(pvArgs) >= 3 Then vContext = pvArgs(3) Else vContext = Nothing If Not ScriptForge.SF_Utils._Validate(vContext, "DialogName", V_OBJECT) Then GoTo Finally Set oDialog = Nothing Try: ' Determine the library container hosting the dialog Set oUi = ScriptForge.SF_Register.CreateScriptService("UI") Set oComp = Nothing If VarType(vContainer) = V_STRING Then bFound = ( UCase(vContainer) = UCase(cstGlobal) ) End If If Not bFound Then Select Case VarType(vContainer) Case V_STRING If Len(vContainer) > 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(vContainer)) _ Or (Len(.WindowName) > 0 And .WindowName = vContainer) _ Or (Len(.WindowTitle) > 0 And .WindowTitle = vContainer) Then bFound = True Exit Do End If End With Loop Else bFound = True Set oComp = StarDesktop.CurrentComponent vWindow = oUi._IdentifyWindow(oComp) End If Case V_OBJECT ' com.sun.star.lang.XComponent bFound = True vWindow = oUi._IdentifyWindow(vContainer) Set oComp = vContainer End Select If Not bFound Then GoTo CatchNotFound If Len(vWindow.DocumentType) = 0 Then GoTo CatchNotFound End If ' Determine the dialog provider Select Case True Case IsNull(vContext) And IsNull(oComp) ' Basic and GlobalScope Set oDialogProvider = GetProcessServiceManager.createInstance("com.sun.star.awt.DialogProvider") Case IsNull(vContext) And Not IsNull(oComp) ' Basic and Document Set oDialogProvider = GetProcessServiceManager.createInstanceWithArguments("com.sun.star.awt.DialogProvider", Array(oComp)) Case Not IsNull(vContext) And IsNull(oComp) ' Python and GlobalScope Set oDialogProvider = vContext.getServiceManager().createInstanceWithContext("com.sun.star.awt.DialogProvider", vContext) Case Not IsNull(vContext) And Not IsNull(oComp) ' Python and Document Set oDialogProvider = vContext.getServiceManager().createInstanceWithArguments("com.sun.star.awt.DialogProvider", Array(oComp)) End Select ' Create the graphical interface sScope = Iif(IsNull(oComp), "application", "document") sURI = "vnd.sun.star.script:" & vLibrary & "." & vDialogName & "?location=" & sScope On Local Error GoTo CatchNotFound Set oDialogControl = oDialogProvider.createDialog(sURI) ' Initialize the basic SF_Dialog instance to return to the user script Set oDialog = New SF_Dialog With oDialog Set .[Me] = oDialog If VarType(vContainer) = V_STRING Then ._Container = vContainer Else ._Container = vWindow.WindowName ._Library = vLibrary ._Name = vDialogName Set ._DialogProvider = oDialogProvider Set ._DialogControl = oDialogControl ._Initialize() End With Finally: Set _NewDialog = oDialog Exit Function Catch: GoTo Finally CatchNotFound: ScriptForge.SF_Exception.RaiseFatal(DIALOGNOTFOUNDERROR, "Service", cstService _ , "Container", vContainer, "Library", vLibrary, "DialogName", vDialogName) GoTo Finally End Function ' SFDialogs.SF_Register._NewDialog REM ============================================== END OF SFDIALOGS.SF_REGISTER