gambas-source-code/app/examples/Misc/DBusExplorer/.src/FVersiongbXML.class

' 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
              Break
            Next
            Try tvDbus.Add(sFullDbusPath & "|" & hattr.Value, hattr.Value, Picture[hNode2.Name & ".png"], sFullDbusPath)
            If Error Then Continue
            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

        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 iArg As Integer
  Dim aOut As New String[]

  ars = Split(skey, "|")
  If Not $cArgs.Exist(skey) Then
    If ars.Max = 4 Then
      Return ars[ars.Max] & "()"
    Else
      Return
    Endif
  Endif

  For Each s In Split($cArgs[sKey], "|")

    Inc iArg

    sName = "Arg" & CStr(iArg)
    For Each t In Split(s)
      aArg = Scan(t, "*=*")
      Select Case aArg[0]
        Case "type"
          sType = GetType(aArg[1])
        Case "name"
          sName = aArg[1]
      End Select
    Next

    If InStr(s, "=out") Then

      aOut.Add(sName & " As " & sType)

    Else

      aIn.Add(sName & " As " & sType)

    Endif

  Next

  s = ars[ars.Max] & "(" & aIn.Join(", ") & ")"
  If aOut.Count Then
    s &= " As "
    If aOut.Count = 1 Then
      s &= Scan(aOut[0], "* As *")[1]
    Else
      s &= "[" & aOut.Join(", ") & "]"
    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