Moved DbusInterface to top, to be ued in the loadinng code of Dbus.

Made :m to expand method calls with signature from members list.
Added return signatures to method registrations.

diff --git a/lsp-dbus/lsp-dbus.lsp b/lsp-dbus/lsp-dbus.lsp
index dd75d4735f09b768c550c25abe61f9395ed4ed93..8a4f7c47d2ee07524b7ac74c04dd7f40a15fc23a 100644 (file)
--- a/lsp-dbus/lsp-dbus.lsp
+++ b/lsp-dbus/lsp-dbus.lsp
@@ -14,6 +14,51 @@
 (unless (context? MAIN:prog1) (load "misc.lsp"))
 (unless (context? MAIN:DbusConnection) (load "lsp-dbus-connection.lsp"))
 
+#################################################################
+;; The DbusInterface context is used for modelling DBus interfaces.
+;;
+;; It includes in particular the :use method for installing a
+;; DbusInterface FOOP object as a constant named by the interface.
+;; E.g. (:use (DbusInterface "org.freedesktop.DBus.ObjectManager")
+;; installes the constant ObjectManager with a DbusInterface FOOP
+;; object modelling that interface.
+;;
+;; The :m method is used to construct a fullly qualified method name.
+;; E.g. (:m ObjectManager "GetManagedObjects()") assuming the prior
+;; :use installation of ObjectManager results in the fully qualified
+;; name string
+;;     "org.freedesktop.DBus.ObjectManager.GetManagedObjects()"
+;; 
+(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 the interface prefix. When
+;; the MEMBER is given without "(", then it is duly looked up in the
+;; MEMBERS list of the DbusInterface, and it thus gets expanded with
+;; parameter signature.
+(define (m MEMBER)
+  (unless (find "(" MEMBER)
+    (if (ref (string MEMBER "(") (%members) (fn (x y) (starts-with y x)) true)
+        (setf MEMBER ((parse $it ":") 0))))
+  (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)))))
+
 #################################################################
 (context 'MAIN:Dbus)
 
@@ -135,13 +180,13 @@
         ))))
 
 ;; Context variables and framework registration
-
 (setf
  SYSTEM-BUS (MAIN:DbusConnection "/run/dbus/system_bus_socket")
  APPID (:initialize SYSTEM-BUS)
  ROOT (Dbus "/org/freedesktop/DBus")
- APPNAME (if (lookup "" (:invoke ROOT "org.freedesktop.DBus.Hello()"))
-               ($it 0))
+ DBus (DbusInterface "org.freedesktop.DBus")
+ APPNAME (if (:invoke ROOT (:m DBus "Hello()"))
+             ($it -1 -1 -1))
  )
 
 ;; Installation of some framework notification handlers
@@ -150,9 +195,9 @@
 (define (signal-trace ARGS)
   (die nil "** Got:" KEY ARGS ))
 
-(:handler ROOT "org.freedesktop.DBus.NameAcquired(s)" signal-trace)
-(:handler ROOT "org.freedesktop.DBus.NameLost(s)" signal-trace)
-(:handler ROOT "org.freedesktop.DBus.NameOwnerChanged(sss)" signal-trace)
+(:handler ROOT (:m DBus "NameAcquired(s)") signal-trace)
+(:handler ROOT (:m DBus "NameLost(s)") signal-trace)
+(:handler ROOT (:m DBus "NameOwnerChanged(sss)") signal-trace)
 
  ; Process notifications that came with the registration handshake
 (process-all-pending)
@@ -160,30 +205,6 @@
 ;; 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)))))
-
 ;;######################################################################
 ;;
 ;; Standard interfaces
@@ -191,50 +212,50 @@
 (context MAIN)
 
 (:use (DbusInterface "org.freedesktop.DBus.Peer"
-                     '( "Ping()"
-                        "GetMachineId()" ; s
+                     '( "Ping():"
+                        "GetMachineId():s"
                         )))
 
 (:use (DbusInterface "org.freedesktop.DBus.ObjectManager"
-                     '( "GetManagedObjects()" ; a(oa(sa(sv)))
+                     '( "GetManagedObjects():a(oa(sa(sv)))"
                         )))
 
 (:use (DbusInterface "org.freedesktop.DBus.Introspectable"
-                     ' Introspectable "Introspect()" ; s (xml data)
+                     ' 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 ?
+                     '( "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)" ; ?
+                     '( "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: