diff options
author | Jean-Pierre Ledure <jp@ledure.be> | 2022-04-04 17:12:39 +0200 |
---|---|---|
committer | Jean-Pierre Ledure <jp@ledure.be> | 2022-04-05 18:52:05 +0200 |
commit | 2e3c34521d78cb738755ca93bebe606b0f627535 (patch) | |
tree | 6909205962d8e9356b21d670515a34649e099414 /wizards | |
parent | 61888e49d6eee55197ca1c27b4b023f9b2108d48 (diff) |
ScriptForge - (SF_Utils) new _VarTypeObj() method
The method is for internal use by the ScriptForge core only.
The only argument is an object with VarType() = V_OBJECT.
The purpose is to inspect thoroughly the argument
and to return a
Type _ObjectDescriptor
iVarType As Integer
sObjectType As String
End Type
The iVarType indicates if the object is either
- a UNO object => sObjectType contains the UNO type ("com.sun.star. ...")
- a ScriptForge class instance => sObjectType contains the class
- another Basic object
- Nothing (different from Null)
Several existing methods benefit from the new method and are part
of the commit.
No effect on help pages.
No effect on Python code.
Change-Id: I69565d335b3aeb7c08c48cbccfc13d3d82f11ae1
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/132525
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Diffstat (limited to 'wizards')
-rw-r--r-- | wizards/source/scriptforge/SF_PythonHelper.xba | 6 | ||||
-rw-r--r-- | wizards/source/scriptforge/SF_Session.xba | 14 | ||||
-rw-r--r-- | wizards/source/scriptforge/SF_Utils.xba | 166 | ||||
-rw-r--r-- | wizards/source/sfdatabases/SF_Database.xba | 2 | ||||
-rw-r--r-- | wizards/source/sfdialogs/SF_Dialog.xba | 9 | ||||
-rw-r--r-- | wizards/source/sfdocuments/SF_Chart.xba | 3 | ||||
-rw-r--r-- | wizards/source/sfwidgets/SF_Menu.xba | 2 | ||||
-rw-r--r-- | wizards/source/sfwidgets/SF_MenuListener.xba | 3 |
8 files changed, 135 insertions, 70 deletions
diff --git a/wizards/source/scriptforge/SF_PythonHelper.xba b/wizards/source/scriptforge/SF_PythonHelper.xba index f8794673ee2e..c3d67d8764fc 100644 --- a/wizards/source/scriptforge/SF_PythonHelper.xba +++ b/wizards/source/scriptforge/SF_PythonHelper.xba @@ -192,7 +192,7 @@ Public Function PyDateAdd(ByVal Add As Variant _ ''' Args: ''' Add: The unit to add ''' Count: how many times to add (might be negative) -''' DateArg: a date as a string in iso format +''' DateArg: a date as a com.sun.star.util.DateTime UNO structure ''' Returns: ''' The new date as a string in iso format ''' Example: (Python code) @@ -597,6 +597,7 @@ Dim sServiceName As String ' Alias of BasicObject.ServiceName Dim bBasicClass As Boolean ' True when BasicObject is a class Dim sLibrary As String ' Library where the object belongs to Dim bUno As Boolean ' Return value is a UNO object +Dim oObjDesc As Object ' _ObjectDescriptor type Dim iDims As Integer ' # of dims of vReturn Dim sess As Object : Set sess = ScriptForge.SF_Session Dim i As Long, j As Long @@ -901,7 +902,8 @@ Try: ' Uno or not Uno ? bUno = False If (CallType And cstUno) = cstUno Then ' UNO considered only when pre-announced in CallType - If Len(sess.UnoObjectType(vReturn)) > 0 Then bUno = True + Set oObjDesc = SF_Utils._VarTypeObj(vReturn) + bUno = ( oObjDesc.iVarType = V_UNOOBJECT ) End If If bUno Then ReDim vReturnArray(0 To 2) diff --git a/wizards/source/scriptforge/SF_Session.xba b/wizards/source/scriptforge/SF_Session.xba index f02a958768ce..dc15fe72c04a 100644 --- a/wizards/source/scriptforge/SF_Session.xba +++ b/wizards/source/scriptforge/SF_Session.xba @@ -873,8 +873,7 @@ Public Function UnoObjectType(Optional ByRef UnoObject As Variant) As String ''' com.sun.star. ... as a string ''' a zero-length string if identification was not successful -Dim oService As Object ' com.sun.star.reflection.CoreReflection -Dim vClass as Variant ' com.sun.star.reflection.XIdlClass +Dim oObjDesc As Object ' _ObjectDescriptor type Dim sObjectType As String ' Return value Const cstThisSub = "Session.UnoObjectType" Const cstSubArgs = "UnoObject" @@ -887,15 +886,8 @@ Check: If IsNull(UnoObject) Then GoTo Finally Try: - On Local Error Resume Next - ' Try usual ImplementationName method - sObjectType = UnoObject.getImplementationName() - If sObjectType = "" Then - ' Now try CoreReflection trick - Set oService = SF_Utils._GetUNOService("CoreReflection") - vClass = oService.getType(UnoObject) - If vClass.TypeClass >= com.sun.star.uno.TypeClass.STRUCT Then sObjectType = vClass.Name - End If + Set oObjDesc = SF_Utils._VarTypeObj(UnoObject) + If oObjDesc.iVarType = V_UNOOBJECT Then sObjectType = oObjDesc.sObjectType Finally: UnoObjectType = sObjectType diff --git a/wizards/source/scriptforge/SF_Utils.xba b/wizards/source/scriptforge/SF_Utils.xba index bcf0c81d76a5..127329c7e78b 100644 --- a/wizards/source/scriptforge/SF_Utils.xba +++ b/wizards/source/scriptforge/SF_Utils.xba @@ -24,26 +24,36 @@ Global _SF_ As Variant ' SF_Root (Basic) object) Const SF_Version = "7.4" ''' Standard symbolic names for VarTypes -' V_EMPTY = 0 -' V_NULL = 1 -' V_INTEGER = 2 -' V_LONG = 3 -' V_SINGLE = 4 -' V_DOUBLE = 5 -' V_CURRENCY = 6 -' V_DATE = 7 -' V_STRING = 8 +' V_EMPTY = 0 +' V_NULL = 1 +' V_INTEGER = 2 +' V_LONG = 3 +' V_SINGLE = 4 +' V_DOUBLE = 5 +' V_CURRENCY = 6 +' V_DATE = 7 +' V_STRING = 8 ''' Additional symbolic names for VarTypes -Global Const V_OBJECT = 9 -Global Const V_BOOLEAN = 11 -Global Const V_VARIANT = 12 -Global Const V_BYTE = 17 -Global Const V_USHORT = 18 -Global Const V_ULONG = 19 -Global Const V_BIGINT = 35 -Global Const V_DECIMAL = 37 -Global Const V_ARRAY = 8192 -Global Const V_NUMERIC = 99 ' Fictive VarType synonym of any numeric value +Global Const V_OBJECT = 9 +Global Const V_BOOLEAN = 11 +Global Const V_VARIANT = 12 +Global Const V_BYTE = 17 +Global Const V_USHORT = 18 +Global Const V_ULONG = 19 +Global Const V_BIGINT = 35 +Global Const V_DECIMAL = 37 +Global Const V_ARRAY = 8192 +''' Fictive VarTypes +Global Const V_NUMERIC = 99 ' Synonym of any numeric value [returned by _VarTypeExt()] +Global Const V_NOTHING = 101 ' Object categories [returned by _VarTypeObj()] Null object +Global Const V_UNOOBJECT = 102 ' Uno object or Uno structure +Global Const V_SFOBJECT = 103 ' ScriptForge object: has ObjectType and ServiceName properties +Global Const V_BASICOBJECT = 104 ' User Basic object + +Type _ObjectDescriptor ' Returned by the _VarTypeObj() method + iVarType As Integer ' One of the V_NOTHING, V_xxxOBJECT constants + sObjectType As String ' Either "" or "com.sun.star..." or a ScriptForge object type (ex. "SF_SESSION" or "DICTIONARY") +End Type REM ================================================================== EXCEPTIONS @@ -545,8 +555,7 @@ Public Function _Repr(ByVal pvArg As Variant, Optional ByVal plMax As Long) As S Dim sArg As String ' Return value Dim oObject As Object ' Alias of argument to avoid "Object variable not set" -Dim sObject As String ' Object representation -Dim sObjectType As String ' ObjectType attribute of Basic objects +Dim oObjectDesc As Object ' Object descriptor Dim sLength As String ' String length as a string Dim i As Long Const cstBasicObject = "com.sun.star.script.NativeObjectWrapper" @@ -564,28 +573,22 @@ Const cstEtc = " … " Case V_EMPTY : sArg = "[EMPTY]" Case V_NULL : sArg = "[NULL]" Case V_OBJECT - If IsNull(pvArg) Then - sArg = "[NULL]" - Else - sObject = SF_Session.UnoObjectType(pvArg) - If sObject = "" Or sObject = cstBasicObject Then ' Not a UNO object - ' Test if argument is a ScriptForge object - sObjectType = "" - On Local Error Resume Next - Set oObject = pvArg - sObjectType = oObject.ObjectType - On Error GoTo 0 - If sObjectType = "" Then + Set oObjectDesc = SF_Utils._VarTypeObj(pvArg) + With oObjectDesc + Select Case .iVarType + Case V_NOTHING : sArg = "[NOTHING]" + Case V_OBJECT, V_BASICOBJECT sArg = "[OBJECT]" - ElseIf Left(sObjectType, 3) = "SF_" Then - sArg = "[" & sObjectType & "]" - Else - sArg = oObject._Repr() - End If - Else - sArg = "[" & sObject & "]" - End If - End If + Case V_UNOOBJECT : sArg = "[" & .sObjectType & "]" + Case V_SFOBJECT + If Left(.sObjectType, 3) = "SF_" Then ' Standard module + sArg = "[" & .sObjectType & "]" + Else ' Class module must have a _Repr() method + Set oObject = pvArg + sArg = oObject._Repr() + End If + End Select + End With Case V_VARIANT : sArg = "[VARIANT]" Case V_STRING sArg = SF_String._Repr(pvArg) @@ -734,9 +737,9 @@ Public Function _Validate(Optional ByRef pvArgument As Variant _ ''' Exceptions: ''' ARGUMENTERROR -Dim iVarType As Integer ' Extended VarType of argument -Dim bValid As Boolean ' Returned value -Dim oArgument As Variant ' Workaround "Object variable not set" error on 1st executable statement +Dim iVarType As Integer ' Extended VarType of argument +Dim bValid As Boolean ' Returned value +Dim oObjectDescriptor As Object ' _ObjectDescriptor type Const cstMaxLength = 256 ' Maximum length of readable value Const cstMaxValues = 10 ' Maximum number of allowed items to list in an error message @@ -772,8 +775,10 @@ Try: End If ' Check instance types If bValid And Len(pvObjectType) > 0 And iVarType = V_OBJECT Then - Set oArgument = pvArgument - bValid = ( pvObjectType = oArgument.ObjectType ) + 'Set oArgument = pvArgument + Set oObjectDescriptor = SF_Utils._VarTypeObj(pvArgument) + bValid = ( oObjectDescriptor.iVarType = V_SFOBJECT ) + If bValid Then bValid = ( oObjectDescriptor.sObjectType = pvObjectType ) End If End If @@ -1034,5 +1039,72 @@ Dim iType As Integer ' VarType of argument End Function ' ScriptForge.SF_Utils._VarTypeExt +REM ----------------------------------------------------------------------------- +Public Function _VarTypeObj(ByRef pvValue As Variant) As Object +''' Inspect the argument that is supposed to be an Object +''' Return the internal type of object as one of the values +''' V_NOTHING Null object +''' V_UNOOBJECT Uno object or Uno structure +''' V_SFOBJECT ScriptForge object: has ObjectType and ServiceName properties +''' V_BASICOBJECT User Basic object +''' coupled withe object type as a string ("com.sun.star..." or "SF_..." or "... ScriptForge class ...") +''' When the argument is not an Object, return the usual VarType() of the argument + +Dim oObjDesc As _ObjectDescriptor ' Return value +Dim oValue As Object ' Alias of pvValue used to avoid "Object variable not set" error +Dim sObjType As String ' The type of object is first derived as a string +Dim oReflection As Object ' com.sun.star.reflection.CoreReflection +Dim vClass As Variant ' com.sun.star.reflection.XIdlClass +Dim bUno As Boolean ' True when object recognized as UNO object + +Const cstBasicClass = "com.sun.star.script.NativeObjectWrapper" ' Way to recognize Basic objects + + On Local Error Resume Next ' Object type is established by trial and error + +Try: + With oObjDesc + .iVarType = VarType(pvValue) + .sObjectType = "" + bUno = False + If .iVarType = V_OBJECT Then + If IsNull(pvValue) Then + .iVarType = V_NOTHING + Else + Set oValue = pvValue + ' Try UNO type with usual ImplementationName property + .sObjectType = oValue.getImplementationName() + If .sObjectType = "" Then + ' Try UNO type with alternative CoreReflection trick + Set oReflection = SF_Utils._GetUNOService("CoreReflection") + vClass = oReflection.getType(oValue) + If vClass.TypeClass >= com.sun.star.uno.TypeClass.STRUCT Then + .sObjectType = vClass.Name + bUno = True + End If + Else + bUno = True + End If + ' Identify Basic objects + If .sObjectType = cstBasicClass Then + bUno = False + ' Try if the Basic object has an ObjectType property + .sObjectType = oValue.ObjectType + End If + ' Derive the return value from the object type + Select Case True + Case Len(.sObjectType) = 0 ' Do nothing (return V_OBJECT) + Case .sObjectType = cstBasicClass : .iVarType = V_BASICOBJECT + Case bUno : .iVarType = V_UNOOBJECT + Case Else : .iVarType = V_SFOBJECT + End Select + End If + End If + End With + +Finally: + Set _VarTypeObj = oObjDesc + Exit Function +End Function ' ScriptForge.SF_Utils._VarTypeObj + REM ================================================= END OF SCRIPTFORGE.SF_UTILS </script:module>
\ No newline at end of file diff --git a/wizards/source/sfdatabases/SF_Database.xba b/wizards/source/sfdatabases/SF_Database.xba index 6d3aa99f6381..804084aff28e 100644 --- a/wizards/source/sfdatabases/SF_Database.xba +++ b/wizards/source/sfdatabases/SF_Database.xba @@ -822,4 +822,4 @@ Private Function _Repr() As String End Function ' SFDatabases.SF_Database._Repr REM ============================================ END OF SFDATABASES.SF_DATABASE -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdialogs/SF_Dialog.xba b/wizards/source/sfdialogs/SF_Dialog.xba index fea3eac98f8f..beb865b6a2dd 100644 --- a/wizards/source/sfdialogs/SF_Dialog.xba +++ b/wizards/source/sfdialogs/SF_Dialog.xba @@ -333,8 +333,8 @@ Public Function Center(Optional ByRef Parent As Variant) As Boolean ''' End Sub Dim bCenter As Boolean ' Return value -Dim oSession As Object ' ScriptForge.SF_Session Dim oUi As Object ' ScriptForge.SF_UI +Dim oObjDesc As Object ' _ObjectDescriptor type Dim sObjectType As String ' Can be uno or sf object type Dim oParent As Object ' UNO alias of parent Dim oParentPosSize As Object ' Parent com.sun.star.awt.Rectangle @@ -356,15 +356,14 @@ Check: Set oParentPosSize = Nothing lParentX = 0 : lParentY = 0 - Set oSession = CreateScriptService("Session") If IsNull(Parent) Then Set oUi = CreateScriptService("UI") Set oParentPosSize = oUi._PosSize() ' Return the position and dimensions of the active window Else ' Determine the object type - sObjectType = oSession.UnoObjectType(Parent) - If sObjectType = "com.sun.star.script.NativeObjectWrapper" Then ' Basic object - sObjectType = Parent.ObjectType + Set oObjDesc = ScriptForge.SF_Utils._VarTypeObj(Parent) + If oObjDesc.iVarType = ScriptForge.V_SFOBJECT Then ' ScriptForge object + sObjectType = oObjDesc.sObjectType ' Document or dialog ? If Not ScriptForge.SF_Array.Contains(Array("BASE", "CALC", "DIALOG", "DOCUMENT", "WRITER"), sObjectType, CaseSensitive := True) Then GoTo Finally If sObjectType = "DIALOG" Then diff --git a/wizards/source/sfdocuments/SF_Chart.xba b/wizards/source/sfdocuments/SF_Chart.xba index a4cbf2f2ba28..0538fb8af758 100644 --- a/wizards/source/sfdocuments/SF_Chart.xba +++ b/wizards/source/sfdocuments/SF_Chart.xba @@ -429,10 +429,9 @@ Public Function Resize(Optional ByVal XPos As Variant _ ''' Returns: ''' True when successful ''' Examples: -''' oChart.Resize(1000, 2000, Height = 6000) ' Width is not changed +''' oChart.Resize(1000, 2000, Height := 6000) ' Width is not changed Dim bResize As Boolean ' Return value -Dim oAddress As Object ' Alias of Range Dim oPosition As Object ' com.sun.star.awt.Point Dim oSize As Object ' com.sun.star.awt.Size Const cstThisSub = "SFDocuments.Chart.Resize" diff --git a/wizards/source/sfwidgets/SF_Menu.xba b/wizards/source/sfwidgets/SF_Menu.xba index d9f0bde0358a..c5f7ea6ad43a 100644 --- a/wizards/source/sfwidgets/SF_Menu.xba +++ b/wizards/source/sfwidgets/SF_Menu.xba @@ -587,4 +587,4 @@ Private Function _Repr() As String End Function ' SFWidgets.SF_Menu._Repr REM ============================================ END OF SFWIDGETS.SF_MENU -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_MenuListener.xba b/wizards/source/sfwidgets/SF_MenuListener.xba index 462816cba4f5..6045f2dd8d96 100644 --- a/wizards/source/sfwidgets/SF_MenuListener.xba +++ b/wizards/source/sfwidgets/SF_MenuListener.xba @@ -93,6 +93,7 @@ Try: Set oFrame = StarDesktop.CurrentComponent.CurrentController.Frame ' A menu has been clicked necessarily in the current window Set oDispatcher = ScriptForge.SF_Utils._GetUNOService("DispatchHelper") oDispatcher.executeDispatch(oFrame, sCommand, "", 0, oArgs()) + oFrame.activate() Else ' Execute script Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") @@ -125,4 +126,4 @@ Sub _SFMENU_disposing(Optional poEvent As Object) ' com.sun.star.awt.Menu End Sub ' SFWidgets.SF_MenuListener._SFMENU_disposing REM ============================================ END OF SFDIALOGS.SF_DIALOGLISTENER -</script:module> +</script:module>
\ No newline at end of file |