| blob | f00ad9e94b21547d441292f5f3c903e363b06142 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Services" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === Full documentation is available on https://help.libreoffice.org/ ===
6 REM =======================================================================================================================
8 Option Compatible
9 Option Explicit
11 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
12 ''' SF_Services
13 ''' ===========
15 ''' Implemented as a usual Basic module
16 ''' The ScriptForge framework includes
17 ''' the current ScriptForge library
19 ''' any user/contributor extension wanting to fit into the framework
20 ''' The methods in this module constitute the kernel of the ScriptForge framework
21 ''' - RegisterScriptServices
22 ''' Register for a library the list of services it implements
23 ''' Each library in the framework must implement its own RegisterScriptServices method
25 ''' - RegisterService
26 ''' Register a single service
27 ''' - RegisterEventManager
28 ''' Register a single event manager
29 ''' - CreateScriptService
30 ''' Called by user scripts to get an object giving access to a service or to the event manager
31 '''
32 ''' Detailed user documentation:
33 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_services.html?DbPAR=BASIC
34 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
36 REM ================================================================== EXCEPTIONS
38 Const UNKNOWNSERVICEERROR = "UNKNOWNSERVICEERROR" ' Service not found within the registered services of the given library
39 Const SERVICESNOTLOADEDERROR = "SERVICESNOTLOADEDERROR" ' Failure during the registering of the services of the given library
42 REM ============================================================== PUBLIC MEMBERS
44 ' Defines an entry in in the services dictionary
45 Type _Service
46 ServiceName As String
47 ServiceType As Integer
51 ServiceReference As Object
52 ServiceMethod As String
53 EventManager As Boolean ' True if registered item is an event manager
54 End Type
56 Private vServicesArray As Variant ' List of services registered by a library
58 REM ============================================================== PUBLIC METHODS
60 REM -----------------------------------------------------------------------------
61 Public Function CreateScriptService(Optional ByRef Service As Variant _
62 , ParamArray pvArgs As Variant _
63 ) As Variant
64 ''' Create access to the services of a library for the benefit of a user script
65 ''' A service is to understand either:
66 ''' as a set of methods gathered in a Basic standard module
67 ''' or a set of methods and properties gathered in a Basic class module
68 ''' Args:
70 ''' The library is a Basic library that must exist in the GlobalScope
72 ''' The service is one of the services registered by the library
73 ''' thru the RegisterScriptServices() routine
74 ''' pvArgs: a set of arguments passed to the constructor of the service
75 ''' This is only possible if the service refers to a Basic class module
76 ''' Returns
77 ''' The object containing either the reference of the Basic module
78 ''' or of the Basic class instance
79 ''' Both are Basic objects
80 ''' Returns Nothing if an error occurred.
81 ''' ==>> NOTE: The error can be within the user script creating the new class instance
82 ''' Exceptions:
83 ''' SERVICESNOTLOADEDERROR RegisterScriptService probable failure
84 ''' UNKNOWNSERVICEERROR Service not found
85 ''' Examples
95 ''' => Refers to the Document service instance, implemented in the SFDocuments library, having triggered the event
97 Dim vScriptService As Variant ' Return value
98 Dim vServiceItem As Variant ' A single service (see _Service type definition)
99 Dim vServicesList As Variant ' Output of RegisterScriptServices
100 Dim vSplit As Variant ' Array to split argument in
101 Dim sLibrary As String ' Library part of the argument
102 Dim sService As String ' Service part of the argument
103 Dim vLibrary As Variant ' Dictionary of libraries
104 Dim vService As Variant ' An individual service object
108 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
109 Set vScriptService = Nothing
111 Check:
112 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
114 If Len(Service) = 0 Then GoTo CatchNotFound
115 End If
117 Try:
119 If IsEmpty(_SF_.ServicesList) Then _SF_.ServicesList = SF_Services._NewDictionary()
121 ' Simple parsing of argument
124 If UBound(vSplit) = 0 Then
126 sService = vSplit(0)
127 ' Accept other default values for associated libraries
128 Select Case LCase(sService)
129 Case "document", "calc", "writer", "base", "formdocument", "documentevent", "formevent"
137 Case Else
138 End Select
139 Else
140 sLibrary = vSplit(0)
141 sService = vSplit(1)
142 End If
144 With _SF_.ServicesList
146 ' Load the set of services from the library, if not yet done
147 If Not .Exists(sLibrary) Then
148 If Not SF_Services._LoadLibraryServices(sLibrary) Then GoTo CatchNotLoaded
149 End If
151 ' Find and return the requested service
152 vServicesList = .Item(sLibrary)
153 If Not vServicesList.Exists(sService) Then GoTo CatchNotFound
154 vServiceItem = vServicesList.Item(sService)
155 Select Case vServiceItem.ServiceType
157 vScriptService = vServiceItem.ServiceReference
160 Select Case UCase(sService)
164 Case Else
165 End Select
166 Else ' Call via script provider
167 Set vService = SF_Session._GetScript("Basic", SF_Session.SCRIPTISAPPLICATION, vServiceItem.ServiceMethod)
168 vScriptService = vService.Invoke(Array(pvArgs()), Array(), Array())
169 End If
170 Case Else
171 End Select
173 End With
175 Finally:
176 CreateScriptService = vScriptService
177 SF_Utils._ExitFunction(cstThisSub)
178 Exit Function
179 Catch:
180 GoTo Finally
181 CatchNotFound:
183 GoTo Finally
184 CatchNotLoaded:
186 GoTo Finally
187 End Function ' ScriptForge.SF_Services.CreateScriptService
189 REM -----------------------------------------------------------------------------
190 Public Function RegisterEventManager(Optional ByVal ServiceName As Variant _
191 , Optional ByRef ServiceReference As Variant _
192 ) As Boolean
193 ''' Register into ScriptForge a new event entry for the library
194 ''' from which this method is called
195 ''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method
196 ''' Usually the method should be called only once by library
197 ''' Args:
198 ''' ServiceName: the name of the service as a string. It the service exists
199 ''' already for the library the method overwrites the existing entry
200 ''' ServiceReference: the function which will identify the source of the triggered event
202 ''' Returns:
203 ''' True if successful
204 ''' Example:
205 ''' ' Code snippet stored in a module contained in the SFDocuments library
206 ''' Sub RegisterScriptServices()
207 ''' ' Register the events manager of the library
208 ''' RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager")
209 ''' End Sub
210 ''' ' Code snippet stored in a user script
212 ''' Dim myDoc As Object
213 ''' ' To get the document concerned by the event:
214 ''' Set myDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent)
215 ''' End Sub
217 Dim bRegister As Boolean ' Return value
221 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
222 bRegister = False
224 Check:
225 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
227 If Not SF_Utils._Validate(ServiceReference, "ServiceReference",V_STRING) Then GoTo Finally
228 End If
230 Try:
231 bRegister = _AddToServicesArray(ServiceName, ServiceReference, True)
233 Finally:
234 RegisterEventManager = bRegister
235 SF_Utils._ExitFunction(cstThisSub)
236 Exit Function
237 Catch:
238 GoTo Finally
239 End Function ' ScriptForge.SF_Services.RegisterEventManager
241 REM -----------------------------------------------------------------------------
242 Public Function RegisterService(Optional ByVal ServiceName As Variant _
243 , Optional ByRef ServiceReference As Variant _
244 ) As Boolean
245 ''' Register into ScriptForge a new service entry for the library
246 ''' from which this method is called
247 ''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method
248 ''' Args:
249 ''' ServiceName: the name of the service as a string. It the service exists
250 ''' already for the library the method overwrites the existing entry
251 ''' ServiceReference: either
252 ''' - the Basic module that implements the methods of the service
253 ''' something like: GlobalScope.Library.Module
254 ''' - an instance of the class implementing the methods and properties of the service
256 ''' Returns:
257 ''' True if successful
259 Dim bRegister As Boolean ' Return value
263 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
264 bRegister = False
266 Check:
267 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
269 If Not SF_Utils._Validate(ServiceReference, "ServiceReference", Array(V_STRING, V_OBJECT)) Then GoTo Finally
270 End If
272 Try:
273 bRegister = _AddToServicesArray(ServiceName, ServiceReference, False)
275 Finally:
276 RegisterService = bRegister
277 SF_Utils._ExitFunction(cstThisSub)
278 Exit Function
279 Catch:
280 GoTo Finally
281 End Function ' ScriptForge.SF_Services.RegisterService
283 REM -----------------------------------------------------------------------------
284 Public Sub RegisterScriptServices() As Variant
285 ''' Register into ScriptForge the list of the services implemented by the current library
286 ''' Each library pertaining to the framework must implement its own version of this method
287 ''' This method may be stored in any standard (i.e. not class-) module
288 '''
289 ''' Each individual service is registered by calling the RegisterService() method
290 '''
291 ''' The current version is given as an example
292 '''
293 With GlobalScope.ScriptForge.SF_Services
294 .RegisterService("Array", GlobalScope.ScriptForge.SF_Array) ' Reference to the Basic module
295 .RegisterService("Dictionary", "ScriptForge.SF_Services._NewDictionary") ' Reference to the function initializing the service
305 'TODO
306 End With
308 End Sub ' ScriptForge.SF_Services.RegisterScriptServices
310 REM =========================================================== PRIVATE FUNCTIONS
312 REM -----------------------------------------------------------------------------
313 Private Function _AddToServicesArray(ByVal psServiceName As String _
314 , ByRef pvServiceReference As Variant _
315 , ByVal pbEvent As Boolean _
316 ) As Boolean
317 ''' Add the arguments as an additional row in vServicesArray (Public variable)
318 ''' Called from RegisterService and RegisterEvent methods
320 Dim bRegister As Boolean ' Return value
321 Dim lMax As Long ' Number of rows in vServicesArray
323 bRegister = False
325 Check:
326 ' Ignore when method is not called from RegisterScriptServices()
327 If IsEmpty(vServicesArray) Or IsNull(vServicesArray) Or Not IsArray(vServicesArray) Then GoTo Finally
329 Try:
333 Else
335 End If
336 vServicesArray(lMax, 0) = psServiceName
337 vServicesArray(lMax, 1) = pvServiceReference
338 vServicesArray(lMax, 2) = pbEvent
339 bRegister = True
341 Finally:
342 _AddToServicesArray = bRegister
343 Exit Function
344 End Function ' ScriptForge.SF_Services._AddToServicesArray
346 REM -----------------------------------------------------------------------------
347 Private Function _FindModuleFromMethod(ByVal psLibrary As String _
348 , ByVal psMethod As String _
349 ) As String
350 ''' Find in the given library the name of the module containing
352 ''' Args:
353 ''' psLibrary: the name of the Basic library
354 ''' psMethod: the method to locate
355 ''' Returns:
356 ''' The name of the module or a zero-length string if not found
359 Dim sCategory As String
360 Dim vLanguages As Variant ' "Basic", "Python", ... programming languages
361 Dim sLanguage As String
362 Dim vLibraries As Variant ' Library names
363 Dim sLibrary As String
364 Dim vModules As Variant ' Module names
365 Dim sModule As String ' Return value
366 Dim vMethods As Variant ' Method/properties/subs/functions
367 Dim sMethod As String
368 Dim oRoot As Object ' com.sun.star.script.browse.BrowseNodeFactory
369 Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
371 _FindModuleFromMethod = ""
372 Set oRoot = SF_Utils._GetUNOService("BrowseNodeFactory").createView(com.sun.star.script.browse.BrowseNodeFactoryViewTypes.MACROORGANIZER)
374 ' Exploration is done via tree nodes
375 If Not IsNull(oRoot) Then
376 If oRoot.hasChildNodes() Then
377 vCategories = oRoot.getChildNodes()
378 For i = 0 To UBound(vCategories)
379 sCategory = vCategories(i).getName()
380 ' Consider "My macros & Dialogs" and "LibreOffice Macros & Dialogs" only
382 If vCategories(i).hasChildNodes() Then
383 vLanguages = vCategories(i).getChildNodes()
384 For j = 0 To UBound(vLanguages)
385 sLanguage = vLanguages(j).getName()
386 ' Consider Basic libraries only
388 If vLanguages(j).hasChildNodes() Then
389 vLibraries = vLanguages(j).getChildNodes()
390 For k = 0 To UBound(vLibraries)
391 sLibrary = vLibraries(k).getName()
392 ' Consider the given library only
393 If sLibrary = psLibrary Then
394 If vLibraries(k).hasChildNodes() Then
395 vModules = vLibraries(k).getChildNodes()
396 For l = 0 To UBound(vModules)
397 sModule = vModules(l).getName()
398 ' Check if the module contains the targeted method
399 If vModules(l).hasChildNodes() Then
400 vMethods = vModules(l).getChildNodes()
401 For m = 0 To UBound(vMethods)
402 sMethod = vMethods(m).getName()
403 If sMethod = psMethod Then
404 _FindModuleFromMethod = sModule
405 Exit Function
406 End If
407 Next m
408 End If
409 Next l
410 End If
411 End If
412 Next k
413 End If
414 End If
415 Next j
416 End If
417 End If
418 Next i
419 End If
420 End If
422 End Function ' ScriptForge.SF_Services._FindModuleFromMethod
424 REM -----------------------------------------------------------------------------
425 Private Function _LoadLibraryServices(ByVal psLibrary As String) As Boolean
426 ''' Execute psLibrary.RegisterScriptServices() and load its services into the persistent storage
427 ''' Args:
428 ''' psLibrary: the name of the Basic library
429 ''' Library will be loaded if not yet done
430 ''' Returns:
431 ''' True if success
432 ''' The list of services is loaded directly into the persistent storage
435 Dim vServicesList As Variant ' Dictionary of services
436 Dim vService As Variant ' Single service entry in dictionary
437 Dim vServiceItem As Variant ' Single service in vServicesArray
438 Dim sModule As String ' Name of module containing the RegisterScriptServices method
439 Dim i As Long
442 Try:
443 _LoadLibraryServices = False
445 vServicesArray = Array()
448 ' Direct call
449 ScriptForge.SF_Services.RegisterScriptServices()
450 Else
451 ' Register services via script provider
452 If GlobalScope.BasicLibraries.hasByName(psLibrary) Then
453 If Not GlobalScope.BasicLibraries.isLibraryLoaded(psLibrary) Then
454 GlobalScope.BasicLibraries.LoadLibrary(psLibrary)
455 End If
456 Else
457 GoTo Finally
458 End If
459 sModule = SF_Services._FindModuleFromMethod(psLibrary, cstRegister)
460 If Len(sModule) = 0 Then GoTo Finally
461 SF_Session.ExecuteBasicScript(, psLibrary & "." & sModule & "." & cstRegister)
462 End If
464 ' Store in persistent storage
465 ' - Create list of services for the current library
466 Set vServicesList = SF_Services._NewDictionary()
468 Set vService = New _Service
469 With vService
470 .ServiceName = vServicesArray(i, 0)
471 vServiceItem = vServicesArray(i, 1)
472 If VarType(vServiceItem) = V_STRING Then
473 .ServiceType = 2
474 .ServiceMethod = vServiceItem
475 Set .ServiceReference = Nothing
476 Else ' OBJECT
477 .ServiceType = 1
478 .ServiceMethod = ""
479 Set .ServiceReference = vServiceItem
480 End If
481 .EventManager = vServicesArray(i, 2)
482 End With
483 vServicesList.Add(vServicesArray(i, 0), vService)
484 Next i
485 ' - Add the new dictionary to the persistent dictionary
486 _SF_.ServicesList.Add(psLibrary, vServicesList)
487 _LoadLibraryServices = True
488 vServicesArray = Empty
490 Finally:
491 Exit Function
492 End Function ' ScriptForge.SF_Services._LoadLibraryServices
494 REM -----------------------------------------------------------------------------
495 Public Function _NewDictionary() As Variant
496 ''' Create a new instance of the SF_Dictionary class
497 ''' Returns: the instance or Nothing
499 Dim oDict As Variant
501 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
503 Check:
505 Try:
506 Set oDict = New SF_Dictionary
507 Set oDict.[Me] = oDict
509 Finally:
510 Set _NewDictionary = oDict
511 Exit Function
512 Catch:
513 Set oDict = Nothing
514 GoTo Finally
515 End Function ' ScriptForge.SF_Services._NewDictionary
517 REM -----------------------------------------------------------------------------
518 Public Function _NewL10N(Optional ByVal pvArgs As Variant) As Variant
519 ''' Create a new instance of the SF_L10N class
520 ' Args:
521 ''' FolderName: the folder containing the PO files in SF_FileSystem.FileNaming notation
522 ''' Locale: locale of user session (default) or any other valid la{nguage]-CO[UNTRY] combination
523 ''' The country part is optional. Valid are f.i. "fr", "fr-CH", "en-US"
524 ''' Encoding: The character set that should be used
525 ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
526 ''' Note that LibreOffice probably does not implement all existing sets
528 ''' Locale2: fallback Locale to select if Locale po file does not exist (typically "en-US")
530 ''' Returns: the instance or Nothing
531 ''' Exceptions:
532 ''' UNKNOWNFILEERROR The PO file does not exist
534 Dim oL10N As Variant ' Return value
535 Dim sFolderName As String ' Folder containing the PO files
536 Dim sLocale As String ' Passed argument or that of the user session
537 Dim sLocale2 As String ' Alias for Locale2
538 Dim oLocale As Variant ' com.sun.star.lang.Locale
539 Dim sPOFile As String ' PO file must exist
540 Dim sEncoding As String ' Alias for Encoding
541 Dim sEncoding2 As String ' Alias for Encoding2
543 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
545 Check:
546 If IsMissing(pvArgs) Then pvArgs = Array()
547 sPOFile = ""
548 sEncoding = ""
551 sFolderName = pvArgs(0)
552 sLocale = ""
555 sLocale = pvArgs(1)
556 End If
557 If Len(sLocale) = 0 Then ' Called from Python, the Locale argument may be the zero-length string
560 End If
564 sEncoding = pvArgs(2)
565 Else
567 End If
568 sLocale2 = ""
571 sLocale2 = pvArgs(3)
572 End If
575 sEncoding2 = pvArgs(4)
576 Else
578 End If
581 If Not SF_FileSystem.FileExists(sPOFile) Then
583 ' Try the fallback
585 If Not SF_FileSystem.FileExists(sPOFile) Then GoTo CatchNotExists
586 sEncoding = sEncoding2
587 End If
588 End If
589 End If
591 Try:
592 Set oL10N = New SF_L10N
593 Set oL10N.[Me] = oL10N
594 oL10N._Initialize(sPOFile, sEncoding)
596 Finally:
597 Set _NewL10N = oL10N
598 Exit Function
599 Catch:
600 Set oL10N = Nothing
601 GoTo Finally
602 CatchNotExists:
604 GoTo Finally
605 End Function ' ScriptForge.SF_Services._NewL10N
607 REM -----------------------------------------------------------------------------
608 Public Function _NewTimer(Optional ByVal pvArgs As Variant) As Variant
609 ''' Create a new instance of the SF_Timer class
610 ''' Args:
612 ''' Returns: the instance or Nothing
614 Dim oTimer As Variant ' Return value
615 Dim bStart As Boolean ' Automatic start ?
617 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
619 Check:
620 If IsMissing(pvArgs) Then pvArgs = Array()
622 bStart = False
623 Else
625 bStart = pvArgs(0)
626 End If
627 Try:
628 Set oTimer = New SF_Timer
629 Set oTimer.[Me] = oTimer
630 If bStart Then oTimer.Start()
632 Finally:
633 Set _NewTimer = oTimer
634 Exit Function
635 Catch:
636 Set oTimer = Nothing
637 GoTo Finally
638 End Function ' ScriptForge.SF_Services._NewTimer
640 REM ============================================== END OF SCRIPTFORGE.SF_SERVICES
641 </script:module>