| #! /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 interface-name signal-name parameters user-data)
|
| (dimfi 'on-my-signal)
|
| (dimfi (format #f "~20,,,' @A:" "connection") connection)
|
| (dimfi (format #f "~20,,,' @A:" "sender") sender)
|
| (dimfi (format #f "~20,,,' @A:" "objec-path") object-path)
|
| (dimfi (format #f "~20,,,' @A:" "interface name") interface-name)
|
| (dimfi (format #f "~20,,,' @A:" "signal-name") signal-name))
|
|
|
| (define (subscribe-signal connection)
|
| (signal-subscribe connection
|
| "org.gnu.test.DBus" ; sender
|
| "org.gnu.test.DBus" ; interface-name
|
| "Signal1" ; signal-name
|
| "/org/gnu/test/DBus" ; object-path
|
| #f ; arg0 filter
|
| '() ; flags
|
| on-my-signal ; callback
|
| #f ; user data
|
| #f)) ; user data free func
|
|
|
| (define (dbus-call-sync connection method-name args result-type)
|
| (call-sync connection
|
| "org.gnu.test.DBus" ; bus-name
|
| "/org/gnu/test/DBus" ; object-path
|
| "org.gnu.test.DBus" ; interface-name
|
| method-name ; method-name
|
| (g-variant-new-tuple args) ; parameters
|
| (g-variant-type-new result-type) ; reply-type
|
| '() ; flags
|
| -1 ; timeout-msec
|
| #f)) ; cancellable
|
|
|
| (define (main args)
|
| (letrec ((debug? (or (member "-d" args)
|
| (member "--debug" args)))
|
| (animate
|
| (lambda ()
|
| (let* ((loop (g-main-loop-new))
|
| (connection (g-bus-get-sync 'session #f))
|
| (s-id (subscribe-signal connection))
|
| (m1-result
|
| (dbus-call-sync connection
|
| "Method1"
|
| `(,(g-variant-new-string "Lucky number"))
|
| "(x)"))
|
| (m2-result
|
| (dbus-call-sync connection
|
| "Method2"
|
| `(,(g-variant-new-int64 10))
|
| "(sx)")))
|
| (dimfi (format #f "~20,,,' @A:" "Result of Method1")
|
| (g-variant-get-int64
|
| (g-variant-get-child-value m1-result 0)))
|
| (dimfi (format #f "~20,,,' @A:" "Result of Method2")
|
| (g-variant-get-string
|
| (g-variant-get-child-value m2-result 0))
|
| (g-variant-get-int64
|
| (g-variant-get-child-value m2-result 1)))
|
| (g-main-loop-run loop)))))
|
| (if debug?
|
| (parameterize ((%debug #t)) (animate))
|
| (animate))))
|