wizards/source/scriptforge/SF_PythonHelper.xba | 6
wizards/source/scriptforge/SF_Session.xba | 14 --
wizards/source/scriptforge/SF_Utils.xba | 166 +++++++++++++++++--------
wizards/source/sfdatabases/SF_Database.xba | 2
wizards/source/sfdialogs/SF_Dialog.xba | 9 -
wizards/source/sfdocuments/SF_Chart.xba | 3
wizards/source/sfwidgets/SF_Menu.xba | 2
wizards/source/sfwidgets/SF_MenuListener.xba | 3
8 files changed, 135 insertions(+), 70 deletions(-)
New commits:
commit 2e3c34521d78cb738755ca93bebe606b0f627535
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Mon Apr 4 17:12:39 2022 +0200
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Tue Apr 5 18:52:05 2022 +0200
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 <j...@ledure.be>
Reviewed-by: Jean-Pierre Ledure <j...@ledure.be>
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
