Current File : //usr/lib/libreoffice/share/basic/SFDialogs/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 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
.RegisterEventManager("NewDialog", "SFDialogs.SF_Register._NewDialogFromScratch") ' Reference to the function initializing the service
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)
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 Set vContext = Nothing
If Not ScriptForge.SF_Utils._Validate(vContext, "Context", ScriptForge.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 -----------------------------------------------------------------------------
Private Function _NewDialogFromScratch(Optional ByVal pvArgs As Variant) As Object
''' Create a new instance of the SF_Dialog class describing a dynamically defined dialog box
''' Args:
''' DialogName: a symbolic name of the dialog to create, for information only. Not checked for unicity.
''' Place: either
''' - an array with 4 elements: (X, Y, Width, Height)
''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height]
''' All elements are expressed in "Map AppFont" units.
''' Context: When called from Python, the context must be provided : XSCRIPTCONTEXT
''' Returns: the instance or Nothing
Dim oDialog As Object ' Return value
Dim vDialogName As Variant ' The name is for information only
Dim vPlace As variant ' com.sun.star.awt.rectangle or array(X, Y, Width, Height)
Dim oPlace As Object ' com.sun.star.awt.rectangle
Dim oProcessManager As Object ' com.sun.star.lang.XMultiServiceFactory
Dim bBuiltInPython As Boolean ' True when context is present
Dim oModel As Object ' com.sun.star.awt.UnoControlDialogModel
Dim oView As Object ' com.sun.star.awt.UnoControlDialog
Dim vContext As Variant ' com.sun.star.uno.XComponentContext
Const cstDialogModel = "com.sun.star.awt.UnoControlDialogModel"
Const cstDialogView = "com.sun.star.awt.UnoControlDialog"
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)
If UBound(pvArgs) >= 0 Then vDialogName = pvArgs(0) Else vDialogName = Empty
If UBound(pvArgs) >= 1 Then vPlace = pvArgs(1) Else vPlace = Empty ' Use Empty to force the mandatory status
If IsMissing(vDialogName) Or IsEmpty(vDialogName) Then vDialogName = "DYNDIALOG"
If UBound(pvArgs) >= 2 Then vContext = pvArgs(2) Else Set vContext = Nothing
If Not ScriptForge.SF_Utils._Validate(vDialogName, "DialogName", V_STRING) Then GoTo Finally
If IsArray(vPlace) Then
If Not ScriptForge.SF_Utils._ValidateArray(vPlace, "Place", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally
Else
If Not ScriptForge.SF_Utils._Validate(vPlace, "Place", ScriptForge.V_OBJECT) Then GoTo Finally
End If
If Not ScriptForge.SF_Utils._Validate(vContext, "Context", ScriptForge.V_OBJECT) Then GoTo Finally
Set oDialog = Nothing
Try:
' Determine the process service manager and create the dialog model
If IsNull(vContext) Then ' Basic
Set oprocessManager = GetProcessServiceManager()
Set oModel = oProcessManager.createInstance(cstDialogModel)
bBuiltInPython = False
Else ' Python
Set oprocessManager = vContext.getServiceManager()
Set oModel = oProcessManager.createInstanceWithContext(cstDialogModel, vContext)
bBuiltInPython = True
End If
oModel.Name = vDialogName
' Set dimension and position
With oModel
If IsArray(vPlace) Then
If UBound(vPlace) = 3 Then
.PositionX = vPlace(0)
.PositionY = vPlace(1)
.Width = vPlace(2)
.Height = vPlace(3)
End If
ElseIf ScriptForge.SF_Session.UnoObjectType(vPlace) = "com.sun.star.awt.Rectangle" Then
Set oPlace = vPlace
.PositionX = oPlace.X
.PositionY = oPlace.Y
.Width = oPlace.Width
.Height = oPlace.Height
Else
'Leave everything to zero
End If
End With
' Create the view and associate model and view
Set oView = oProcessManager.createInstance(cstDialogView)
oView.setModel(oModel)
' Initialize the basic SF_Dialog instance to return to the user script
Set oDialog = New SF_Dialog
With oDialog
Set .[Me] = oDialog
._Container = ""
._Library = ""
._BuiltFromScratch = True
._BuiltInPython = bBuiltInPython
._Name = vDialogName
Set ._DialogProvider = Nothing
Set ._DialogControl = oView
._Initialize()
End With
Finally:
Set _NewDialogFromScratch = oDialog
Exit Function
Catch:
GoTo Finally
End Function ' SFDialogs.SF_Register._NewDialogFromScratch
REM ============================================== END OF SFDIALOGS.SF_REGISTER
</script:module>
Mini Shell