Changeset 25884 in project for release/4/dbus/trunk/dbus.scm


Ignore:
Timestamp:
02/10/12 00:20:55 (9 years ago)
Author:
ecloud
Message:

Removed dbus: prefix; you can add it back like this: (use (prefix dbus dbus:))

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/dbus/trunk/dbus.scm

    r25883 r25884  
    11;;;; dbus.scm
    22
    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:session-bus
    15               dbus:system-bus
    16               dbus:starter-bus
    17               dbus:known-bus-count
    18               dbus:register-path
     3(module dbus (make-context
     4              send
     5              call
     6              make-method-proxy
     7              register-signal-handler
     8              register-method
     9              enable-polling-thread!
     10              poll-for-message
     11              discover-services
     12              discover-api-xml
     13              dbus-service
     14              session-bus
     15              system-bus
     16              starter-bus
     17              known-bus-count
     18              register-path
    1919                  unsupported-type?
    2020                  unsupported-type-signature
     
    7070
    7171; Would want to do this:
    72 ; (define-foreign-enum (dbus:bus (enum "DBusBusType"))
    73         ; (dbus:session-bus DBUS_BUS_SESSION)
    74         ; (dbus:system-bus DBUS_BUS_SYSTEM)
    75         ; (dbus:starter-bus DBUS_BUS_STARTER) )
     72; (define-foreign-enum (bus (enum "DBusBusType"))
     73        ; (session-bus DBUS_BUS_SESSION)
     74        ; (system-bus DBUS_BUS_SYSTEM)
     75        ; (starter-bus DBUS_BUS_STARTER) )
    7676; but because that enum is typedef'd, chicken has a problem with it.
    7777
    78 (define-foreign-type dbus:bus int) ; really "DBusBusType"
    79 (define dbus:session-bus (foreign-value DBUS_BUS_SESSION int))
    80 (define dbus:system-bus (foreign-value DBUS_BUS_SYSTEM int))
    81 (define dbus:starter-bus (foreign-value DBUS_BUS_STARTER int))
    82 (define dbus:dbus-service (foreign-value DBUS_SERVICE_DBUS c-string))
    83 (define dbus:known-bus-count (+ 1 (max dbus:session-bus dbus:system-bus dbus:starter-bus)))
    84 
    85 (define-foreign-type dbus:handler-result int) ; really "DBusHandlerResult"
    86 (define dbus:result-handled (foreign-value DBUS_HANDLER_RESULT_HANDLED int))
    87 (define dbus:result-not-yet-handled (foreign-value DBUS_HANDLER_RESULT_NOT_YET_HANDLED int))
    88 (define dbus:result-need-memory (foreign-value DBUS_HANDLER_RESULT_NEED_MEMORY int))
    89 
    90 (define dbus:name-flag-allow-replacement (foreign-value DBUS_NAME_FLAG_ALLOW_REPLACEMENT int))
    91 (define dbus:name-flag-replace-existing (foreign-value DBUS_NAME_FLAG_REPLACE_EXISTING int))
    92 (define dbus:name-flag-do-not-queue (foreign-value DBUS_NAME_FLAG_DO_NOT_QUEUE int))
     78(define-foreign-type bus int) ; really "DBusBusType"
     79(define session-bus (foreign-value DBUS_BUS_SESSION int))
     80(define system-bus (foreign-value DBUS_BUS_SYSTEM int))
     81(define starter-bus (foreign-value DBUS_BUS_STARTER int))
     82(define dbus-service (foreign-value DBUS_SERVICE_DBUS c-string))
     83(define known-bus-count (+ 1 (max session-bus system-bus starter-bus)))
     84
     85(define-foreign-type handler-result int) ; really "DBusHandlerResult"
     86(define result-handled (foreign-value DBUS_HANDLER_RESULT_HANDLED int))
     87(define result-not-yet-handled (foreign-value DBUS_HANDLER_RESULT_NOT_YET_HANDLED int))
     88(define result-need-memory (foreign-value DBUS_HANDLER_RESULT_NEED_MEMORY int))
     89
     90(define name-flag-allow-replacement (foreign-value DBUS_NAME_FLAG_ALLOW_REPLACEMENT int))
     91(define name-flag-replace-existing (foreign-value DBUS_NAME_FLAG_REPLACE_EXISTING int))
     92(define name-flag-do-not-queue (foreign-value DBUS_NAME_FLAG_DO_NOT_QUEUE int))
    9393
    9494;; DBus simple data types
    95 (define dbus:type-invalid (foreign-value DBUS_TYPE_INVALID int))
    96 (define dbus:type-invalid-string (foreign-value DBUS_TYPE_INVALID_AS_STRING int))
    97 (define dbus:type-byte  (foreign-value DBUS_TYPE_BYTE int))
    98 (define dbus:type-byte-string  (foreign-value DBUS_TYPE_BYTE_AS_STRING int))
    99 (define dbus:type-boolean  (foreign-value DBUS_TYPE_BOOLEAN int))
    100 (define dbus:type-boolean-string  (foreign-value DBUS_TYPE_BOOLEAN_AS_STRING int))
    101 (define dbus:type-int16  (foreign-value DBUS_TYPE_INT16 int))
    102 (define dbus:type-int16-string  (foreign-value DBUS_TYPE_INT16_AS_STRING int))
    103 (define dbus:type-uint16  (foreign-value DBUS_TYPE_UINT16 int))
    104 (define dbus:type-uint16-string  (foreign-value DBUS_TYPE_UINT16_AS_STRING int))
    105 (define dbus:type-fixnum (foreign-value DBUS_TYPE_INT32 int))
    106 (define dbus:type-int32  (foreign-value DBUS_TYPE_INT32 int))
    107 (define dbus:type-int32-string  (foreign-value DBUS_TYPE_INT32_AS_STRING int))
    108 (define dbus:type-uint32  (foreign-value DBUS_TYPE_UINT32 int))
    109 (define dbus:type-uint32-string  (foreign-value DBUS_TYPE_UINT32_AS_STRING int))
    110 (define dbus:type-int64  (foreign-value DBUS_TYPE_INT64 int))
    111 (define dbus:type-int64-string  (foreign-value DBUS_TYPE_INT64_AS_STRING int))
    112 (define dbus:type-uint64  (foreign-value DBUS_TYPE_UINT64 int))
    113 (define dbus:type-uint64-string  (foreign-value DBUS_TYPE_UINT64_AS_STRING int))
    114 (define dbus:type-double  (foreign-value DBUS_TYPE_DOUBLE int))
    115 (define dbus:type-flonum  (foreign-value DBUS_TYPE_DOUBLE int))
    116 (define dbus:type-double-string  (foreign-value DBUS_TYPE_DOUBLE_AS_STRING int))
    117 (define dbus:type-string  (foreign-value DBUS_TYPE_STRING int))
    118 (define dbus:type-string-string  (foreign-value DBUS_TYPE_STRING_AS_STRING int))
    119 (define dbus:type-object-path  (foreign-value DBUS_TYPE_OBJECT_PATH int))
    120 (define dbus:type-signature  (foreign-value DBUS_TYPE_SIGNATURE int))
    121 (define dbus:type-signature-string  (foreign-value DBUS_TYPE_SIGNATURE_AS_STRING int))
    122 (define dbus:type-array (foreign-value DBUS_TYPE_ARRAY int))
    123 (define dbus:type-array-string  (foreign-value DBUS_TYPE_ARRAY_AS_STRING int))
    124 (define dbus:type-dict  (foreign-value DBUS_TYPE_DICT_ENTRY int))
    125 (define dbus:type-variant (foreign-value DBUS_TYPE_VARIANT int))
    126 
    127 (define dbus:make-context)
    128 (define dbus:send)
    129 (define dbus:make-method-proxy)
    130 (define dbus:call)
    131 (define dbus:flush)
    132 (define dbus:poll-for-message)
    133 (define dbus:register-signal-handler)
    134 (define dbus:register-method)
    135 (define dbus:register-path)
    136 (define dbus:enable-polling-thread!)
    137 
    138 (define dbus:add-match)
    139 (define dbus:request-name)
     95(define type-invalid (foreign-value DBUS_TYPE_INVALID int))
     96(define type-invalid-string (foreign-value DBUS_TYPE_INVALID_AS_STRING int))
     97(define type-byte  (foreign-value DBUS_TYPE_BYTE int))
     98(define type-byte-string  (foreign-value DBUS_TYPE_BYTE_AS_STRING int))
     99(define type-boolean  (foreign-value DBUS_TYPE_BOOLEAN int))
     100(define type-boolean-string  (foreign-value DBUS_TYPE_BOOLEAN_AS_STRING int))
     101(define type-int16  (foreign-value DBUS_TYPE_INT16 int))
     102(define type-int16-string  (foreign-value DBUS_TYPE_INT16_AS_STRING int))
     103(define type-uint16  (foreign-value DBUS_TYPE_UINT16 int))
     104(define type-uint16-string  (foreign-value DBUS_TYPE_UINT16_AS_STRING int))
     105(define type-fixnum (foreign-value DBUS_TYPE_INT32 int))
     106(define type-int32  (foreign-value DBUS_TYPE_INT32 int))
     107(define type-int32-string  (foreign-value DBUS_TYPE_INT32_AS_STRING int))
     108(define type-uint32  (foreign-value DBUS_TYPE_UINT32 int))
     109(define type-uint32-string  (foreign-value DBUS_TYPE_UINT32_AS_STRING int))
     110(define type-int64  (foreign-value DBUS_TYPE_INT64 int))
     111(define type-int64-string  (foreign-value DBUS_TYPE_INT64_AS_STRING int))
     112(define type-uint64  (foreign-value DBUS_TYPE_UINT64 int))
     113(define type-uint64-string  (foreign-value DBUS_TYPE_UINT64_AS_STRING int))
     114(define type-double  (foreign-value DBUS_TYPE_DOUBLE int))
     115(define type-flonum  (foreign-value DBUS_TYPE_DOUBLE int))
     116(define type-double-string  (foreign-value DBUS_TYPE_DOUBLE_AS_STRING int))
     117(define type-string  (foreign-value DBUS_TYPE_STRING int))
     118(define type-string-string  (foreign-value DBUS_TYPE_STRING_AS_STRING int))
     119(define type-object-path  (foreign-value DBUS_TYPE_OBJECT_PATH int))
     120(define type-signature  (foreign-value DBUS_TYPE_SIGNATURE int))
     121(define type-signature-string  (foreign-value DBUS_TYPE_SIGNATURE_AS_STRING int))
     122(define type-array (foreign-value DBUS_TYPE_ARRAY int))
     123(define type-array-string  (foreign-value DBUS_TYPE_ARRAY_AS_STRING int))
     124(define type-dict  (foreign-value DBUS_TYPE_DICT_ENTRY int))
     125(define type-variant (foreign-value DBUS_TYPE_VARIANT int))
     126
     127(define make-context)
     128(define send)
     129(define make-method-proxy)
     130(define call)
     131(define flush)
     132(define poll-for-message)
     133(define register-signal-handler)
     134(define register-method)
     135(define register-path)
     136(define enable-polling-thread!)
     137
     138(define add-match)
     139(define request-name)
    140140
    141141
     
    149149(define-foreign-type vtable-ptr c-pointer)      ;; DBusObjectPathVTable*
    150150
    151 (define (dbus:discover-services #!key (bus dbus:session-bus))
    152         (let* ([ctxt (dbus:make-context
     151(define (discover-services #!key (bus session-bus))
     152        (let* ([ctxt (make-context
    153153                                        bus: bus
    154154                                        service: 'org.freedesktop.DBus
    155155                                        interface: 'org.freedesktop.DBus
    156156                                        path: '/org/freedesktop/DBus)]
    157                         [services (dbus:call ctxt "ListNames")])
     157                        [services (call ctxt "ListNames")])
    158158                (and (pair? services) (vector? (car services)) (vector->list (car services)))))
    159159
    160 (define dbus:discover-api-xml)
    161 
    162 (define-external (C_msg_cb (dbus:bus bus) (message-ptr msg)) bool
     160(define discover-api-xml)
     161
     162(define-external (C_msg_cb (bus bus) (message-ptr msg)) bool
    163163        (let* ([cb (find-callback bus msg)][found (procedure? cb)])
    164164                ; (printf "got a message: ~s on bus ~a and found callback ~s~%" msg bus cb)
     
    168168        ))
    169169
    170 (let (  [connections '()]       ;; an alist mapping dbus:bus to DBusConnection ptrs
     170(let (  [connections '()]       ;; an alist mapping bus to DBusConnection ptrs
    171171                [error (foreign-value "&err" c-pointer)]
    172172                ;; indices in a "context" vector
     
    178178                [context-count 0]
    179179                [default-polling-interval 0.01]
    180                 [polling-interval (make-vector dbus:known-bus-count 0.01)]
    181                 [polling-enabled (make-vector dbus:known-bus-count #t)]
    182                 [polling-threads (make-vector dbus:known-bus-count #f)]
     180                [polling-interval (make-vector known-bus-count 0.01)]
     181                [polling-enabled (make-vector known-bus-count #t)]
     182                [polling-threads (make-vector known-bus-count #f)]
    183183                ;; will become an assoc tree:
    184184                ;; bus
     
    188188                ;;         method
    189189                ;;           callback-fn
    190                 [callbacks-table `((,dbus:system-bus . #f) (,dbus:session-bus . #f))]
     190                [callbacks-table `((,system-bus . #f) (,session-bus . #f))]
    191191                [iterm (gensym 'terminiter)] )
    192192
     
    270270                                (set! conn (cdr conn))
    271271                                (begin
    272                                         (set! conn ((foreign-lambda connection-ptr "dbus_bus_get" dbus:bus error-ptr)
     272                                        (set! conn ((foreign-lambda connection-ptr "dbus_bus_get" bus error-ptr)
    273273                                                bus-type error) )
    274274                                        (when conn
     
    345345
    346346        ;; val would usually be a single value, but
    347         ;; could be a pair of the form (dbus:type-x . value)
     347        ;; could be a pair of the form (type-x . value)
    348348        ;; in which case we will attempt to convert the value to that type for sending.
    349349        (define (iter-append-basic iter val)
     
    359359                                                ;; do not match parameter-list (a207 a206)
    360360                                                ;; so I guess it has to _be_ a byte before the call
    361                                                 ; [(eq? type dbus:type-byte)
     361                                                ; [(eq? type type-byte)
    362362                                                        ; (iter-append-basic-byte (cdr val))]
    363                                                 ; [(eq? type dbus:type-int16)
     363                                                ; [(eq? type type-int16)
    364364                                                        ; (iter-append-basic-int16 (cdr val))]
    365                                                 ; [(eq? type dbus:type-uint32)
     365                                                ; [(eq? type type-uint32)
    366366                                                        ; (iter-append-basic-uint32 (cdr val))]
    367                                                 ; [(eq? type dbus:type-uint16)
     367                                                ; [(eq? type type-uint16)
    368368                                                        ; (iter-append-basic-uint16 (cdr val))]
    369                                                 ; [(eq? type dbus:type-int64)
     369                                                ; [(eq? type type-int64)
    370370                                                        ; (iter-append-basic-int64 (cdr val))]
    371                                                 ; [(eq? type dbus:type-uint64)
     371                                                ; [(eq? type type-uint64)
    372372                                                        ; (iter-append-basic-uint64 (cdr val))]
    373373                                                ;; other custom requests will be handled as usual, above
     
    381381                                                message-iter-ptr) iter)] )
    382382                        (cond
    383                                 [(memq type `(,dbus:type-string ,dbus:type-invalid-string
    384                                                                 ,dbus:type-string-string ,dbus:type-object-path
    385                                                                 ,dbus:type-signature-string
     383                                [(memq type `(,type-string ,type-invalid-string
     384                                                                ,type-string-string ,type-object-path
     385                                                                ,type-signature-string
    386386                                                                ;; TODO maybe the following types ought to be converted?
    387                                                                 ,dbus:type-byte-string ,dbus:type-boolean-string
    388                                                                 ,dbus:type-int16-string ,dbus:type-uint16-string
    389                                                                 ,dbus:type-int32-string ,dbus:type-uint32-string
    390                                                                 ,dbus:type-int64-string ,dbus:type-uint64-string
    391                                                                 ,dbus:type-double-string ))
     387                                                                ,type-byte-string ,type-boolean-string
     388                                                                ,type-int16-string ,type-uint16-string
     389                                                                ,type-int32-string ,type-uint32-string
     390                                                                ,type-int64-string ,type-uint64-string
     391                                                                ,type-double-string ))
    392392                                        ((foreign-lambda* c-string ((message-iter-ptr iter))
    393393                                                "char* ret;
    394394                                                dbus_message_iter_get_basic(iter, &ret);
    395395                                                C_return (ret);") iter)]
    396                                 [(eq? type dbus:type-boolean)
     396                                [(eq? type type-boolean)
    397397                                        ((foreign-lambda* bool ((message-iter-ptr iter))
    398398                                                "bool ret;
    399399                                                dbus_message_iter_get_basic(iter, &ret);
    400400                                                return (ret);") iter)]
    401                                 [(memq type `(,dbus:type-int32 ,dbus:type-byte
    402                                                                 ,dbus:type-int16 ))
     401                                [(memq type `(,type-int32 ,type-byte
     402                                                                ,type-int16 ))
    403403                                        ((foreign-lambda* int ((message-iter-ptr iter))
    404404                                                "int ret;
    405405                                                dbus_message_iter_get_basic(iter, &ret);
    406406                                                C_return (ret);") iter)]
    407                                 [(memq type `(,dbus:type-uint32 ,dbus:type-uint16))
     407                                [(memq type `(,type-uint32 ,type-uint16))
    408408                                        ((foreign-lambda* unsigned-int ((message-iter-ptr iter))
    409409                                                "unsigned int ret;
    410410                                                dbus_message_iter_get_basic(iter, &ret);
    411411                                                C_return (ret);") iter)]
    412                                 [(memq type `(,dbus:type-flonum ,dbus:type-uint64))
     412                                [(memq type `(,type-flonum ,type-uint64))
    413413                                        ((foreign-lambda* double ((message-iter-ptr iter))
    414414                                                "double ret;
    415415                                                dbus_message_iter_get_basic(iter, &ret);
    416416                                                C_return (ret);") iter)]
    417                                 [(eq? type dbus:type-int64)
     417                                [(eq? type type-int64)
    418418                                        ((foreign-lambda* integer64 ((message-iter-ptr iter))
    419419                                                "int64_t ret;
    420420                                                dbus_message_iter_get_basic(iter, &ret);
    421421                                                C_return (ret);") iter)]
    422                                 [(eq? type dbus:type-array)
     422                                [(eq? type type-array)
    423423                                        (iter->vector (make-sub-iter iter))]
    424                                 [(eq? type dbus:type-dict)
     424                                [(eq? type type-dict)
    425425                                        (iter->pair (make-sub-iter iter))]
    426                                 [(eq? type dbus:type-variant)
     426                                [(eq? type type-variant)
    427427                                        (if (auto-unbox-variants)
    428428                                                ((make-sub-iter iter))
    429429                                                (make-variant ((make-sub-iter iter))))]
    430430                                ;; unsupported so far (not understood well enough):
    431                                 ;;      dbus:type-object-path and dbus:type-signature
    432                                 ;; dbus:type-invalid is returned as #f (could be (void) but that
     431                                ;;      type-object-path and type-signature
     432                                ;; type-invalid is returned as #f (could be (void) but that
    433433                                ;; would be the termination condition for the iterator)
    434434                                [else (make-unsupported-type (integer->char type))] )))
     
    519519                                (tassq callbacks-table bus path iface mber) ))))
    520520
    521         (set! dbus:make-context (lambda (#!key (bus dbus:session-bus) service interface (path "/"))
     521        (set! make-context (lambda (#!key (bus session-bus) service interface (path "/"))
    522522                (vector (next-context-ID) bus (string?->symbol service)
    523523                        (string?->symbol path) (string?->symbol interface)) ))
     
    526526                (foreign-lambda int "dbus_connection_send" connection-ptr message-ptr uint-ptr))
    527527
    528         (set! dbus:send (lambda (context name . params)
     528        (set! send (lambda (context name . params)
    529529                (let* ( [service (symbol?->string (vector-ref context context-idx-service))]
    530530                                [msg (make-signal
     
    542542                        ))))
    543543
    544         (set! dbus:call (lambda (context name . params)
     544        (set! call (lambda (context name . params)
    545545                (let* ( [service (symbol->string (vector-ref context context-idx-service))]
    546546                                [msg (make-message service
     
    569569                                        reply-args)))))
    570570
    571         (set! dbus:make-method-proxy (lambda (context name)
     571        (set! make-method-proxy (lambda (context name)
    572572                (let (  [service (symbol->string (vector-ref context context-idx-service))]
    573573                                [conn (conn-or-abort (vector-ref context context-idx-bus))] )
     
    596596                                                        reply-args))))))
    597597
    598         (define-foreign-record-type (dbus:vtable "struct DBusObjectPathVTable")
    599                 (constructor: dbus:make-vtable-impl)
    600                 (destructor: dbus:free-vtable)
    601                 (c-pointer unregister_function dbus:vtable-unregister_function dbus:vtable-unregister_function-set!)
    602                 (c-pointer message_function dbus:vtable-message_function dbus:vtable-message_function-set!)
    603                 (c-pointer dbus_internal_pad1 dbus:vtable-dbus_internal_pad1)
    604                 (c-pointer dbus_internal_pad2 dbus:vtable-dbus_internal_pad2)
    605                 (c-pointer dbus_internal_pad3 dbus:vtable-dbus_internal_pad3)
    606                 (c-pointer dbus_internal_pad4 dbus:vtable-dbus_internal_pad4))
    607 
    608         (define (dbus:make-vtable cb unreg-cb)
     598        (define-foreign-record-type (vtable "struct DBusObjectPathVTable")
     599                (constructor: make-vtable-impl)
     600                (destructor: free-vtable)
     601                (c-pointer unregister_function vtable-unregister_function vtable-unregister_function-set!)
     602                (c-pointer message_function vtable-message_function vtable-message_function-set!)
     603                (c-pointer dbus_internal_pad1 vtable-dbus_internal_pad1)
     604                (c-pointer dbus_internal_pad2 vtable-dbus_internal_pad2)
     605                (c-pointer dbus_internal_pad3 vtable-dbus_internal_pad3)
     606                (c-pointer dbus_internal_pad4 vtable-dbus_internal_pad4))
     607
     608        (define (make-vtable cb unreg-cb)
    609609                (let ()
    610610                        (define (fn conn msg user-data)
     
    612612                                (let ([ret (cb conn msg user-data)])
    613613                                        ;; TODO: return ret as the result
    614                                         dbus:result-handled ))
    615                         (let ([ret (dbus:make-vtable-impl)])
    616                                 (dbus:vtable-message_function-set! ret fn)
    617                                 (dbus:vtable-unregister_function-set! ret unreg-cb)
     614                                        result-handled ))
     615                        (let ([ret (make-vtable-impl)])
     616                                (vtable-message_function-set! ret fn)
     617                                (vtable-unregister_function-set! ret unreg-cb)
    618618                                ret) ))
    619619
    620         ; (set! dbus:add-match-self (lambda ()
     620        ; (set! add-match-self (lambda ()
    621621                ; ((foreign-safe-lambda void "dbus_bus_add_match" connection-ptr c-string error-ptr)
    622622                        ; (get-conn (vector-ref context context-idx-bus)) rule #f) ))
    623623
    624         (set! dbus:read-write (lambda (conn timeout)
     624        (set! read-write (lambda (conn timeout)
    625625                (let ()
    626626                        ((foreign-safe-lambda bool "dbus_connection_read_write" connection-ptr int)
    627627                                conn timeout))))
    628628
    629         (set! dbus:request-name (lambda (context)
     629        (set! request-name (lambda (context)
    630630                (let ([service-name (symbol?->string (vector-ref context context-idx-service))])
    631631                        (conn-or-abort (vector-ref context context-idx-bus))
     
    634634                                        (get-conn (vector-ref context context-idx-bus))
    635635                                        service-name
    636                                         dbus:name-flag-replace-existing #f) ))))
    637 
    638         (set! dbus:add-match (lambda (context)
     636                                        name-flag-replace-existing #f) ))))
     637
     638        (set! add-match (lambda (context)
    639639                ;; TODO is it always type signal?  We are using this for methods too.
    640640                (let ([rule (format "type='signal', interface='~s'" (vector-ref context context-idx-interface))])
     
    644644
    645645        ;; return #t if it received a message, #f if not
    646         (set! dbus:poll-for-message (lambda (#!key (bus dbus:session-bus) (timeout 0))
     646        (set! poll-for-message (lambda (#!key (bus session-bus) (timeout 0))
    647647                (let ([conn (conn-or-abort bus)])
    648648                        ; (exists-or-abort conn (format "no connection to bus ~s~%" (vector-ref context context-idx-bus)))
    649649                        ((foreign-safe-lambda* bool
    650                                 ((connection-ptr conn) (dbus:bus bus) (int timeout))
     650                                ((connection-ptr conn) (bus bus) (int timeout))
    651651                                "DBusMessage* msg = NULL;
    652652                                dbus_connection_read_write(conn, timeout);
     
    664664
    665665        ;; TODO: one polling thread is necessary for each connection
    666         (define (dbus:start-polling! bus interval)
     666        (define (start-polling! bus interval)
    667667                (vector-set! polling-interval bus interval)
    668668                ; (pretty-print callbacks-table)
     
    672672                                        (let loop ()
    673673                                                ; (printf "polling~%")
    674                                                 (dbus:poll-for-message bus: bus timeout: 0)
     674                                                (poll-for-message bus: bus timeout: 0)
    675675                                                (thread-sleep! (vector-ref polling-interval bus))
    676676                                                (when (vector-ref polling-enabled bus) (loop)))))))))
    677677
    678         (set! dbus:enable-polling-thread! (lambda (#!key (bus dbus:session-bus) (enable #t) (interval default-polling-interval))
     678        (set! enable-polling-thread! (lambda (#!key (bus session-bus) (enable #t) (interval default-polling-interval))
    679679                (vector-set! polling-enabled bus enable)
    680680                (if enable
    681                         (dbus:start-polling! bus interval)
     681                        (start-polling! bus interval)
    682682                        (let ([th (vector-ref polling-threads bus)])
    683683                                (when th (thread-join! th))))))
     
    710710
    711711        ;; msg-cb: the handler implementation.  Its return value is ignored.
    712         (set! dbus:register-signal-handler (lambda (context name msg-cb)
    713                 (dbus:request-name context)
    714                 (dbus:add-match context)
     712        (set! register-signal-handler (lambda (context name msg-cb)
     713                (request-name context)
     714                (add-match context)
    715715                (tasset! callbacks-table
    716716                        (handler-wrapper (conn-or-abort (vector-ref context context-idx-bus)) msg-cb)
     
    719719                        (vector-ref context context-idx-interface)
    720720                        (string?->symbol name))
    721                 (dbus:start-polling! (vector-ref context context-idx-bus) default-polling-interval)
     721                (start-polling! (vector-ref context context-idx-bus) default-polling-interval)
    722722        ))
    723723
    724724        ;; msg-cb: the method implementation.  Its return value is sent back as the response.
    725         (set! dbus:register-method (lambda (context name msg-cb)
    726                 (dbus:request-name context)
    727                 ; (dbus:add-match context)      doesn't seem to be necessary
     725        (set! register-method (lambda (context name msg-cb)
     726                (request-name context)
     727                ; (add-match context)   doesn't seem to be necessary
    728728                (tasset! callbacks-table
    729729                        (method-wrapper (conn-or-abort (vector-ref context context-idx-bus)) msg-cb)
     
    733733                        (vector-ref context context-idx-interface)
    734734                        (string?->symbol name))
    735                 (dbus:start-polling! (vector-ref context context-idx-bus) default-polling-interval)
     735                (start-polling! (vector-ref context context-idx-bus) default-polling-interval)
    736736        ))
    737737
     
    740740                                                                                                                ; const DBusObjectPathVTable  *vtable,
    741741                                                                                                                ; void                        *user_data);
    742         (set! dbus:register-path (lambda (bus path fn unreg-fn)
     742        (set! register-path (lambda (bus path fn unreg-fn)
    743743                ; (let ([unreg-fn (lambda (parm . rest) #f)])
    744744                ((foreign-safe-lambda bool "dbus_connection_register_object_path"
     
    746746                        (conn-or-abort bus)
    747747                        (symbol?->string path)
    748                         (dbus:make-vtable fn unreg-fn) #f)))
    749 
    750         (set! dbus:discover-api-xml (lambda (ctxt)
     748                        (make-vtable fn unreg-fn) #f)))
     749
     750        (set! discover-api-xml (lambda (ctxt)
    751751                (let ([ctxt (list->vector (vector->list ctxt))])        ;; todo: efficiency?
    752752                        (vector-set! ctxt context-idx-interface 'org.freedesktop.DBus.Introspectable)
    753                         (let ([xml (dbus:call ctxt "Introspect")])
     753                        (let ([xml (call ctxt "Introspect")])
    754754                                (and (pair? xml) (car xml))))))
    755755
Note: See TracChangeset for help on using the changeset viewer.