ffi-help: dbus demo

[Matt Wette]

Hi All,

I am working on a ffi-helper (FH): a program that will read in C dot-h files
and generate a Guile dot-scm file which defines a module to provide
hooks into
the associated C libraries.

I am currently writing random code to see what utilities are needed to
help use
ffi-help.I just ran my first dbus program in guile, using ffi modules
for glib,
gio, etc.I still have to check if I'm getting the right content, but it
seems
to run at least.I also don't know how GC between C libraries like glib
and guile
will pan out.  I haveadded guardians, but not sure I need them yet or
that I have
put them in the right place.


mwette$ guile dbus01.scm
<!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection
1.0//EN"
"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">
<node>
</node>

mwette$ cat dbus01.scm
(use-modules (system ffi-help-rt))
(use-modules ((system foreign) #:prefix ffi:))
(use-modules (bytestructures guile))

(use-modules (ffi glib))
(use-modules (ffi gobject))
(use-modules (ffi gio))

(define (sf fmt . args) (apply simple-format #t fmt args))

(define FALSE 0)

(define (got-error? error)
  (not (zero? (bytestructure-ref (fh-object-val error)))))

(define (g-error-message error)
  (let* ((eval (fh-object-ref error '* 'message))
         (pval (ffi:make-pointer eval))
         (sval (ffi:pointer->string pval)))
    sval))

(define glib-guardian (make-guardian))

(define gv-string-singleton-type        ; gen. variant type "(s)"
  (let* ((code "s")
         (cptr (ffi:string->pointer code)) ; GVariantType* for "s"
         (cadr (ffi:pointer-address cptr))
         (cvec (bytestructure (bs:vector 1 (bs:pointer int8)) (vector
cadr)))
         (cptr (ffi:make-pointer (bs-addr cvec)))
         (gvar (g_variant_type_new_tuple cptr 1)))
    (glib-guardian code)                ; guard "s" from collection
    gvar))

;; === main ============================

(define loop (g_main_loop_new NULL FALSE))

(g_type_init)

(define error (make-GError*))

(define conn (g_bus_get_sync 'G_BUS_TYPE_SESSION NULL (pointer-to error)))

(define (check-rez rez)                 ; rez: GVariant*
  (let* ((type (ffi:pointer->string (g_variant_get_type_string rez)))
         (elt0 (g_variant_get_child_value rez 0))
         (strp (g_variant_get_string elt0 NULL))
         (strv (ffi:pointer->string strp)))
    ;; needs work
    (glib-guardian elt0)
    (display strv)))

(define callback
  (make-GAsyncReadyCallback
   (lambda (~src ~res user_data)
     (let* ((src (make-GObject* ~src))
            (res (make-GAsyncResult* ~res))
            (err (make-GError*))
            (rez (g_dbus_connection_call_finish conn res (pointer-to err)))
            )
       (if (got-error? err)
           (sf "~A\n" (g-error-message err))
           (check-rez rez))
       (g_main_loop_quit loop)
       (if #f #f)))))

(g_dbus_connection_call
 conn                                   ; connection
 NULL                                   ; bus name
 "/RecoveryMedia"                       ; object path
 "org.freedesktop.DBus.Introspectable"  ; interface name
 "Introspect"                           ; method
 NULL                                   ; parameters
 gv-string-singleton-type               ; GVariantType*
 'G_DBUS_CALL_FLAGS_NONE                ; GDBusCallFlags
 1000                                   ; timeout_msec
 NULL                                   ; GCancellable*
 callback                               ; GAsyncReadyCallback
 NULL                                   ; user_data
 )

(g_main_loop_run loop)