diff --git a/gb.dbus/src/gb.dbus/.src/CIntrospection.class b/gb.dbus/src/gb.dbus/.src/CIntrospection.class new file mode 100644 index 000000000..41eafe917 --- /dev/null +++ b/gb.dbus/src/gb.dbus/.src/CIntrospection.class @@ -0,0 +1,194 @@ +' Gambas class file + +Private $sText As String +Private $iPos As Integer + +Property Read Text As String Use $sBefore +Property Read Open As Boolean Use $bOpen +Property Read Close As Boolean Use $bClose +Property Read Node As String Use $sNode +Property Read Level As Integer Use $iLevel + +Private $cAttr As Collection + +Public Sub _new(sText As String) + + $sText = sText + +End + +Public Sub MoveNext() As Boolean + + Dim sCar As String + Dim iStart As Integer + Dim sEnd As String + + If $bClose Then Dec $iLevel + + $bOpen = False + $bClose = False + $sNode = "" + + iStart = $iPos + Do + GoSub READ_CHAR + If Not sCar Then Return True + If sCar = "<" Then + If Mid$($sText, $iPos) Begins "", $iPos + 4) + If $iPos = 0 Then Return True + $iPos += 3 + Continue + Endif + Goto READ_MARKUP + Endif + Loop + +READ_MARKUP: + + $sBefore = Mid$($sText, iStart + 1, $iPos - 1) + iStart = $iPos + + Do + + GoSub READ_CHAR + If sCar = "\"" Or If sCar = "'" Then + GoSub READ_STRING + Else If sCar = ">" Then + AnalyzeMarkup(Mid$($sText, iStart, $iPos - iStart + 1)) + If $bOpen Then Inc $iLevel + Return + Else If Not sCar Then + Return True + Endif + + Loop + +READ_STRING: + + sEnd = sCar + Do + GoSub READ_CHAR + If Not sCar Then Return True + If sCar = sEnd Then Return + Loop + +READ_CHAR: + + Inc $iPos + If $iPos <= Len($sText) Then + sCar = Mid$($sText, $iPos, 1) + Else + sCar = "" + Endif + Return + +End + +Private Sub AnalyzeMarkup(sMarkup As String) + + Dim iPos As Integer + Dim sCar As String + Dim sEnd As String + Dim sAttr As String + Dim iPosAttr As Integer + Dim sValue As String + Dim iStart As Integer + + $cAttr = New Collection + + sMarkup = Mid$(sMarkup, 2, -1) + + If sMarkup Begins "!DOCTYPE" Then + Return + Endif + + If sMarkup Begins "/" Then + sMarkup = Mid$(sMarkup, 2) + $bClose = True + Else + $bOpen = True + If sMarkup Ends "/" Then + sMarkup = Left(sMarkup, -1) + $bClose = True + Endif + Endif + + iPos = InStr(sMarkup, " ") + If iPos = 0 Then + $sNode = sMarkup + Return + Endif + + $sNode = Left(sMarkup, iPos - 1) + sMarkup = Mid(sMarkup, iPos + 1) + + iPos = 0 + iStart = 1 + + Do + + GoSub READ_CHAR + + If sCar = "\"" Or If sCar = "'" Then + GoSub READ_STRING + Else If sCar = " " Or If Not sCar Then + sAttr = Mid$(sMarkup, iStart, iPos - iStart) + If sAttr Then + iPosAttr = InStr(sAttr, "=") + If iPosAttr > 1 Then + sValue = Mid$(sAttr, iPosAttr + 1) + If sValue Begins "\"" And If sValue Ends "\"" Then + sValue = Mid$(sValue, 2, -1) + Else If sValue Begins "'" And If sValue Ends "'" Then + sValue = Mid$(sValue, 2, -1) + Endif + $cAttr[Left(sAttr, iPosAttr - 1)] = sValue + Else + If sAttr Ends "=" Then sAttr = Left(sAttr, -1) + $cAttr[sAttr] = "" + Endif + Endif + iStart = iPos + 1 + If Not sCar Then Break + Endif + + Loop + + Return + +READ_STRING: + + sEnd = sCar + Do + GoSub READ_CHAR + If sCar = sEnd Or If Not sCar Then Return + Loop + +READ_CHAR: + + Inc iPos + If iPos <= Len(sMarkup) Then + sCar = Mid$(sMarkup, iPos, 1) + Else + sCar = "" + Endif + Return + +End + +Public Sub HasAttribute(sName As String) As Boolean + + Return $cAttr.Exist(sName) + +End + +Public Sub GetAttribute(sName As String) As String + + Dim vVal As Variant + + vVal = $cAttr[sName] + If TypeOf(vVal) = gb.Boolean Then Return + Return vVal + +End diff --git a/gb.dbus/src/gb.dbus/.src/DBus.class b/gb.dbus/src/gb.dbus/.src/DBus.class index c73a7c289..424ed2d4d 100644 --- a/gb.dbus/src/gb.dbus/.src/DBus.class +++ b/gb.dbus/src/gb.dbus/.src/DBus.class @@ -21,25 +21,18 @@ Static Private $hSession As DBusConnection Static Public Sub _get((Application) As String) As DBusApplication Dim hConn As DBusConnection - Dim hApp As DBusApplication - Dim sKey As String If Application Like "system://*" Then - sKey = Application Application = Mid$(Application, 10) hConn = DBus.System Else If Application Like "session://*" Then - sKey = Application Application = Mid$(Application, 11) hConn = DBus.Session Else - sKey = "session://" & Application hConn = DBus.Session Endif - hApp = _ApplicationCache[sKey] - If Not hApp Then hApp = New DBusApplication(hConn, Application) - Return hApp + Return hConn[Application] End diff --git a/gb.dbus/src/gb.dbus/.src/DBusConnection.class b/gb.dbus/src/gb.dbus/.src/DBusConnection.class index 0cc678ade..ee652b279 100644 --- a/gb.dbus/src/gb.dbus/.src/DBusConnection.class +++ b/gb.dbus/src/gb.dbus/.src/DBusConnection.class @@ -37,3 +37,22 @@ Public Sub Close() End +Public Sub _get((Application) As String) As DBusApplication + + Dim hApp As DBusApplication + Dim sKey As String + + If Me = DBus.System Then + sKey = "system://" & Application + Else If Me = DBus.Session Then + sKey = "session://" & Application + Else + sKey = "unknown://" & Application + Endif + + hApp = DBus._ApplicationCache[sKey] + If Not hApp Then hApp = New DBusApplication(Me, Application) + Return hApp + +End + diff --git a/gb.dbus/src/gb.dbus/.src/DBusProxy.class b/gb.dbus/src/gb.dbus/.src/DBusProxy.class index 37cb72372..8d32578a8 100644 --- a/gb.dbus/src/gb.dbus/.src/DBusProxy.class +++ b/gb.dbus/src/gb.dbus/.src/DBusProxy.class @@ -259,46 +259,11 @@ End Private Function Children_Read() As String[] - Dim sIntr As String - Dim aChildren As New String[] - Dim iPos, iPos2, iLevel As Integer - Dim sNode, sChild As String Dim hApp As DBusApplication hApp = DBus._ApplicationCache[$hAppIndex] - sIntr = hApp._Introspect($sObjectPath) - - Do - iPos2 = iPos - iPos = InStr(sIntr, "", iPos2 + 1) - If iPos2 = 0 Then iPos2 = Len(sIntr) + 1 - - If iPos > Len(sIntr) And If iPos2 > Len(sIntr) Then Return aChildren - - If iPos < iPos2 Then - - Inc iLevel - If iLevel <> 2 Then Continue - - iPos2 = InStr(sIntr, ">", iPos + 1) - If iPos2 = 0 Then Continue - - sNode = Mid$(sIntr, iPos, iPos2 - iPos + 1) - Try sChild = Scan(sNode, "*name=\"*\"*")[1] - If sChild Then aChildren.Add(sChild) - - If Right(sNode, 2) = "/>" Then Dec iLevel - - Else - - iPos = iPos2 - Dec iLevel - - Endif - - Loop + $sIntrospection = hApp._Introspect($sObjectPath) + Return _GetSymbols("node") End @@ -307,3 +272,28 @@ Private Function _Introspection_Read() As String Return $sIntrospection End + +Public Sub _GetSymbols(Optional Which As String) As String[] + + Dim hIntr As CIntrospection + Dim aSym As New String[] + Dim sName As String + + hIntr = New CIntrospection($sIntrospection) + + While Not hIntr.MoveNext() + + If Not hIntr.Open Then Continue + If hIntr.Level <> 2 Then Continue + If Which And If hIntr.Node <> Which Then Continue + + sName = hIntr.GetAttribute("name") + If Not sName Then Continue + If Not Which Then sName = Left(hIntr.Node) & ":" & sName + aSym.Add(sName) + + Wend + + Return aSym + +End diff --git a/gb.dbus/src/gb.dbus/.src/MMain.module b/gb.dbus/src/gb.dbus/.src/MMain.module index b3e35ac17..5c092ad09 100644 --- a/gb.dbus/src/gb.dbus/.src/MMain.module +++ b/gb.dbus/src/gb.dbus/.src/MMain.module @@ -157,12 +157,14 @@ Public Sub Main() Dim cManaged As Collection - Try Print DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2", "org.freedesktop.DBus.Introspectable"].Introspect() + 'Try Print DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2", "org.freedesktop.DBus.Introspectable"].Introspect() - Try cManaged = DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2", "org.freedesktop.DBus.ObjectManager"].GetManagedObjects() + 'Try cManaged = DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2", "org.freedesktop.DBus.ObjectManager"].GetManagedObjects() - If Error Then - Print Error.Text - Endif + Print DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2/drives/ST1000LM024_HN_M101MBB_S2ZUJ9BCB04136", "org.freedesktop.UDisks2.Drive"]._GetSymbols().Join("\n") + + 'Print DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2/drives"]._GetSymbols("node").Join("\n") + + 'Print DBus.System._Name End