Changeset 25905 in project


Ignore:
Timestamp:
02/14/12 21:11:09 (9 years ago)
Author:
ecloud
Message:

Special case: an empty vector seems to be a vector with a null type inside. Also an untested attempt to append variants.

File:
1 edited

Legend:

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

    r25884 r25905  
    22
    33(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
    19                   unsupported-type?
    20                   unsupported-type-signature
    21                   variant?
    22                   variant-data
    23                   make-variant
    24                   auto-unbox-variants)
     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
     19                unsupported-type?
     20                unsupported-type-signature
     21                variant?
     22                variant-data
     23                make-variant
     24                auto-unbox-variants)
    2525        (import scheme chicken extras
    2626                (except foreign foreign-declare)
     
    2929                miscmacros)
    3030        (use srfi-18)
    31 
    3231
    3332#>
     
    4948        (signature unsupported-type-signature))
    5049(define-record-printer (unsupported-type d out)
    51         (fprintf out "#<unsupported-type ~a>" (unsupported-type-signature d)))
     50        (fprintf out "#<unsupported-type ~s>" (unsupported-type-signature d)))
    5251
    5352;; Scheme is a dynamically typed language, so fundamentally we don't
    5453;; have a use for the "variant" concept; but since dbus has a variant type,
    5554;; we need a way of representing one when preparing a message for marshalling.
    56 ;; So, it might as well be symmetric, putting any variant returned from
    57 ;; a dbus call into this type as well.
    5855(define-record-type variant
    5956        (make-variant data)
     
    6663;; By default this feature is turned off, in the interest of having a
    6764;; representation that is the same as you will need to build when
    68 ;; you want to send (marshall) a dbus message.
     65;; you want to send (marshall) a dbus message.  But probably
     66;; you want to turn it on for convenience, if you don't care to know
     67;; about this low-level detail.
    6968(define auto-unbox-variants (make-parameter #f))
    7069
     
    121120(define type-signature-string  (foreign-value DBUS_TYPE_SIGNATURE_AS_STRING int))
    122121(define type-array (foreign-value DBUS_TYPE_ARRAY int))
    123 (define type-array-string  (foreign-value DBUS_TYPE_ARRAY_AS_STRING int))
    124122(define type-dict  (foreign-value DBUS_TYPE_DICT_ENTRY int))
    125123(define type-variant (foreign-value DBUS_TYPE_VARIANT int))
     
    192190
    193191    (define (any->string arg)
    194       (if (string? arg)
    195         arg
    196         (if (eq? (void) arg)
    197           ""
    198           (format "~a" arg)
    199         )))
     192                (if (string? arg)
     193                        arg
     194                        (if (eq? (void) arg)
     195                          ""
     196                          (format "~a" arg))))
    200197
    201198        (define (symbol?->string arg)
     
    341338                        "C_return (dbus_message_iter_append_basic(iter, DBUS_TYPE_UINT64, &v));"))
    342339
     340        ;; todo efficient
     341        (define (char->string ch) (format "~a" ch))
     342
     343        (define (value-signature val)
     344                (cond
     345                        [(fixnum? val) (char->string type-fixnum)]
     346                        [(flonum? val) (char->string type-flonum)]
     347                        [(boolean? val) (char->string type-boolean)]
     348                        [(variant? val) (value-signature (variant-data val))]
     349                        ; todo: recursive
     350                        ; [(pair? val)
     351                ))
     352
     353        (define (iter-append-basic-variant iter val)
     354                (let ([signature (value-signature val)])
     355                ; (let ([append-fn #f][signature ""])
     356                        ; (cond
     357                                ; todo signature should be a string; need to handle complex types nested in variants too
     358                                ; [(fixnum? val)
     359                                        ; (set! append-fn iter-append-basic-int)
     360                                        ; (set! signature type-fixnum)]
     361                                ; [(flonum? val)
     362                                        ; (set! append-fn iter-append-basic-double)
     363                                        ; (set! signature type-flonum)]
     364                                ; [(boolean? val)
     365                                        ; (set! append-fn iter-append-basic-bool)
     366                                        ; (set! signature type-boolean)]
     367                                ; [(variant? val)
     368                                        ; (set! append-fn iter-append-basic-variant)
     369                                        ; (set! signature type-variant)] )
     370                                ;; todo: for a list, how would I know the composite signature until having done the append?
     371                                ; [(pair? val)
     372                                        ; (set! append-fn iter-append-basic)
     373                                        ; (set! signature type-variant)] )
     374                        (let ([container ((foreign-lambda* message-iter-ptr ((message-iter-ptr iter) (c-string signature))
     375                                        "DBusMessageIter value;
     376                                        dbus_message_iter_open_container(iter, DBUS_TYPE_VARIANT, signature, &value);
     377                                        C_return(&value);") iter signature)])
     378                                (iter-append-basic container val)
     379                                ((foreign-lambda* bool ((message-iter-ptr iter)(message-iter-ptr container))
     380                                        "C_return (dbus_message_iter_close_container(iter, container));") iter container) ) ))
     381
     382; (foreign-lambda* bool ((message-iter-ptr iter) (integer64 v))
     383                        ; "dbus_message_iter_open_container(iter, DBUS_TYPE_VARIANT, signature, &value);
     384                        ; dbus_message_iter_append_basic(&value, type, val);
     385                        ; C_return (dbus_message_iter_close_container(iter, &value));")
     386
    343387        ;; TODO: iter-append-basic-T for each possible type:
    344388        ;; especially variant, array and struct might still be possible
     
    352396                        [(flonum? val) (iter-append-basic-double iter val)]
    353397                        [(boolean? val) (iter-append-basic-bool iter val)]
     398                        [(variant? val) (iter-append-basic-variant iter val)]
    354399                        [(pair? val)
    355400                                (let ([type (car val)])
     
    380425                (let (  [type ((foreign-lambda int "dbus_message_iter_get_arg_type"
    381426                                                message-iter-ptr) iter)] )
     427                        ; (printf "iter-cond type ~s~%" type)
    382428                        (cond
    383429                                [(memq type `(,type-string ,type-invalid-string
     
    421467                                                C_return (ret);") iter)]
    422468                                [(eq? type type-array)
    423                                         (iter->vector (make-sub-iter iter))]
     469                                        (let ([v  (iter->vector (make-sub-iter iter))])
     470                                                (when (and (vector? v) (eq? 1 (vector-length v)) (unsupported-type? (vector-ref v 0)))
     471                                                        (set! v (make-vector 0)))
     472                                                v)]
    424473                                [(eq? type type-dict)
    425474                                        (iter->pair (make-sub-iter iter))]
Note: See TracChangeset for help on using the changeset viewer.