| blob | ffada4653d2cdab4e830399ce1a176bcbf2afa8d |
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 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 ' Save Err, Erl, .. values before any On Error ... statement
109 SF_Exception._CaptureSystemError()
110 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
111 Set vScriptService = Nothing
113 Check:
114 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
116 If Len(Service) = 0 Then GoTo CatchNotFound
117 End If
119 Try:
121 If IsEmpty(_SF_.ServicesList) Then _SF_.ServicesList = SF_Services._NewDictionary()
123 ' Simple parsing of argument
126 If UBound(vSplit) = 0 Then
128 sService = vSplit(0)
129 ' Accept other default values for associated libraries
130 Select Case LCase(sService)
131 Case "document", "calc", "writer", "base", "formdocument", "documentevent", "formevent"
137 Case "contextmenu", "menu", "popupmenu", "toolbar", "toolbarbutton"
139 Case Else
140 End Select
141 Else
142 sLibrary = vSplit(0)
143 sService = vSplit(1)
144 End If
146 With _SF_.ServicesList
148 ' Load the set of services from the library, if not yet done
149 If Not .Exists(sLibrary) Then
150 If Not SF_Services._LoadLibraryServices(sLibrary) Then GoTo CatchNotLoaded
151 End If
153 ' Find and return the requested service
154 vServicesList = .Item(sLibrary)
155 If Not vServicesList.Exists(sService) Then GoTo CatchNotFound
156 vServiceItem = vServicesList.Item(sService)
157 Select Case vServiceItem.ServiceType
159 vScriptService = vServiceItem.ServiceReference
162 Select Case UCase(sService)
166 Case Else
167 End Select
168 Else ' Call via script provider
169 Set vService = SF_Session._GetScript("Basic", SF_Session.SCRIPTISAPPLICATION, vServiceItem.ServiceMethod)
170 vScriptService = vService.Invoke(Array(pvArgs()), Array(), Array())
171 End If
172 Case Else
173 End Select
175 End With
177 Finally:
178 CreateScriptService = vScriptService
179 SF_Utils._ExitFunction(cstThisSub)
180 Exit Function
181 Catch:
182 GoTo Finally
183 CatchNotFound:
185 GoTo Finally
186 CatchNotLoaded:
188 GoTo Finally
189 End Function ' ScriptForge.SF_Services.CreateScriptService
191 REM -----------------------------------------------------------------------------
192 Public Function RegisterEventManager(Optional ByVal ServiceName As Variant _
193 , Optional ByRef ServiceReference As Variant _
194 ) As Boolean
195 ''' Register into ScriptForge a new event entry for the library
196 ''' from which this method is called
197 ''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method
198 ''' Usually the method should be called only once by library
199 ''' Args:
200 ''' ServiceName: the name of the service as a string. It the service exists
201 ''' already for the library the method overwrites the existing entry
202 ''' ServiceReference: the function which will identify the source of the triggered event
204 ''' Returns:
205 ''' True if successful
206 ''' Example:
207 ''' ' Code snippet stored in a module contained in the SFDocuments library
208 ''' Sub RegisterScriptServices()
209 ''' ' Register the events manager of the library
210 ''' RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager")
211 ''' End Sub
212 ''' ' Code snippet stored in a user script
214 ''' Dim myDoc As Object
215 ''' ' To get the document concerned by the event:
216 ''' Set myDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent)
217 ''' End Sub
219 Dim bRegister As Boolean ' Return value
223 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
224 bRegister = False
226 Check:
227 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
229 If Not SF_Utils._Validate(ServiceReference, "ServiceReference",V_STRING) Then GoTo Finally
230 End If
232 Try:
233 bRegister = _AddToServicesArray(ServiceName, ServiceReference, True)
235 Finally:
236 RegisterEventManager = bRegister
237 SF_Utils._ExitFunction(cstThisSub)
238 Exit Function
239 Catch:
240 GoTo Finally
241 End Function ' ScriptForge.SF_Services.RegisterEventManager
243 REM -----------------------------------------------------------------------------
244 Public Function RegisterService(Optional ByVal ServiceName As Variant _
245 , Optional ByRef ServiceReference As Variant _
246 ) As Boolean
247 ''' Register into ScriptForge a new service entry for the library
248 ''' from which this method is called
249 ''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method
250 ''' Args:
251 ''' ServiceName: the name of the service as a string. It the service exists
252 ''' already for the library the method overwrites the existing entry
253 ''' ServiceReference: either
254 ''' - the Basic module that implements the methods of the service
255 ''' something like: GlobalScope.Library.Module
256 ''' - an instance of the class implementing the methods and properties of the service
258 ''' Returns:
259 ''' True if successful
261 Dim bRegister As Boolean ' Return value
265 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
266 bRegister = False
268 Check:
269 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
271 If Not SF_Utils._Validate(ServiceReference, "ServiceReference", Array(V_STRING, V_OBJECT)) Then GoTo Finally
272 End If
274 Try:
275 bRegister = _AddToServicesArray(ServiceName, ServiceReference, False)
277 Finally:
278 RegisterService = bRegister
279 SF_Utils._ExitFunction(cstThisSub)
280 Exit Function
281 Catch:
282 GoTo Finally
283 End Function ' ScriptForge.SF_Services.RegisterService
285 REM -----------------------------------------------------------------------------
286 Public Sub RegisterScriptServices() As Variant
287 ''' Register into ScriptForge the list of the services implemented by the current library
288 ''' Each library pertaining to the framework must implement its own version of this method
289 ''' This method may be stored in any standard (i.e. not class-) module
290 '''
291 ''' Each individual service is registered by calling the RegisterService() method
292 '''
293 ''' The current version is given as an example
294 '''
295 With GlobalScope.ScriptForge.SF_Services
296 .RegisterService("Array", GlobalScope.ScriptForge.SF_Array) ' Reference to the Basic module
297 .RegisterService("Dictionary", "ScriptForge.SF_Services._NewDictionary") ' Reference to the function initializing the service
307 'TODO
308 End With
310 End Sub ' ScriptForge.SF_Services.RegisterScriptServices
312 REM =========================================================== PRIVATE FUNCTIONS
314 REM -----------------------------------------------------------------------------
315 Private Function _AddToServicesArray(ByVal psServiceName As String _
316 , ByRef pvServiceReference As Variant _
317 , ByVal pbEvent As Boolean _
318 ) As Boolean
319 ''' Add the arguments as an additional row in vServicesArray (Public variable)
320 ''' Called from RegisterService and RegisterEvent methods
322 Dim bRegister As Boolean ' Return value
323 Dim lMax As Long ' Number of rows in vServicesArray
325 bRegister = False
327 Check:
328 ' Ignore when method is not called from RegisterScriptServices()
329 If IsEmpty(vServicesArray) Or IsNull(vServicesArray) Or Not IsArray(vServicesArray) Then GoTo Finally
331 Try:
335 Else
337 End If
338 vServicesArray(lMax, 0) = psServiceName
339 vServicesArray(lMax, 1) = pvServiceReference
340 vServicesArray(lMax, 2) = pbEvent
341 bRegister = True
343 Finally:
344 _AddToServicesArray = bRegister
345 Exit Function
346 End Function ' ScriptForge.SF_Services._AddToServicesArray
348 REM -----------------------------------------------------------------------------
349 Private Function _FindModuleFromMethod(ByVal psLibrary As String _
350 , ByVal psMethod As String _
351 ) As String
352 ''' Find in the given library the name of the module containing
354 ''' Args:
355 ''' psLibrary: the name of the Basic library
356 ''' psMethod: the method to locate
357 ''' Returns:
358 ''' The name of the module or a zero-length string if not found
361 Dim sCategory As String
362 Dim vLanguages As Variant ' "Basic", "Python", ... programming languages
363 Dim sLanguage As String
364 Dim vLibraries As Variant ' Library names
365 Dim sLibrary As String
366 Dim vModules As Variant ' Module names
367 Dim sModule As String ' Return value
368 Dim vMethods As Variant ' Method/properties/subs/functions
369 Dim sMethod As String
370 Dim oRoot As Object ' com.sun.star.script.browse.BrowseNodeFactory
371 Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
373 _FindModuleFromMethod = ""
374 Set oRoot = SF_Utils._GetUNOService("BrowseNodeFactory").createView(com.sun.star.script.browse.BrowseNodeFactoryViewTypes.MACROORGANIZER)
376 ' Exploration is done via tree nodes
377 If Not IsNull(oRoot) Then
378 If oRoot.hasChildNodes() Then
379 vCategories = oRoot.getChildNodes()
380 For i = 0 To UBound(vCategories)
381 sCategory = vCategories(i).getName()
382 ' Consider "My macros & Dialogs" and "LibreOffice Macros & Dialogs" only
384 If vCategories(i).hasChildNodes() Then
385 vLanguages = vCategories(i).getChildNodes()
386 For j = 0 To UBound(vLanguages)
387 sLanguage = vLanguages(j).getName()
388 ' Consider Basic libraries only
390 If vLanguages(j).hasChildNodes() Then
391 vLibraries = vLanguages(j).getChildNodes()
392 For k = 0 To UBound(vLibraries)
393 sLibrary = vLibraries(k).getName()
394 ' Consider the given library only
395 If sLibrary = psLibrary Then
396 If vLibraries(k).hasChildNodes() Then
397 vModules = vLibraries(k).getChildNodes()
398 For l = 0 To UBound(vModules)
399 sModule = vModules(l).getName()
400 ' Check if the module contains the targeted method
401 If vModules(l).hasChildNodes() Then
402 vMethods = vModules(l).getChildNodes()
403 For m = 0 To UBound(vMethods)
404 sMethod = vMethods(m).getName()
405 If sMethod = psMethod Then
406 _FindModuleFromMethod = sModule
407 Exit Function
408 End If
409 Next m
410 End If
411 Next l
412 End If
413 End If
414 Next k
415 End If
416 End If
417 Next j
418 End If
419 End If
420 Next i
421 End If
422 End If
424 End Function ' ScriptForge.SF_Services._FindModuleFromMethod
426 REM -----------------------------------------------------------------------------
427 Private Function _LoadLibraryServices(ByVal psLibrary As String) As Boolean
428 ''' Execute psLibrary.RegisterScriptServices() and load its services into the persistent storage
429 ''' Args:
430 ''' psLibrary: the name of the Basic library
431 ''' Library will be loaded if not yet done
432 ''' Returns:
433 ''' True if success
434 ''' The list of services is loaded directly into the persistent storage
437 Dim vServicesList As Variant ' Dictionary of services
438 Dim vService As Variant ' Single service entry in dictionary
439 Dim vServiceItem As Variant ' Single service in vServicesArray
440 Dim sModule As String ' Name of module containing the RegisterScriptServices method
441 Dim i As Long
444 Try:
445 _LoadLibraryServices = False
447 vServicesArray = Array()
450 ' Direct call
451 ScriptForge.SF_Services.RegisterScriptServices()
452 Else
453 ' Register services via script provider
454 If GlobalScope.BasicLibraries.hasByName(psLibrary) Then
455 If Not GlobalScope.BasicLibraries.isLibraryLoaded(psLibrary) Then
456 GlobalScope.BasicLibraries.LoadLibrary(psLibrary)
457 End If
458 Else
459 GoTo Finally
460 End If
461 sModule = SF_Services._FindModuleFromMethod(psLibrary, cstRegister)
462 If Len(sModule) = 0 Then GoTo Finally
463 SF_Session.ExecuteBasicScript(, psLibrary & "." & sModule & "." & cstRegister)
464 End If
466 ' Store in persistent storage
467 ' - Create list of services for the current library
468 Set vServicesList = SF_Services._NewDictionary()
470 Set vService = New _Service
471 With vService
472 .ServiceName = vServicesArray(i, 0)
473 vServiceItem = vServicesArray(i, 1)
474 If VarType(vServiceItem) = V_STRING Then
475 .ServiceType = 2
476 .ServiceMethod = vServiceItem
477 Set .ServiceReference = Nothing
478 Else ' OBJECT
479 .ServiceType = 1
480 .ServiceMethod = ""
481 Set .ServiceReference = vServiceItem
482 End If
483 .EventManager = vServicesArray(i, 2)
484 End With
485 vServicesList.Add(vServicesArray(i, 0), vService)
486 Next i
487 ' - Add the new dictionary to the persistent dictionary
488 _SF_.ServicesList.Add(psLibrary, vServicesList)
489 _LoadLibraryServices = True
490 vServicesArray = Empty
492 Finally:
493 Exit Function
494 End Function ' ScriptForge.SF_Services._LoadLibraryServices
496 REM -----------------------------------------------------------------------------
497 Public Function _NewDictionary(Optional ByVal pvArgs As Variant) As Variant
498 ''' Create a new instance of the SF_Dictionary class
499 ''' Args:
501 ''' Returns: the instance or Nothing
503 Dim oDict As Variant ' Return value
504 Dim bCaseSensitive As Boolean ' Keys comparison
506 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
508 Check:
509 If IsMissing(pvArgs) Then pvArgs = Array()
510 If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
512 bCaseSensitive = False
513 Else
514 If Not SF_Utils._Validate(pvArgs(0), "CaseSensitive (Arg0)", V_BOOLEAN) Then GoTo Catch
515 bCaseSensitive = pvArgs(0)
516 End If
518 Try:
519 Set oDict = New SF_Dictionary
520 Set oDict.[Me] = oDict
521 oDict.CaseSensitive = bCaseSensitive
523 Finally:
524 Set _NewDictionary = oDict
525 Exit Function
526 Catch:
527 Set oDict = Nothing
528 GoTo Finally
529 End Function ' ScriptForge.SF_Services._NewDictionary
531 REM -----------------------------------------------------------------------------
532 Public Function _NewL10N(Optional ByVal pvArgs As Variant) As Variant
533 ''' Create a new instance of the SF_L10N class
534 ' Args:
535 ''' FolderName: the folder containing the PO files in SF_FileSystem.FileNaming notation
536 ''' Locale: locale of user session (default) or any other valid la{nguage]-CO[UNTRY] combination
537 ''' The country part is optional. Valid are f.i. "fr", "fr-CH", "en-US"
538 ''' Encoding: The character set that should be used
539 ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
540 ''' Note that LibreOffice probably does not implement all existing sets
542 ''' Locale2: fallback Locale to select if Locale po file does not exist (typically "en-US")
544 ''' Returns: the instance or Nothing
545 ''' Exceptions:
546 ''' UNKNOWNFILEERROR The PO file does not exist
548 Dim oL10N As Variant ' Return value
549 Dim sFolderName As String ' Folder containing the PO files
550 Dim sLocale As String ' Passed argument or that of the user session
551 Dim sLocale2 As String ' Alias for Locale2
552 Dim oLocale As Variant ' com.sun.star.lang.Locale
553 Dim sPOFile As String ' PO file must exist
554 Dim sEncoding As String ' Alias for Encoding
555 Dim sEncoding2 As String ' Alias for Encoding2
557 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
559 Check:
560 If IsMissing(pvArgs) Then pvArgs = Array()
561 sPOFile = ""
562 sEncoding = ""
565 sFolderName = pvArgs(0)
566 sLocale = ""
569 sLocale = pvArgs(1)
570 End If
571 If Len(sLocale) = 0 Then ' Called from Python, the Locale argument may be the zero-length string
574 End If
578 sEncoding = pvArgs(2)
579 Else
581 End If
582 sLocale2 = ""
585 sLocale2 = pvArgs(3)
586 End If
589 sEncoding2 = pvArgs(4)
590 Else
592 End If
595 If Not SF_FileSystem.FileExists(sPOFile) Then
597 ' Try the fallback
599 If Not SF_FileSystem.FileExists(sPOFile) Then GoTo CatchNotExists
600 sEncoding = sEncoding2
601 End If
602 End If
603 End If
605 Try:
606 Set oL10N = New SF_L10N
607 Set oL10N.[Me] = oL10N
608 oL10N._Initialize(sPOFile, sEncoding)
610 Finally:
611 Set _NewL10N = oL10N
612 Exit Function
613 Catch:
614 Set oL10N = Nothing
615 GoTo Finally
616 CatchNotExists:
618 GoTo Finally
619 End Function ' ScriptForge.SF_Services._NewL10N
621 REM -----------------------------------------------------------------------------
622 Public Function _NewTimer(Optional ByVal pvArgs As Variant) As Variant
623 ''' Create a new instance of the SF_Timer class
624 ''' Args:
626 ''' Returns: the instance or Nothing
628 Dim oTimer As Variant ' Return value
629 Dim bStart As Boolean ' Automatic start ?
631 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
633 Check:
634 If IsMissing(pvArgs) Then pvArgs = Array()
636 bStart = False
637 Else
639 bStart = pvArgs(0)
640 End If
641 Try:
642 Set oTimer = New SF_Timer
643 Set oTimer.[Me] = oTimer
644 If bStart Then oTimer.Start()
646 Finally:
647 Set _NewTimer = oTimer
648 Exit Function
649 Catch:
650 Set oTimer = Nothing
651 GoTo Finally
652 End Function ' ScriptForge.SF_Services._NewTimer
654 REM ============================================== END OF SCRIPTFORGE.SF_SERVICES
655 </script:module>