Added DbusInterface context for explicit modelling of DBus interfaces.

diff --git a/lsp-dbus/lsp-dbus.lsp b/lsp-dbus/lsp-dbus.lsp
index 6b50235e99472744b16f2c8177ceede0e883d4bc..dd75d4735f09b768c550c25abe61f9395ed4ed93 100644 (file)
--- a/lsp-dbus/lsp-dbus.lsp
+++ b/lsp-dbus/lsp-dbus.lsp
@@ -160,68 +160,84 @@
 ;; Set up the Dbus event loop as prompt-event handler
 (prompt-event Dbus:main-loop)
 
+(context 'DbusInterface)
+(FOOP name members)
+
+;; FOOP constructor; remember the interface name
+(define (DbusInterface:DbusInterface NAME (MEMBERS '()))
+  (list (context) NAME MEMBERS))
+
+;; Utility method to expand a member with interface prefix
+(define (m MEMBER)
+  (string (%name) "." MEMBER))
+
+;; Install this interface into the context of the caller
+(define (use)
+  (let ((IF (when (regex "([^.]+)$" (%name) 0) $1))
+        (CC (prefix (first (or (1 (history)) '(MAIN))))))
+    (letex ((S (sym $1 CC)) (V (self)))
+      (begin (context CC) (constant 'S 'V)))))
+
+;; Declare additional members for this interface
+(define (has)
+  (dolist (MEMBER (args))
+    (unless (member MEMBER (%members))
+      (!members (push MEMBER (%members) -1)))))
+
 ;;######################################################################
 ;;
-;; Some tidbits
-
-;;org.freedesktop.DBus.Peer.Ping ()
-;;org.freedesktop.DBus.Peer.GetMachineId (out STRING machine_uuid)
-;;org.freedesktop.DBus.Introspectable.Introspect (out STRING xml_data)
-;;org.freedesktop.DBus.Properties.Get (
-;;            in STRING interface_name,
-;;            in STRING property_name,
-;;            out VARIANT value);
-;;org.freedesktop.DBus.Properties.Set (
-;;            in STRING interface_name,
-;;            in STRING property_name,
-;;            in VARIANT value);
-;;org.freedesktop.DBus.Properties.GetAll (
-;;            in STRING interface_name,
-;;            out ARRAY of DICT_ENTRY<STRING,VARIANT> props);
-;;org.freedesktop.DBus.Properties.PropertiesChanged (
-;;            STRING interface_name,
-;;            ARRAY of DICT_ENTRY<STRING,VARIANT> changed_properties,
-;;            ARRAY<STRING> invalidated_properties);
-;;org.freedesktop.DBus.ObjectManager.GetManagedObjects (
-;;            out ARRAY of
-;;               DICT_ENTRY<OBJPATH,ARRAY of
-;;                  DICT_ENTRY<STRING,ARRAY of
-;;                     DICT_ENTRY<STRING,VARIANT>>>
-;;            objpath_interfaces_and_properties);
-;;org.freedesktop.DBus.ObjectManager.GetManagedObjects():a(oa(sa(sv)))
-;
-;;org.freedesktop.DBus.Hello():s
-;;org.freedesktop.DBus.RequestName(su):u
-;;org.freedesktop.DBus.ReleaseName(s):u
-;;org.freedesktop.DBus.ListQueuedOwners (s):as
-;;org.freedesktop.DBus.ListNames():as
-;;org.freedesktop.DBus.ListActivatableNames():as
-;;org.freedesktop.DBus.NameHasOwner(s):b
-;;org.freedesktop.DBus.NameOwnerChanged(sss) -- signal
-;;org.freedesktop.DBus.NameLost(s) -- signal
-;;org.freedesktop.DBus.NameAcquired(s) -- signal
-;;org.freedesktop.DBus.ActivatableServicesChanged() -- signal
-;;org.freedesktop.DBus.StartServiceByName(s,u):u
-;;org.freedesktop.DBus.UpdateActivationEnvironment(a(ss)):?
-;;org.freedesktop.DBus.GetNameOwner(s):s
-;;org.freedesktop.DBus.GetConnectionUnixUser(s):u
-;;org.freedesktop.DBus.GetConnectionUnixProcessID(s):u
-;;org.freedesktop.DBus.GetConnectionCredentials(s):a(sv)
-;;org.freedesktop.DBus.GetAdtAuditSessionData(s):ay
-;;org.freedesktop.DBus.GetConnectionSELinuxSecurityContext(s):ay
-;;org.freedesktop.DBus.AddMatch(s):? (org.freedesktop.DBus.Error.OOM)
-;;org.freedesktop.DBus.RemoveMatch(s):?
-;;org.freedesktop.DBus.GetId():s
-;;org.freedesktop.DBus.Monitoring.BecomeMonitor(asu):?
-
-;;org.freedesktop.DBus.AddMatch(s)
-;eg 
+;; Standard interfaces
+
+(context MAIN)
+
+(:use (DbusInterface "org.freedesktop.DBus.Peer"
+                     '( "Ping()"
+                        "GetMachineId()" ; s
+                        )))
+
+(:use (DbusInterface "org.freedesktop.DBus.ObjectManager"
+                     '( "GetManagedObjects()" ; a(oa(sa(sv)))
+                        )))
+
+(:use (DbusInterface "org.freedesktop.DBus.Introspectable"
+                     ' Introspectable "Introspect()" ; s (xml data)
+                       ))
+; https://dbus.freedesktop.org/doc/dbus-specification.html#introspection-format
+
+(:use (DbusInterface "org.freedesktop.DBus.Properties"
+                     '( "Get(ss)" ; v
+                        "Set(ssv)" ; --
+                        "GetAll(s)" ; a(sv)
+                        "PropertiesChanged(sa(sv)as)" ; signal ?
+                        )))
+
+(:use (DbusInterface "org.freedesktop.DBus"
+                     '( "Hello()" ; s
+                        "RequestName(su)" ; u
+                        "ReleaseName(s)" ; u
+                        "ListQueuedOwners (s)" ; as
+                        "ListNames()" ; as
+                        "ListActivatableNames()" ; as
+                        "NameHasOwner(s)" ; b
+                        "NameOwnerChanged(sss)" ;   -- signal
+                        "NameLost(s)" ;  -- signal
+                        "NameAcquired(s)" ;  -- signal
+                        "ActivatableServicesChanged()" ;  -- signal
+                        "StartServiceByName(s,u)" ; u
+                        "UpdateActivationEnvironment(a(ss))" ; ?
+                        "GetNameOwner(s)" ; s
+                        "GetConnectionUnixUser(s)" ; u
+                        "GetConnectionUnixProcessID(s)" ; u
+                        "GetConnectionCredentials(s)" ; a(sv)
+                        "GetAdtAuditSessionData(s)" ; ay
+                        "GetConnectionSELinuxSecurityContext(s)" ; ay
+                        "AddMatch(s)" ; 
+                        "RemoveMatch(s)" ; ?
+                        "GetId()" ; s
+                        "Monitoring.BecomeMonitor(asu)" ; ?
+                        )))
+
+;eg AddMatch argument:
 ;"type='signal',sender='org.example.App2',path_namespace='/org/example/App2'"
 
-;;org.freedesktop.DBus.StartServiceByName(?)
-;;org.freedesktop.DBus.NameOwnerChanged(?)
-
-;; org.freedesktop.DBus.Introspectable.Introspect():s (xml data)
-;; https://dbus.freedesktop.org/doc/dbus-specification.html#introspection-format
-
 "lsp-dbus.lsp"