Changeset 10324 in project


Ignore:
Timestamp:
04/03/08 09:21:03 (12 years ago)
Author:
ecloud
Message:

simplified dbus:poll-for-message and added dbus:enable-polling-thread!

Location:
release/3/dbus/trunk
Files:
2 edited

Legend:

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

    r10318 r10324  
    99        dbus:send
    1010
     11        ; Send (a method call), then block until the reply is received
     12        dbus:send-and-await-reply
     13
    1114        ; Register a callback to handle a particular method
    1215        dbus:register-method
    1316
     17        ; By default, dbus:register-method starts a polling thread
     18        ; if there is not yet one.  Call (dbus:enable-polling-thread #f)
     19        ; to disable it.  If you later call (dbus:enable-polling-thread #f)
     20        ; it will start the polling thread immediately, whether there are
     21        ; any registered methods or not.
     22        dbus:enable-polling-thread!
     23
    1424        ; Manually poll for a new message
    1525        dbus:poll-for-message
    16 
    17         ; Send (a method call), then block until the reply is received
    18         dbus:send-and-await-reply
    1926
    2027        ;=====
     
    122129                [context-idx-interface 4]
    123130                [context-count 0]
     131                [polling-enabled #t]
    124132                [polling-thread #f]
     133                [default-polling-interval 0.01]
    125134                [polling-interval 0.01]
    126135                ;; will become an assoc tree:
     
    512521                                (get-conn (vector-ref context context-idx-bus)) rule #f) )))
    513522
    514         ;; assumption (not verified yet): one polling thread is necessary for each context
    515523        ;; return #t if it received a message, #f if not
    516         (set! dbus:poll-for-message (lambda (context timeout msg-cb)
    517                 ; (printf "poll-for-message given msg-cb ~a; faking it:~%" msg-cb)
    518                 ; (msg-cb #f)
    519                 (let ([conn (get-conn (vector-ref context context-idx-bus))])
     524        (set! dbus:poll-for-message (lambda (#!key (bus dbus:session-bus) (timeout 0))
     525                (let ([conn (get-conn bus)])
    520526                        ((foreign-safe-lambda* bool
    521527                                ((connection-ptr conn) (dbus:bus bus) (int timeout))
     
    527533                                        //printf(\"rcv: %s\\n\", dbus_message_get_interface(msg));
    528534                                        C_msg_cb(bus, msg);
    529                                         /*
    530                                         {
    531                                                 DBusMessage* reply = dbus_message_new_method_return(msg);
    532                                                 //DBusMessageIter args;
    533                                                 dbus_uint32_t serial = 0;
    534                                                 //printf(\"cb happened; notifying that the message was received and accepted\\n\");
    535                                                 //dbus_message_iter_init_append(reply, &args);
    536                                                 // Actuall this is out-of-order, because C_msg_cb (indirectly)
    537                                                 // sends the _real_ reply
    538                                                 dbus_connection_send(conn, reply, &serial);
    539                                                 dbus_message_unref(reply);
    540                                         }
    541                                         */
    542535                                        dbus_message_unref(msg);
    543536                                        C_return(true);         // yes there was a message
    544537                                }
    545538                                C_return (false);               // we polled, we came back empty-handed
    546                                 ") conn (vector-ref context context-idx-bus) timeout)
     539                                ") conn bus timeout)
    547540                )))
    548541
    549         (define (dbus:start-polling! context name msg-cb)
    550                 (tasset! callbacks-table msg-cb
    551                         (vector-ref context context-idx-bus)
    552                         (vector-ref context context-idx-path)
    553                         (vector-ref context context-idx-service)
    554                         (vector-ref context context-idx-interface)
    555                         (string?->symbol name))
     542        (set! dbus:enable-polling-thread! (lambda (#!key (bus dbus:session-bus) (enable #t) (interval default-polling-interval))
     543                (set! polling-enabled enable)
     544                (if enable
     545                        (dbus:start-polling! bus interval)
     546                        (when polling-thread (thread-join! polling-thread)))))
     547
     548
     549        ;; TODO: one polling thread is necessary for each connection
     550        (define (dbus:start-polling! bus interval)
     551                (set! polling-interval interval)
    556552                ; (pretty-print callbacks-table)
    557                 (unless polling-thread
    558                         (set! polling-thread (thread-start! (lambda ()
    559                                 (let loop ()
    560                                         ; (printf "polling~%")
    561                                         (dbus:poll-for-message context 0 msg-cb)
    562                                         (thread-sleep! polling-interval)
    563                                         (loop)))))))
     553                (when polling-enabled
     554                        (unless polling-thread
     555                                (set! polling-thread (thread-start! (lambda ()
     556                                        (let loop ()
     557                                                ; (printf "polling~%")
     558                                                (dbus:poll-for-message bus: bus timeout: 0)
     559                                                (thread-sleep! polling-interval)
     560                                                (when polling-enabled (loop)))))))))
    564561
    565562        ;; Wraps a user-provided callback so as to pass it the
    566563        ;; received dbus message's parameters, and return a dbus response
    567564        ;; with the parameter(s) returned from the callback.
     565        ;; msg-cb is the user-provided one.
    568566        (define (callback-wrapper conn msg-cb)
    569567                (lambda (msg)
     
    583581                                        ))))
    584582
    585         ;; fn: the method implementation.  Its return value is sent back as the response. (todo)
    586         (set! dbus:register-method (lambda (context name fn)
     583        ;; msg-cb: the method implementation.  Its return value is sent back as the response.
     584        (set! dbus:register-method (lambda (context name msg-cb)
    587585                (dbus:request-name context)
    588586                (dbus:add-match context)
    589                 (dbus:start-polling! context name
    590                         (callback-wrapper (get-conn (vector-ref context context-idx-bus)) fn))
     587                (tasset! callbacks-table
     588                        (callback-wrapper (get-conn (vector-ref context context-idx-bus)) msg-cb)
     589                        (vector-ref context context-idx-bus)
     590                        (vector-ref context context-idx-path)
     591                        (vector-ref context context-idx-service)
     592                        (vector-ref context context-idx-interface)
     593                        (string?->symbol name))
     594                (dbus:start-polling! (vector-ref context context-idx-bus) default-polling-interval)
    591595        ))
    592596
     
    602606                        (symbol?->string path)
    603607                        (dbus:make-vtable fn unreg-fn) #f)))
    604 
    605 
    606608)
  • release/3/dbus/trunk/test/receive-car-turn.scm

    r10099 r10324  
    55
    66(define rc-car-context (dbus:make-context
    7         bus: dbus:session-bus   ;; would be the session-bus by default anyway
     7        ; bus: dbus:session-bus         ;; would be the session-bus by default anyway
    88        service: 'com.trolltech.CarExample
    99        path: '/Car
    1010        interface: 'com.trolltech.Examples.CarInterface ))
    1111
     12(dbus:enable-polling-thread!
     13        ; bus: dbus:session-bus         ;; would be the session-bus by default anyway
     14        enable: #f)
     15
    1216(dbus:register-method rc-car-context "turnRight" turn-right)
    1317(dbus:register-method rc-car-context "turnLeft" turn-left)
    1418
    15 ; (let loop ()
     19(let loop ()
    1620        ; (printf "poll~%")
    17         ; (dbus:poll-for-message rc-car-context 0 (lambda (msg) (printf "got a message!~%")))
    18         ; (loop))
     21        ; (dbus:poll-for-message bus: dbus:session-bus) ;; would be the session-bus by default anyway
     22        (dbus:poll-for-message)
     23        (loop))
Note: See TracChangeset for help on using the changeset viewer.