[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

ffi-help: dbus demo

From: Matt Wette
Subject: ffi-help: dbus demo
Date: Sun, 18 Mar 2018 07:13:36 -0700
User-agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.6.0

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"

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)))

(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

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

(define loop (g_main_loop_new NULL FALSE))


(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
   (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)))))

 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)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]