;; 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"
projects / rrq / lsp-utils.git / blobdiff