63ea861f9e
[DbusExplorer] * BUG Fixed bug in how the XML introspect file was handled, look for key 'name' now * NEW Display the property name with type returned or set, and read/write access type * NEW Display Signal information in a more clear format
313 lines
7 KiB
Text
313 lines
7 KiB
Text
' Gambas class file
|
|
|
|
Private $cArgs As New Collection
|
|
Private $cType As New Collection
|
|
|
|
Public Sub _new()
|
|
|
|
$cType["i"] = "Integer"
|
|
$cType["u"] = "Integer"
|
|
$cType["s"] = "String"
|
|
$cType["g"] = "String"
|
|
$cType["o"] = "DBusObject"
|
|
$cType["b"] = "Boolean"
|
|
$cType["y"] = "Byte"
|
|
$cType["v"] = "Variant"
|
|
$cType["d"] = "Float"
|
|
$cType["n"] = "Short"
|
|
$cType["q"] = "Short"
|
|
$cType["x"] = "Long"
|
|
$cType["t"] = "Long"
|
|
$cType["a{sv}"] = "Collection"
|
|
|
|
End
|
|
|
|
Public Sub Form_Open()
|
|
|
|
btnRefresh_Click
|
|
'HSplit1.Layout = [1, 1]
|
|
|
|
End
|
|
|
|
Public Sub ShowPathContent(sPath As String, sBus As String, sApplication As String)
|
|
|
|
Dim xmlDoc As New XmlDocument
|
|
Dim sFullDbusPath, s, sAppPath As String
|
|
Dim hattr, hattr2, hNode, hNode2 As XmlNode
|
|
Dim i, j, k As Integer
|
|
Dim aArgs As New String[]
|
|
Dim sIntr As String
|
|
|
|
'Dim haArgs As New Object[]
|
|
|
|
sIntr = DBus[sBus & sApplication]._Introspect(sPath)
|
|
Print sIntr
|
|
Try xmlDoc.FromString(sIntr)
|
|
|
|
If Error Then Return
|
|
|
|
For i = 0 To xmlDoc.Root.Children.Count - 1
|
|
hNode = xmlDoc.Root.Children[i]
|
|
If hNode.Name = "interface" Then
|
|
For Each hattr In hNode.Attributes
|
|
sFullDbusPath = [sBus, sApplication, sPath, CStr(hattr.Value)].Join("|")
|
|
If Not tvDbus.Exist(sBus & "|" & sApplication & "|" & sPath) Then
|
|
tvDbus.Add(sFullDbusPath, hattr.Value)
|
|
Else
|
|
tvDbus.Add(sFullDbusPath, hattr.Value,, sBus & "|" & sApplication & "|" & sPath)
|
|
Endif
|
|
|
|
For j = 0 To hNode.Children.Count - 1
|
|
hNode2 = hNode.Children[j]
|
|
If hNode2.Name = "method" Or hNode2.Name = "property" Or hNode2.Name = "signal" Then
|
|
For Each hattr In hNode2.Attributes
|
|
If hattr.name = "name" Then Break
|
|
Next
|
|
|
|
Try tvDbus.Add(sFullDbusPath & "|" & hattr.Value, hattr.Value, Picture[hNode2.Name & ".png"], sFullDbusPath)
|
|
If Error Then Continue
|
|
$cArgs[sFullDbusPath & "|" & hattr.Value] &= "ref=" & hNode2.Name
|
|
|
|
If hNode2.name = "property" Then
|
|
|
|
For Each hattr2 In hNode2.Attributes
|
|
If hattr2.name = "name" Then Continue
|
|
aArgs.Add(hattr2.Name & "=" & hattr2.Value)
|
|
Next
|
|
|
|
$cArgs[sFullDbusPath & "|" & hattr.Value] &= "|" & aArgs.Join()
|
|
aArgs.Clear
|
|
|
|
Else
|
|
|
|
For k = 0 To hNode2.Children.Count - 1
|
|
If hNode2.Children[k].Name = "arg" Then
|
|
|
|
For Each hattr2 In hNode2.Children[k].Attributes
|
|
|
|
aArgs.Add(hattr2.Name & "=" & hattr2.Value)
|
|
|
|
Next
|
|
|
|
$cArgs[sFullDbusPath & "|" & hattr.Value] &= "|" & aArgs.Join()
|
|
|
|
'If k < hNode2.Children.Count - 2 Then $cArgs[sFullDbusPath & "|" & hattr.Value] &= "|"
|
|
aArgs.Clear
|
|
Endif
|
|
Next
|
|
Endif
|
|
Endif
|
|
Next
|
|
Next
|
|
Endif
|
|
Next
|
|
|
|
For Each s In DBus[sBus & sApplication][sPath].Children
|
|
sAppPath = [sBus, sApplication, sPath].join("|")
|
|
|
|
If tvDbus.Exist(sAppPath) Then
|
|
tvDbus.Add(sAppPath &/ s, s,, sAppPath)
|
|
Else
|
|
tvDbus.Add(sAppPath &/ s, s)
|
|
Endif
|
|
tvDbus.Add(sAppPath &/ s & "|child", "child",, sAppPath &/ s)
|
|
tvDbus[sAppPath &/ s].Picture = Picture["icon:/small/directory"]
|
|
|
|
Next
|
|
|
|
Catch
|
|
Print Error.Where; ": "; Error.Text
|
|
|
|
End
|
|
|
|
Public Sub lstb_activate()
|
|
|
|
tvDbus.Clear
|
|
$cArgs.Clear
|
|
ShowPathContent("/", Last.Tag & "://", Last.current.text)
|
|
|
|
End
|
|
|
|
Public Sub tvDbus_Expand()
|
|
|
|
Dim ars As String[]
|
|
|
|
If Not tvDbus.Exist(tvDbus.item.Key & "|" & "child") Then Return
|
|
tvDbus.Remove(tvDbus.item.Key & "|" & "child")
|
|
ars = Split(tvDbus.Item.Key, "|")
|
|
ShowPathContent(ars[2], ars[0], ars[1])
|
|
|
|
End
|
|
|
|
Private Sub RemoveIds(aList As String[])
|
|
|
|
Dim iInd As Integer
|
|
|
|
While iInd < aList.Count
|
|
If Left(aList[iInd]) = ":" Then
|
|
aList.Remove(iInd)
|
|
Else
|
|
Inc iInd
|
|
Endif
|
|
Wend
|
|
|
|
End
|
|
|
|
Public Sub btnRefresh_Click()
|
|
|
|
Dim aList As String[]
|
|
|
|
lstbSystem.Clear
|
|
lstbSession.Clear
|
|
$cArgs.Clear
|
|
tvDbus.Clear
|
|
|
|
aList = DBus.Session.Applications.Sort(gb.Natural)
|
|
If Not btnShowId.Value Then RemoveIds(aList)
|
|
lstbSession.List = aList
|
|
aList = DBus.System.Applications.Sort(gb.Natural)
|
|
If Not btnShowId.Value Then RemoveIds(aList)
|
|
lstbSystem.List = aList
|
|
|
|
End
|
|
|
|
Public Sub lstb_DblClick()
|
|
|
|
Try Print DBus[Last.current.text]._Introspect("/")
|
|
|
|
End
|
|
|
|
Private Sub GetType(sType As String) As String
|
|
|
|
If $cType.Exist(sType) Then Return $cType[sType]
|
|
|
|
If Left(sType) = "a" Then Return GetType(Mid$(sType, 2)) & "[]"
|
|
|
|
Return "Variant"
|
|
|
|
End
|
|
|
|
Public Function MakeSignature(sKey As String) As String
|
|
|
|
Dim ars As String[]
|
|
Dim aIn As New String[]
|
|
Dim s, t As String
|
|
Dim aArg As String[]
|
|
Dim sName, sType As String
|
|
Dim sDirection As String
|
|
Dim sRef As String
|
|
Dim iArg As Integer = 1
|
|
Dim aOut As New String[]
|
|
Dim sAccess As String = ""
|
|
Dim bHasAccess As Boolean = False
|
|
|
|
ars = Split(skey, "|")
|
|
If Not $cArgs.Exist(skey) Then
|
|
If ars.Max = 4 Then
|
|
Return ars[ars.Max] & "()"
|
|
Else
|
|
Return
|
|
Endif
|
|
Endif
|
|
|
|
Dim sParameters As String[] = Split($cArgs[sKey], "|")
|
|
For Each s In sParameters
|
|
|
|
sName = "Arg" '
|
|
sDirection = ""
|
|
sType = ""
|
|
For Each t In Split(s)
|
|
aArg = Scan(t, "*=*")
|
|
|
|
Select Case aArg[0]
|
|
Case "ref"
|
|
sRef = aArg[1]
|
|
Case "direction"
|
|
sDirection = aArg[1]
|
|
Case "type"
|
|
sType = GetType(aArg[1])
|
|
Case "name"
|
|
sName = aArg[1]
|
|
Case "access"
|
|
sAccess = aArg[1]
|
|
bHasAccess = True
|
|
End Select
|
|
Next
|
|
|
|
If sDirection == "in" Then
|
|
If sName = "Arg" Then
|
|
sName &= CStr(iArg)
|
|
Inc iArg
|
|
Endif
|
|
aIn.Add(sName & " As " & sType)
|
|
Else
|
|
If sName = "Arg" Then
|
|
If stype <> "" Then aOut.Add(sType)
|
|
Else
|
|
aOut.Add(sName & " As " & sType)
|
|
Endif
|
|
Endif
|
|
|
|
Next
|
|
|
|
If sRef = "property" Then
|
|
s = ars[ars.max] & " AS " & aOut.last & " For " & sAccess
|
|
Else
|
|
If sRef = "method" Then
|
|
s = ars[ars.Max] & "(" & aIn.Join(", ") & ")"
|
|
Else If sRef = "signal" Then
|
|
s = ars[ars.Max]
|
|
Endif
|
|
If aOut.Count Then
|
|
s &= IIf(sRef = "signal", " Sends ", " As ")
|
|
If aOut.Count = 1 Then
|
|
s &= aOut.last
|
|
Else
|
|
s &= "[" & aOut.Join(", ") & "] as variant[]"
|
|
Endif
|
|
Else
|
|
If sRef = "signal" Then s &= " Sends Nothing"
|
|
Endif
|
|
Endif
|
|
|
|
Return s
|
|
|
|
End
|
|
|
|
Public Sub tvDbus_Select()
|
|
|
|
MakeSignature(Last.item.key)
|
|
|
|
End
|
|
|
|
Public Sub tvDbus_MouseMove()
|
|
|
|
Dim s As String
|
|
Dim ix, iy As Integer
|
|
Dim hcont As Object
|
|
|
|
If Not tvDbus.FindAt(Mouse.x, Mouse.y) Then
|
|
|
|
s = MakeSignature(tvDbus.item.key)
|
|
|
|
hcont = tvDbus.Parent
|
|
ix = tvDbus.Item.X + tvDbus.Item.w / 2
|
|
iy = tvDbus.Item.Y
|
|
|
|
'lblsignature.Text = s
|
|
'lblsignature.Left = Min(iX, tvDbus.Width - lblsignature.Width)
|
|
'lblsignature.Y = iY
|
|
'lblsignature.Visible = True
|
|
'lblsignature.Refresh
|
|
'Else
|
|
'lblsignature.Visible = False
|
|
Endif
|
|
lblsignature.Text = s
|
|
|
|
End
|
|
|
|
Public Sub btnShowId_Click()
|
|
|
|
btnRefresh_Click
|
|
|
|
End
|