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>

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	&apos;	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
 &apos;&apos;&apos;		End Sub
 
 Dim bCenter As Boolean				&apos;	Return value
-Dim oSession As Object				&apos;	ScriptForge.SF_Session
 Dim oUi As Object					&apos;	ScriptForge.SF_UI
+Dim oObjDesc As Object				&apos;	_ObjectDescriptor type
 Dim sObjectType As String			&apos;	Can be uno or sf object type
 Dim oParent As Object				&apos;	UNO alias of parent
 Dim oParentPosSize As Object		&apos;	Parent com.sun.star.awt.Rectangle
@@ -356,15 +356,14 @@ Check:
 
 	Set oParentPosSize = Nothing
 	lParentX = 0	:	lParentY = 0
-	Set oSession = CreateScriptService(&quot;Session&quot;)
 	If IsNull(Parent) Then
 		Set oUi = CreateScriptService(&quot;UI&quot;)
 		Set oParentPosSize = oUi._PosSize()	&apos;	Return the position and dimensions of the active window
 	Else
 		&apos;	Determine the object type
-		sObjectType = oSession.UnoObjectType(Parent)
-		If sObjectType = &quot;com.sun.star.script.NativeObjectWrapper&quot; Then		&apos;	Basic object
-			sObjectType = Parent.ObjectType
+		Set oObjDesc = ScriptForge.SF_Utils._VarTypeObj(Parent)
+		If oObjDesc.iVarType = ScriptForge.V_SFOBJECT Then		&apos;	ScriptForge object
+			sObjectType = oObjDesc.sObjectType
 			&apos;	Document or dialog ?
 			If Not ScriptForge.SF_Array.Contains(Array(&quot;BASE&quot;, &quot;CALC&quot;, &quot;DIALOG&quot;, &quot;DOCUMENT&quot;, &quot;WRITER&quot;), sObjectType, CaseSensitive := True) Then GoTo Finally
 			If sObjectType = &quot;DIALOG&quot; 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 _
 &apos;&apos;&apos;	Returns:
 &apos;&apos;&apos;		True when successful
 &apos;&apos;&apos;	Examples:
-&apos;&apos;&apos;		oChart.Resize(1000, 2000, Height = 6000)	&apos;	Width is not changed
+&apos;&apos;&apos;		oChart.Resize(1000, 2000, Height := 6000)	&apos;	Width is not changed
 
 Dim bResize As Boolean				&apos;	Return value
-Dim oAddress As Object				&apos;	Alias of Range
 Dim oPosition As Object				&apos;	com.sun.star.awt.Point
 Dim oSize As Object					&apos;	com.sun.star.awt.Size
 Const cstThisSub = &quot;SFDocuments.Chart.Resize&quot;
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	&apos;	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	&apos;	A menu has been clicked necessarily in the current window
 			Set oDispatcher = ScriptForge.SF_Utils._GetUNOService(&quot;DispatchHelper&quot;)
 			oDispatcher.executeDispatch(oFrame, sCommand, &quot;&quot;, 0, oArgs())
+			oFrame.activate()
 		Else
 			&apos;	Execute script
 			Set oSession = ScriptForge.SF_Services.CreateScriptService(&quot;Session&quot;)
@@ -125,4 +126,4 @@ Sub _SFMENU_disposing(Optional poEvent As Object)			&apos;	com.sun.star.awt.Menu
 End Sub			&apos;	SFWidgets.SF_MenuListener._SFMENU_disposing
 
 REM ============================================ END OF SFDIALOGS.SF_DIALOGLISTENER
-</script:module>
+</script:module>
\ No newline at end of file