X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=lsp-dbus%2Flsp-dbus-events.lsp;h=3bde66144bc3295361f58f956cfde93e3c943cec;hb=121167c737403e2f49231fd5704aae86850b5b38;hp=6e93994ff89a9651f956b0b302db461382baaa17;hpb=1898ef96b70cb93c53a84e6a7536d0a3bceb35d6;p=rrq%2Flsp-utils.git

diff --git a/lsp-dbus/lsp-dbus-events.lsp b/lsp-dbus/lsp-dbus-events.lsp
index 6e93994..3bde661 100644
--- a/lsp-dbus/lsp-dbus-events.lsp
+++ b/lsp-dbus/lsp-dbus-events.lsp
@@ -1,33 +1,81 @@
 ;; This newlisp module implements dbus socket send-receive together
-;; with signal receive.
-;
-; This should be included into the Dbus contect
+;; with signal receive. (This file should be loaded into the Dbus
+;; context)
+;;
+;; The REPL loop is re-mastered by means of a prompt-event function
+;; that firstly handles any pending dbus messages, and secondly
+;; net-select on both the dbus socket and stdin.
+;;
+;; Stdin is handled with priority.
+;;
+;; Dbus messages are read and added to the pending list.
+;;
+;; Handlers are set up as functions (fn (data msg) ..) identified by
+;; "dbus callback key" consisting of path, interface, method and
+;; signature separated by ":". For example:
+;;
+;;    "/org/freedesktop/DBus:org.freedesktop.DBus.NameAcquired(s)"
+;;
+;; would identify the handler for the NameAcquired(string) method of
+;; the interface "org.freedesktop.DBus" of the path
+;; "/org/freedesktop/DBus" of the client. That particular callback is
+;; a s.c. signal sent by the dbus framework implementation in reaction
+;; to the initial Hello call, i.e. the s.c. invocation of
+;;
+;;    "/org/freedesktop/DBus:org.freedesktop.DBus.Hello()"
+;;
 
-(setf pending '())
+;; Return the callback key for a message MSG
+(define (message-key MSG)
+  (string (lookup 'PATH MSG) ":" (lookup 'INTERFACE MSG) "."
+          (lookup 'MEMBER MSG) "(" (lookup 'SIGNATURE MSG) ")" ))
+
+;; This is the table of handlers, keyed by path:interface:method:signature
+(define RECV:RECV nil)
+
+;; Utility function to install a handler for a given key,
+(define (handler KEY HANDLER)
+  (RECV (string (%path) ":" KEY) HANDLER))
 
-(define 'RECV:RECV nil) ; Table of objects that receive calls/signals
+;; This is the list of Dbus messages still to handle.
+(setf pending '())
 
-(define (set-object PATH HANDLER) (RECV PATH HANDLER))
+(define (no-handler KEY MSG)
+  (write-line 2 (format "** No handler %s for:\n%s" KEY (string MSG))))
 
-(define (process-signal DATA)
-  (let ((MSG (unpack-message "uuuuyya(yv)" DATA)))
-    ;; Determine object concerned
-    ;; Determine that object's handler for this signal
-    ;; Call the handler with signal data
-    ))
+(define (process-message MSG)
+  ;;(die nil (list 'process-message MSG))
+  (let ((KEY (message-key MSG)))
+    ;;(die nil "Dbus:process-message" KEY (and (RECV KEY) true))
+    (if (RECV KEY) ($it (lookup "" MSG))
+      (no-handler KEY MSG))))
 
-(define (send-recv--message MSG)
-  ;; Pack the message into a data block
-  (:send-message SYSTEM-SOCKET)
-  (while (unrelated (setf MSEG (:read-message SYSTEM-BUS )))
-    (push MSG pending -1))
-  MSG)
+;; Process all messages currently pending
+(define (process-all-pending)
+  (while (if (pop pending) (process-message $it))))
 
 ;; The main-loop is intended as a prompt-handler so as to deal with
 ;; asyncronous events
-(define (main-loop)
-  (let ((FDS (list 0 (:%socket SYSTEM-BUS))))
-    (while (and (empty? pending) (not (member 0 (net-select FDS "r" -1))))
-      (if (pop pending) (process-signal $it)
-        (if (:read-message SYSTEM-BUS) (push $it pending -1)))
-      )))
\ No newline at end of file
+(define (main-loop S)
+  (let ((FDS (list 0 (:%socket SYSTEM-BUS))) (FD nil))
+    ;;(die nil "Dbus:main-loop" (length pending) "pending")
+    (write 2 (string "> "))
+    (while (or pending (not (member 0 (net-select FDS "r" -1))))
+      (if (pop pending) (process-message $it)
+        (if (unpack-messages (or (:read-message SYSTEM-BUS) ""))
+            (extend pending $it))
+        ))
+    "main-loop: "))
+
+;; Send message, then keep reading messages until there is a reply
+(define (send-recv-message MSG)
+  ;;(die nil (list 'send-recv-message (octals-string MSG)))
+  (net-send (:%socket SYSTEM-BUS) MSG)
+  (let ((REPLY nil))
+    (while (nil? REPLY)
+      (dolist (M (unpack-messages (:read-message SYSTEM-BUS)))
+        (if (lookup 'REPLY_SERIAL M) (setf REPLY M)
+          (push M pending -1))))
+    REPLY))
+
+"lsp-dbus-events.lsp"