Ticket #339: dbus.diff
File dbus.diff, 8.7 KB (added by , 14 years ago) |
---|
-
deleted file Makefile
diff --git a/Makefile b/Makefile deleted file mode 100644 index 7411535..0000000
+ - 1 LIBS = -ldbus-12 INCLUDE = -I/usr/include/dbus-1.0/ -I/usr/lib/dbus-1.0/include3 TARGET = dbus.so4 5 all: $(TARGET)6 7 $(TARGET): dbus.scm8 csc -dynamic $(INCLUDE) -o $(TARGET) dbus.scm $(LIBS)9 10 dbus.egg:11 tar zcvf dbus.egg dbus.meta dbus.setup dbus.scm dbus.html doc test --exclude \.svn* -
dbus.meta
diff --git a/dbus.meta b/dbus.meta index 671ae38..b339278 100644
a b 1 ((egg "dbus.egg") 2 3 ; all the files that should be bundled as part of the egg 4 (files "dbus.scm" "dbus.setup" "dbus.html" 5 "examples/send-signal.scm" 6 "examples/send-example-query.scm" 7 "examples/introspect-hal.scm" 8 "examples/introspect-services.scm" 9 "examples/listen-example.scm" 10 "examples/introspect-phonekit.scm" 11 "examples/introspect-avahi.scm" 12 "examples/paranoid-android.scm" 13 "examples/send-car-turn.scm" 14 "examples/receive-car-turn.scm" 15 "examples/receive-signal.scm" 16 ) 17 18 (license "MIT") 1 ;;; dbus.meta -*- Scheme -*- 19 2 3 ((synopsis "A binding for libdbus, the IPC mechanism") 20 4 (category os) 21 5 (license "MIT") 6 (depends easyffi protobj matchable miscmacros foreigners) 22 7 (doc-from-wiki) 23 24 (author "Shawn Rutledge") 25 26 (synopsis "A binding for libdbus, the IPC mechanism")) 8 (author "Shawn Rutledge")) -
dbus.scm
diff --git a/dbus.scm b/dbus.scm index 6ae8305..52aed89 100644
a b 1 (declare (export 2 ;===== 3 ; functions 1 ;;;; dbus.scm 2 3 (module dbus (dbus:make-context 4 dbus:send 5 dbus:call 6 dbus:make-method-proxy 7 dbus:register-signal-handler 8 dbus:register-method 9 dbus:enable-polling-thread! 10 dbus:poll-for-message 11 dbus:discover-services 12 dbus:discover-api-xml 13 dbus:dbus-service 14 dbus:type-uint32 15 dbus:session-bus 16 dbus:system-bus 17 dbus:starter-bus 18 dbus:known-bus-count 19 dbus:register-path) 20 (import scheme chicken 21 (except foreign foreign-declare) 22 foreigners 23 easyffi 24 miscmacros) 25 (use srfi-18) 4 26 5 ; Construct a context structure6 dbus:make-context7 8 ; Send a message (call a remote method)9 dbus:send10 11 ; Wrap dbus:send in a lambda which you can use just like a local function12 dbus:make-sender13 14 ; Send a method call, then block until the reply is received15 ; and return the reply value(s) as a list16 dbus:call17 18 ; Wrap dbus:call in a lambda which you can use just like a local function19 dbus:make-method-proxy20 21 ; Register a callback to handle a particular signal22 dbus:register-signal-handler23 24 ; Register a callback to handle a particular method25 dbus:register-method26 27 ; By default, dbus:register-method starts a polling thread28 ; if there is not yet one. Call (dbus:enable-polling-thread enable: #f)29 ; to disable it. If you later call (dbus:enable-polling-thread enable: #t)30 ; it will start the polling thread immediately, whether there are31 ; any registered methods or not.32 dbus:enable-polling-thread!33 34 ; Manually poll for a new message35 dbus:poll-for-message36 37 ; Get the list of service names available on a bus38 dbus:discover-services39 40 ; Get the XML API documentation for a service41 ; (if the service implements org.freedesktop.DBus.Introspectable)42 dbus:discover-api-xml43 44 ;=====45 ; constants46 dbus:dbus-service47 dbus:type-uint3248 dbus:session-bus49 dbus:system-bus50 dbus:starter-bus51 ; dbus:known-bus-count52 ))53 54 (use srfi-18)55 27 56 28 #> 57 29 #include <dbus/dbus.h> … … 120 92 121 93 (define dbus:make-context) 122 94 (define dbus:send) 95 (define dbus:make-method-proxy) 96 (define dbus:call) 123 97 (define dbus:flush) 124 98 (define dbus:poll-for-message) 99 (define dbus:register-signal-handler) 100 (define dbus:register-method) 101 (define dbus:register-path) 102 (define dbus:enable-polling-thread!) 103 104 (define dbus:add-match) 105 (define dbus:request-name) 106 125 107 126 108 (define find-callback) 127 109 … … 176 158 177 159 (define (any->string arg) 178 160 (if (string? arg) 179 180 181 182 183 161 arg 162 (if (eq? (void) arg) 163 "" 164 (format "~a" arg) 165 ))) 184 166 185 167 (define (symbol?->string arg) 186 168 (if (symbol? arg) … … 570 552 [reply-args (iter->list reply-iter)] ) 571 553 reply-args)))))) 572 554 573 (define-foreign-record (dbus:vtable "struct DBusObjectPathVTable")555 (define-foreign-record-type (dbus:vtable "struct DBusObjectPathVTable") 574 556 (constructor: dbus:make-vtable-impl) 575 557 (destructor: dbus:free-vtable) 576 (c-pointer unregister_function )577 (c-pointer message_function )578 (c-pointer dbus_internal_pad1 )579 (c-pointer dbus_internal_pad2 )580 (c-pointer dbus_internal_pad3 )581 (c-pointer dbus_internal_pad4 ))558 (c-pointer unregister_function dbus:vtable-unregister_function dbus:vtable-unregister_function-set!) 559 (c-pointer message_function dbus:vtable-message_function dbus:vtable-message_function-set!) 560 (c-pointer dbus_internal_pad1 dbus:vtable-dbus_internal_pad1) 561 (c-pointer dbus_internal_pad2 dbus:vtable-dbus_internal_pad2) 562 (c-pointer dbus_internal_pad3 dbus:vtable-dbus_internal_pad3) 563 (c-pointer dbus_internal_pad4 dbus:vtable-dbus_internal_pad4)) 582 564 583 565 (define (dbus:make-vtable cb unreg-cb) 584 566 (let () … … 637 619 ") conn bus timeout) 638 620 ))) 639 621 640 (set! dbus:enable-polling-thread! (lambda (#!key (bus dbus:session-bus) (enable #t) (interval default-polling-interval))641 (vector-set! polling-enabled bus enable)642 (if enable643 (dbus:start-polling! bus interval)644 (let ([th (vector-ref polling-threads bus)])645 (when th (thread-join! th))))))646 647 648 622 ;; TODO: one polling thread is necessary for each connection 649 623 (define (dbus:start-polling! bus interval) 650 624 (vector-set! polling-interval bus interval) … … 658 632 (thread-sleep! (vector-ref polling-interval bus)) 659 633 (when (vector-ref polling-enabled bus) (loop))))))))) 660 634 635 (set! dbus:enable-polling-thread! (lambda (#!key (bus dbus:session-bus) (enable #t) (interval default-polling-interval)) 636 (vector-set! polling-enabled bus enable) 637 (if enable 638 (dbus:start-polling! bus interval) 639 (let ([th (vector-ref polling-threads bus)]) 640 (when th (thread-join! th)))))) 641 661 642 ;; Wraps a user-provided callback so as to pass it the 662 643 ;; received dbus message's parameters, and return a dbus response 663 644 ;; with the parameter(s) returned from the callback. … … 730 711 (and (pair? xml) (car xml)))))) 731 712 732 713 ) 714 ) 715 No newline at end of file -
dbus.setup
diff --git a/dbus.setup b/dbus.setup index edeb1e5..3f31ddd 100644
a b 1 ;;;; dbus.setup -*- Scheme -*- 1 2 2 ( define has-exports? (string>=? (chicken-version) "2.310"))3 (use files utils) 3 4 4 (compile -s -O2 -d1 5 ,@(if has-exports? '(-check-imports -emit-exports dbus.exports) '()) 6 -ldbus-1 -I/usr/include/dbus-1.0/ -I/usr/lib/dbus-1.0/include 7 dbus.scm) 5 ;; (define has-exports? (string>=? (chicken-version) "2.310")) 6 7 (define prefix (installation-prefix)) 8 (define libpath (make-pathname prefix "lib")) 9 (define incpath (make-pathname prefix "include")) 10 (define binpath (make-pathname prefix "bin")) 11 (define csc (make-pathname binpath "csc")) 12 13 (make (("dbus.import.so" ("dbus.c") 14 (run (,csc -s -O3 -d0 dbus.import.scm))) 15 ("dbus.so" ("dbus.c") 16 (run (,csc -s -O3 -d1 dbus.scm 17 -ldbus-1 -I/usr/include/dbus-1.0/ -I/usr/lib/dbus-1.0/include))) 18 ("dbus.c" ("dbus.scm") 19 (run (,csc -t dbus.scm -O3 -d1 -X easyffi -C -g -j dbus)))) 20 '("dbus.so" "dbus.import.so")) 21 22 ;; (compile -s -O2 -d1 23 ;; ,@(if has-exports? '(-emit-exports dbus.exports) '()) 24 ;; -ldbus-1 -I/usr/include/dbus-1.0/ -I/usr/lib/dbus-1.0/include 25 ;; dbus.scm) 8 26 9 27 (install-extension 'dbus 10 `("dbus.so" 11 "dbus.html" 12 ,@(if has-exports? '("dbus.exports") '()) ) 13 `((version 0.85) 14 ,@(if has-exports? `((exports "dbus.exports")) '()) 15 (documentation "dbus.html") 16 (examples 17 "examples/introspect-avahi.scm" 18 "examples/introspect-services.scm" 19 "examples/receive-car-turn.scm" 20 "examples/send-example-query.scm" 21 "examples/introspect-hal.scm" 22 "examples/listen-example.scm" 23 "examples/receive-signal.scm" 24 "examples/send-signal.scm" 25 "examples/introspect-phonekit.scm" 26 "examples/paranoid-android.scm" 27 "examples/send-car-turn.scm" 28 ))) 28 `("dbus.so" "dbus.import.so") 29 `((version 0.85) 30 (examples 31 "examples/introspect-avahi.scm" 32 "examples/introspect-services.scm" 33 "examples/receive-car-turn.scm" 34 "examples/send-example-query.scm" 35 "examples/introspect-hal.scm" 36 "examples/listen-example.scm" 37 "examples/receive-signal.scm" 38 "examples/send-signal.scm" 39 "examples/introspect-phonekit.scm" 40 "examples/paranoid-android.scm" 41 "examples/send-car-turn.scm"))) 42 43 ;; pkg-config dbus-1 --cflags