| #! /bin/sh
|
| # -*- mode: scheme; coding: utf-8 -*-
|
| exec guile -e main -s "$0" "$@"
|
| !#
|
|
|
| (eval-when (expand load eval)
|
| (use-modules (oop goops))
|
|
|
| (default-duplicate-binding-handler
|
| '(merge-generics replace warn-override-core warn last))
|
|
|
| (use-modules (g-golf))
|
|
|
| (g-irepository-require "Gio")
|
| (for-each (lambda (name)
|
| (gi-import-by-name "Gio" name))
|
| '("DBusConnection"
|
| "bus_get_sync")))
|
|
|
| (define (on-my-signal connection sender object-path iface-name signal-name parameters user-data)
|
| (dimfi 'on-my-signal)
|
| (dimfi (format #f "~20,,,' @A:" "Received a signal") signal-name)
|
| (dimfi (format #f "~20,,,' @A:" "interface") iface-name))
|
|
|
| (define (subscribe-signal conn)
|
| (gd-bus-connection-signal-subscribe
|
| conn
|
| "fi.tohoyn.DBusServer1" ; sender
|
| "fi.tohoyn.DBusServer1" ; interface
|
| "MySignal" ; signal
|
| "/fi/tohoyn/DBusServer1" ; object path
|
| #f ; arg0 filter
|
| '() ; flags
|
| on-my-signal ; callback
|
| #f ; user data
|
| #f)) ; user data free func
|
|
|
| (define (dbus-call conn str-method l-vnt-args str-result-type)
|
| (gd-bus-connection-call-sync
|
| conn
|
| "fi.tohoyn.DBusServer1" ; bus name
|
| "/fi/tohoyn/DBusServer1" ; object path
|
| "fi.tohoyn.DBusServer1" ; interface
|
| str-method ; method
|
| (g-variant-new-tuple l-vnt-args) ; arguments
|
| (g-variant-type-new str-result-type) ; expected reply type
|
| '() ; flags
|
| -1 ; timeout
|
| #f)) ; cancellable
|
|
|
| (define (main args)
|
| (letrec ((debug? (or (member "-d" args)
|
| (member "--debug" args)))
|
| (animate
|
| (lambda ()
|
| (let* ((loop (g-main-loop-new))
|
| (conn (g-bus-get-sync 'session #f))
|
| (i-subscription (subscribe-signal conn))
|
| (vnt-result1
|
| (dbus-call conn
|
| "MyMethod1"
|
| (list
|
| (g-variant-new-string
|
| "Lucky number"))
|
| "(x)"))
|
| (vnt-result2
|
| (dbus-call conn
|
| "MyMethod2"
|
| (list
|
| (g-variant-new-int64 10))
|
| "(sx)")))
|
| (dimfi 'main)
|
| (dimfi (format #f "~20,,,' @A:" "subscription")
|
| i-subscription)
|
| (dimfi (format #f "~20,,,' @A:" "Result of MyMethod1")
|
| (g-variant-get-int64
|
| (g-variant-get-child-value vnt-result1 0)))
|
| (dimfi (format #f "~20,,,' @A:" "Result of MyMethod2")
|
| (g-variant-get-string
|
| (g-variant-get-child-value vnt-result2 0))
|
| ","
|
| (g-variant-get-int64
|
| (g-variant-get-child-value vnt-result2 1)))
|
| (g-main-loop-run loop)))))
|
| (if debug?
|
| (parameterize ((%debug #t)) (animate))
|
| (animate))))
|