Ticket #339: dbus.diff

File dbus.diff, 8.7 KB (added by felix winkelmann, 14 years ago)

  • deleted file Makefile 

    diff --git a/Makefile b/Makefile
deleted file mode 100644
index 7411535..0000000
    + -  
    1 LIBS = -ldbus-1
    2 INCLUDE = -I/usr/include/dbus-1.0/ -I/usr/lib/dbus-1.0/include
    3 TARGET = dbus.so
    4 
    5 all: $(TARGET)
    6 
    7 $(TARGET): dbus.scm
    8         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 -*-
    192
     3((synopsis "A binding for libdbus, the IPC mechanism")
    204 (category os)
    21 
     5 (license "MIT")
     6 (depends easyffi protobj matchable miscmacros foreigners)
    227 (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)
    426
    5         ; Construct a context structure
    6         dbus:make-context
    7 
    8         ; Send a message (call a remote method)
    9         dbus:send
    10 
    11         ; Wrap dbus:send in a lambda which you can use just like a local function
    12         dbus:make-sender
    13 
    14         ; Send a method call, then block until the reply is received
    15         ; and return the reply value(s) as a list
    16         dbus:call
    17 
    18         ; Wrap dbus:call in a lambda which you can use just like a local function
    19         dbus:make-method-proxy
    20 
    21         ; Register a callback to handle a particular signal
    22         dbus:register-signal-handler
    23 
    24         ; Register a callback to handle a particular method
    25         dbus:register-method
    26 
    27         ; By default, dbus:register-method starts a polling thread
    28         ; 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 are
    31         ; any registered methods or not.
    32         dbus:enable-polling-thread!
    33 
    34         ; Manually poll for a new message
    35         dbus:poll-for-message
    36 
    37         ; Get the list of service names available on a bus
    38         dbus:discover-services
    39 
    40         ; Get the XML API documentation for a service
    41         ; (if the service implements org.freedesktop.DBus.Introspectable)
    42         dbus:discover-api-xml
    43 
    44         ;=====
    45         ; constants
    46         dbus:dbus-service
    47         dbus:type-uint32
    48         dbus:session-bus
    49         dbus:system-bus
    50         dbus:starter-bus
    51         ; dbus:known-bus-count
    52 ))
    53 
    54 (use srfi-18)
    5527
    5628#>
    5729        #include <dbus/dbus.h>
    … …  
    12092
    12193(define dbus:make-context)
    12294(define dbus:send)
     95(define dbus:make-method-proxy)
     96(define dbus:call)
    12397(define dbus:flush)
    12498(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
    125107
    126108(define find-callback)
    127109
    … …  
    176158
    177159    (define (any->string arg)
    178160      (if (string? arg)
    179         arg
    180         (if (eq? (void) arg)
    181           ""
    182           (format "~a" arg)
    183         )))
     161        arg
     162        (if (eq? (void) arg)
     163          ""
     164          (format "~a" arg)
     165        )))
    184166
    185167        (define (symbol?->string arg)
    186168                (if (symbol? arg)
    … …  
    570552                                                                [reply-args (iter->list reply-iter)] )
    571553                                                        reply-args))))))
    572554
    573         (define-foreign-record (dbus:vtable "struct DBusObjectPathVTable")
     555        (define-foreign-record-type (dbus:vtable "struct DBusObjectPathVTable")
    574556                (constructor: dbus:make-vtable-impl)
    575557                (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))
    582564
    583565        (define (dbus:make-vtable cb unreg-cb)
    584566                (let ()
    … …  
    637619                                ") conn bus timeout)
    638620                )))
    639621
    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 enable
    643                         (dbus:start-polling! bus interval)
    644                         (let ([th (vector-ref polling-threads bus)])
    645                                 (when th (thread-join! th))))))
    646 
    647 
    648622        ;; TODO: one polling thread is necessary for each connection
    649623        (define (dbus:start-polling! bus interval)
    650624                (vector-set! polling-interval bus interval)
    … …  
    658632                                                (thread-sleep! (vector-ref polling-interval bus))
    659633                                                (when (vector-ref polling-enabled bus) (loop)))))))))
    660634
     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
    661642        ;; Wraps a user-provided callback so as to pass it the
    662643        ;; received dbus message's parameters, and return a dbus response
    663644        ;; with the parameter(s) returned from the callback.
    … …  
    730711                                (and (pair? xml) (car xml))))))
    731712
    732713)
     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 -*-
    12
    2 (define has-exports? (string>=? (chicken-version) "2.310"))
     3(use files utils)
    34
    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)
    826
    927(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