
;; Copyright (C) 2026 Tommi Höynälänmaa

;; Distributed under GNU Lesser General Public License.


(define-body (theme-d-intr dbus wrappers)


  (import (standard-library list-utilities)
          (standard-library string-utilities)
          (standard-library object-string-conversion)
          (standard-library text-file-io)
          (theme-d-intr base utils)
          (theme-d-intr dbus connection))


  (define-simple-method generate-arg-names
      (((l-indices (:uniform-list <integer>))) (:uniform-list <symbol>) pure)
    (map1 (lambda (((i <integer>)) <symbol> pure)
            (string->symbol (string-append "arg" (integer->string i))))
          l-indices))


  ;; (define-simple-method my-array->list
  ;;     (((x-array <g-variant>)) (:uniform-list <integer>) nonpure)
  ;;   (let-mutable ((l-result (:uniform-list <integer>) null))
  ;;     (let ((i-elements (g-variant-n-children x-array)))
  ;;       (do ((i <integer> 0 (+ i 1))) ((>= i i-elements))
  ;;         (let* ((vnt-child (g-variant-get-child-value x-array i ))
  ;;                (i-cur (g-variant-get-int64 vnt-child)))
  ;;           (set! l-result (append-uniform2 l-result (cons i-cur null))))))
  ;;     l-result))
    
  
  (declare-simple-method gen-arg-wrapper
    (<dbus-type-repr> <symbol>)
    <source-expr> pure)
  
  
  (define-simple-method gen-struct-arg-wrapper
      (((l-components (:uniform-list <dbus-type-repr>))
        (s-arg-name <symbol>))
       <source-expr> pure)
    (if (null? l-components)
        '(g-variant-new-tuple null)
        (let* ((l-indices (get-integer-sequence 0 (length l-components)))
               (l-comp-arg-names (generate-arg-names l-indices))
               (l-let-vars
                (map2 (lambda (((i <integer>) (s-comp-name <symbol>))
                               <source-expr> pure)
                        `(,s-comp-name (tuple-ref ,s-arg-name ,i)))
                      l-indices l-comp-arg-names))
               (l-child-construction
                (map2 (lambda (((x-repr-component <dbus-type-repr>)
                                (s-comp-name <symbol>))
                               <source-expr> pure)
                        (gen-arg-wrapper x-repr-component s-comp-name))
                      l-components l-comp-arg-names))
               (sx-result
                `(let ,l-let-vars
                   (g-variant-new-tuple (list ,@l-child-construction)))))
          sx-result)))
    

  (define-simple-method gen-array-arg-wrapper
      (((x-component-type <dbus-type-repr>)
        (s-arg-name <symbol>))
       <source-expr> pure)
    (let ((str-type (dbus-repr->type x-component-type))
          (x-theme-d-type (dbus-repr->theme-d x-component-type)))
      `(let* ((l-construction
               (map-nonpure1
                (lambda (((x-component ,x-theme-d-type)) <g-variant> nonpure)
                  ,(gen-arg-wrapper x-component-type 'x-component))
                ,s-arg-name))
              (sx-result
               (g-variant-new-array
                (g-variant-type-new ,str-type)
                l-construction)))
         sx-result)))
  
  
  (define-simple-method gen-dict-entry-arg-wrapper
      (((sx-key <dbus-basic-type-repr>)
        (sx-value <dbus-type-repr>)
        (s-arg-name <symbol>))
       <source-expr> pure)
    (let* ((sx-let-var1 `(key (car ,s-arg-name)))
           (sx-let-var2 `(value (cdr ,s-arg-name)))
           (sx-ctr1 (gen-arg-wrapper sx-key 'key))
           (sx-ctr2 (gen-arg-wrapper sx-value 'value))
           (sx-result
            `(let (,sx-let-var1 ,sx-let-var2)
               (g-variant-new-dict-entry ,sx-ctr1 ,sx-ctr2))))
      sx-result))


  (define-simple-method gen-arg-wrapper
      (((x-repr <dbus-type-repr>) (s-arg-name <symbol>)) <source-expr> pure)
    (match-type x-repr
      (((:singleton-type 'byte)) `(g-variant-new-byte ,s-arg-name))
      (((:singleton-type 'boolean)) `(g-variant-new-boolean ,s-arg-name))
      (((:singleton-type 'int16)) `(g-variant-new-int16 ,s-arg-name))
      (((:singleton-type 'uint16)) `(g-variant-new-uint16 ,s-arg-name))
      (((:singleton-type 'int32)) `(g-variant-new-int32 ,s-arg-name))
      (((:singleton-type 'uint32)) `(g-variant-new-uint32 ,s-arg-name))
      (((:singleton-type 'int64)) `(g-variant-new-int64 ,s-arg-name))
      (((:singleton-type 'uint64)) `(g-variant-new-uint64 ,s-arg-name))
      (((:singleton-type 'double)) `(g-variant-new-double ,s-arg-name))
      (((:singleton-type 'unix-fd)) `(g-variant-new-handle ,s-arg-name))
      (((:singleton-type 'string)) `(g-variant-new-string ,s-arg-name))
      (((:singleton-type 'object-path)) `(g-variant-new-object-path ,s-arg-name))
      (((:singleton-type 'signature)) `(g-variant-new-signature ,s-arg-name))
      (((:singleton-type 'variant)) `(g-variant-new-variant ,s-arg-name))
      ((l1 (:pair (:singleton-type 'struct) (:uniform-list <dbus-type-repr>)))
       (gen-struct-arg-wrapper (cdr l1) s-arg-name))
      ((l2 (:tuple (:singleton-type 'array) <dbus-type-repr>))
       (gen-array-arg-wrapper (cadr l2) s-arg-name))
      ((l3 (:tuple
            (:singleton-type 'dict-entry)
            <dbus-basic-type-repr>
            <dbus-type-repr>))
       (gen-dict-entry-arg-wrapper (cadr l3) (caddr l3) s-arg-name))))
  

  (declare-simple-method gen-result-wrapper
    (<dbus-type-repr> <symbol>)
    <source-expr> pure)


  (define-simple-method gen-struct-result-wrapper
      (((l-components (:uniform-list <dbus-type-repr>))
        (s-var-name <symbol>))
       <source-expr> pure)
    (if (null? l-components)
        'null
        (let* ((l-indices (get-integer-sequence 0 (length l-components)))
               (l-wrap-components
                (map1 (lambda (((i <integer>)) <source-expr> pure)
                        `(let ((sx-value
                                (g-variant-get-child-value ,s-var-name ,i)))
                           ,(gen-result-wrapper (uniform-list-ref l-components i)
                                                'sx-value)))
                      l-indices))
               (sx-result (cons 'list l-wrap-components)))
          sx-result)))
  

  (define-simple-method gen-array-result-wrapper
      (((x-component-type <dbus-type-repr>) (s-var-name <symbol>))
       <source-expr> pure)
    (let ((x-theme-d-type (dbus-repr->theme-d x-component-type)))
      `(let* ((i-len (g-variant-n-children ,s-var-name))
              (l-indices (get-integer-sequence 0 i-len))
              (l-result
               (map-nonpure1
                (lambda (((i-child <integer>)) ,x-theme-d-type nonpure)
                  (let ((sx-value
                         (g-variant-get-child-value ,s-var-name i-child)))
                    ,(gen-result-wrapper x-component-type 'sx-value)))
                l-indices)))
         l-result)))

  
  (define-simple-method gen-dict-entry-result-wrapper
      (((sx-key <dbus-basic-type-repr>)
        (sx-value <dbus-type-repr>)
        (s-var-name <symbol>))
       <source-expr> pure)
    (let* ((sx-get-key
            `(let ((key (g-variant-get-child-value ,s-var-name 0)))
               ,(gen-result-wrapper sx-key 'key)))
           (sx-get-value
            `(let ((value (g-variant-get-child-value ,s-var-name 1)))
               ,(gen-result-wrapper sx-value 'value)))
           (sx-result (list 'cons sx-get-key sx-get-value)))
      sx-result))


  (define-simple-method gen-result-wrapper
      (((x-repr <dbus-type-repr>) (s-var-name <symbol>)) <source-expr> pure)
    (match-type x-repr
      (((:singleton-type 'byte)) `(g-variant-get-byte ,s-var-name))
      (((:singleton-type 'boolean)) `(g-variant-get-boolean ,s-var-name))
      (((:singleton-type 'int16)) `(g-variant-get-int16 ,s-var-name))
      (((:singleton-type 'uint16)) `(g-variant-get-uint16 ,s-var-name))
      (((:singleton-type 'int32)) `(g-variant-get-int32 ,s-var-name))
      (((:singleton-type 'uint32)) `(g-variant-get-uint32 ,s-var-name))
      (((:singleton-type 'int64)) `(g-variant-get-int64 ,s-var-name))
      (((:singleton-type 'uint64)) `(g-variant-get-uint64 ,s-var-name))
      (((:singleton-type 'double)) `(g-variant-get-double ,s-var-name))
      (((:singleton-type 'unix-fd)) `(g-variant-get-handle ,s-var-name))
      (((:singleton-type 'string)) `(g-variant-get-string1 ,s-var-name))
      (((:singleton-type 'object-path)) `(g-variant-get-object-path ,s-var-name))
      (((:singleton-type 'signature)) `(g-variant-get-signature ,s-var-name))
      (((:singleton-type 'variant)) `(g-variant-get-variant ,s-var-name))
      ((l1 (:pair (:singleton-type 'struct) (:uniform-list <dbus-type-repr>)))
       (gen-struct-result-wrapper (cdr l1) s-var-name))
      ((l2 (:tuple (:singleton-type 'array) <dbus-type-repr>))
       (gen-array-result-wrapper (cadr l2) s-var-name))
      ((l3 (:tuple
            (:singleton-type 'dict-entry)
            <dbus-basic-type-repr>
            <dbus-type-repr>))
       (gen-dict-entry-result-wrapper (cadr l3) (caddr l3) s-var-name))))


  (define-simple-method compute-method-name
      (((str-interface <string>)
        (str-method <string>)
        (sync? <boolean>)
        (short? <boolean>))
       <symbol> pure)
    (let ((str-async (if sync? "" "async:"))
          (str-interface2
           (if short?
               ""
               (string-append (replace-char str-interface #\. #\_) ":"))))
      (string->symbol
       (string-append
        str-interface2
        str-async
        str-method))))


  (define-simple-method compute-signal-sub-name
      (((str-interface <string>)
        (str-signal <string>)
        (short? <boolean>))
       <symbol> pure)
    (let ((str-interface2
           (if short?
               ""
               (string-append (replace-char str-interface #\. #\_) ":"))))
      (string->symbol
       (string-append
        str-interface2
        "subscribe:"
        str-signal))))


  (define-simple-method compute-property-get-name
      (((str-interface <string>)
        (str-property <string>)
        (short? <boolean>))
       <symbol> pure)
    (let ((str-interface2
           (if short?
               ""
               (string-append (replace-char str-interface #\. #\_) ":"))))
      (string->symbol
       (string-append
        str-interface2
        "get:"
        str-property))))


  (define-simple-method compute-property-set-name
      (((str-interface <string>)
        (str-property <string>)
        (short? <boolean>))
       <symbol> pure)
    (let ((str-interface2
           (if short?
               ""
               (string-append (replace-char str-interface #\. #\_) ":"))))
      (string->symbol
       (string-append
        str-interface2
        "set:"
        str-property))))


  (define-simple-method gen-sync-method-wrapper
      (((str-interface <string>)
        (str-method <string>)
        (s-method-name <symbol>)
        (l-arg-types (:uniform-list <dbus-type-repr>))
        (l-result-types (:uniform-list <dbus-type-repr>)))
       <source-expr> pure)
    (let* ((i-nr-arg-types (length l-arg-types))
           (i-nr-result-types (length l-result-types))
           (x-arg-type-list
            (cons (singleton-type-dispatch 'struct) l-arg-types))
           (x-result-type-list
            (cons (singleton-type-dispatch 'struct) l-result-types))
           (l-sx-theme-d-arg-types
            (map1 dbus-repr->theme-d l-arg-types))
           (l-sx-theme-d-result-types
            (map1 dbus-repr->theme-d l-result-types))
           (str-result-type
            (dbus-repr->type x-result-type-list))
           (l-sx-args
            (if (equal? i-nr-arg-types 0)
                '()
                `((l-args (:tuple ,@l-sx-theme-d-arg-types)))))
           (sx-arg-wrapper (gen-arg-wrapper x-arg-type-list 'l-args))
           (sx-result-type
            (case i-nr-result-types
              ((0) '<none>)
              ((1) (uniform-list-ref l-sx-theme-d-result-types 0))
              (else (cons ':tuple l-sx-theme-d-result-types))))
           (sx-header
            `(((conn <g-dbus-connection>)
               (str-bus-name <string>)
               (str-object-path <string>)
               (flags <g-dbus-call-flags>)
               (i-timeout <integer>)
               (cancellable (:alt-maybe <g-cancellable>))
               ,@l-sx-args)
              ,sx-result-type
              nonpure))
           (l-sx-results
            (case i-nr-result-types
              ((0) null)
              ((1)
               `((vnt-result (g-variant-get-child-value vnt-results 0))
                 (x-result
                  ,(gen-result-wrapper
                    (uniform-list-ref l-result-types 0)
                    'vnt-result))))
              (else
               `((x-result
                  ,(gen-result-wrapper x-result-type-list 'vnt-results))))))
           (sx-call
            `(g-dbus-connection-call-sync
              conn
              str-bus-name
              str-object-path
              ,str-interface
              ,str-method
              vnt-args
              (g-variant-type-new ,str-result-type)
              flags
              i-timeout
              cancellable)))
      (if (> i-nr-result-types 0)
          `(define-simple-method ,s-method-name
               ,sx-header
             (let* ((vnt-args ,sx-arg-wrapper)
                    (vnt-results ,sx-call)
                    ,@l-sx-results)
               x-result))
          `(define-simple-method ,s-method-name
               ,sx-header
             (let ((vnt-args ,sx-arg-wrapper))
               ,sx-call)))))


  (define-simple-method gen-async-method-wrapper
      (((str-interface <string>)
        (str-method <string>)
        (s-method-name <symbol>)
        (l-arg-types (:uniform-list <dbus-type-repr>))
        (l-result-types (:uniform-list <dbus-type-repr>)))
       <source-expr> pure)
    (let* ((i-nr-arg-types (length l-arg-types))
           (i-nr-result-types (length l-result-types))
           (x-arg-type-list
            (cons (singleton-type-dispatch 'struct) l-arg-types))
           (x-result-type-list
            (cons (singleton-type-dispatch 'struct) l-result-types))
           (l-sx-theme-d-arg-types
            (map1 dbus-repr->theme-d l-arg-types))
           (l-sx-theme-d-result-types
            (map1 dbus-repr->theme-d l-result-types))
           (str-result-type
            (dbus-repr->type x-result-type-list))
           (l-sx-args
            (if (equal? i-nr-arg-types 0)
                '()
                `((l-args (:tuple ,@l-sx-theme-d-arg-types)))))
           (sx-arg-wrapper (gen-arg-wrapper x-arg-type-list 'l-args))
           (sx-result-type
            (case i-nr-result-types
              ((0) '<none>)
              ((1) (uniform-list-ref l-sx-theme-d-result-types 0))
              (else (cons ':tuple l-sx-theme-d-result-types))))
           (sx-callback-type
            (if (> i-nr-result-types 0)
               `(:procedure ((:alt-maybe <gobject>) ,sx-result-type <object>)
                            <none> nonpure)
               '(:procedure ((:alt-maybe <gobject>) <object>) <none> nonpure)))
           (l-sx-callback-arg
            `((proc-result (:alt-maybe ,sx-callback-type))))
           (sx-header
            `(((conn <g-dbus-connection>)
               (str-bus-name <string>)
               (str-object-path <string>)
               (flags <g-dbus-call-flags>)
               (i-timeout <integer>)
               (cancellable (:alt-maybe <g-cancellable>))
               ,@l-sx-callback-arg
               ,@l-sx-args)
              <none>
              nonpure))
           (l-sx-results
            (case i-nr-result-types
              ((0) null)
              ((1)
               `((vnt-result (g-variant-get-child-value vnt-results 0))
                 (x-result
                  ,(gen-result-wrapper
                    (uniform-list-ref l-result-types 0)
                    'vnt-result))))
              (else
               `((x-result
                  ,(gen-result-wrapper x-result-type-list 'vnt-results))))))
           (sx-proc-body
            (if (> i-nr-result-types 0)
                `(let* ((connection (cast <g-dbus-connection> arg1))
                        (vnt-results
                         (g-dbus-connection-call-finish connection arg2))
                        ,@l-sx-results)
                   (match-type proc-result
                     ((<boolean>)
                      #f)
                     ((proc-result1 ,sx-callback-type)
                      (proc-result1 arg1 x-result arg3))))
                `(let ((connection (cast <g-dbus-connection> arg1)))
                   (g-dbus-connection-call-finish connection arg2)
                   (match-type proc-result
                     ((<boolean>)
                      #f)
                     ((proc-result1 ,sx-callback-type)
                      (proc-result1 arg1 arg3))))))
           (sx-proc-result0
            `(lambda (((arg1 (:alt-maybe <gobject>))
                       (arg2 <g-async-result>)
                       (arg3 <object>))
                      <none>
                      nonpure)
               ,sx-proc-body))
           (sx-call
            `(g-dbus-connection-call
              conn
              str-bus-name
              str-object-path
              ,str-interface
              ,str-method
              vnt-args
              (g-variant-type-new ,str-result-type)
              flags
              i-timeout
              cancellable
              proc-result0
              #f)))
      `(define-simple-method ,s-method-name
           ,sx-header
         (let ((vnt-args ,sx-arg-wrapper)
               (proc-result0 ,sx-proc-result0))
           ,sx-call))))


  (define-simple-method gen-sync-method-declaration
      (((s-method-name <symbol>)
        (l-arg-types (:uniform-list <dbus-type-repr>))
        (l-result-types (:uniform-list <dbus-type-repr>)))
       <source-expr> pure)
    (let* ((i-nr-arg-types (length l-arg-types))
           (i-nr-result-types (length l-result-types))
           (l-sx-theme-d-arg-types
            (map1 dbus-repr->theme-d l-arg-types))
           (l-sx-theme-d-result-types
            (map1 dbus-repr->theme-d l-result-types))
           (l-sx-args
            (if (equal? i-nr-arg-types 0)
                '()
                `((:tuple ,@l-sx-theme-d-arg-types))))
           (sx-result-type
            (case i-nr-result-types
              ((0) '<none>)
              ((1) (uniform-list-ref l-sx-theme-d-result-types 0))
              (else (cons ':tuple l-sx-theme-d-result-types))))
           (l-sx-header
            `((<g-dbus-connection>
               <string>
               <string>
               <g-dbus-call-flags>
               <integer>
               (:alt-maybe <g-cancellable>)
               ,@l-sx-args)
              ,sx-result-type
              nonpure)))
      `(declare-simple-method ,s-method-name ,@l-sx-header)))


  (define-simple-method gen-async-method-declaration
      (((s-method-name <symbol>)
        (l-arg-types (:uniform-list <dbus-type-repr>))
        (l-result-types (:uniform-list <dbus-type-repr>)))
       <source-expr> pure)
    (let* ((i-nr-arg-types (length l-arg-types))
           (i-nr-result-types (length l-result-types))
           (l-sx-theme-d-arg-types
            (map1 dbus-repr->theme-d l-arg-types))
           (l-sx-theme-d-result-types
            (map1 dbus-repr->theme-d l-result-types))
           (l-sx-args
            (if (equal? i-nr-arg-types 0)
                '()
                `((:tuple ,@l-sx-theme-d-arg-types))))
           (sx-result-type
            (case i-nr-result-types
              ((0) '<none>)
              ((1) (uniform-list-ref l-sx-theme-d-result-types 0))
              (else (cons ':tuple l-sx-theme-d-result-types))))
           (sx-callback-type
            (if (> i-nr-result-types 0)
                `(:procedure ((:alt-maybe <gobject>) ,sx-result-type <object>)
                             <none> nonpure)
                '(:procedure ((:alt-maybe <gobject>) <object>) <none> nonpure)))
           (l-sx-callback-arg
            `((:alt-maybe ,sx-callback-type)))
           (l-sx-header
            `((<g-dbus-connection>
               <string>
               <string>
               <g-dbus-call-flags>
               <integer>
               (:alt-maybe <g-cancellable>)
               ,@l-sx-callback-arg
               ,@l-sx-args)
              <none>
               nonpure)))
      `(declare-simple-method ,s-method-name ,@l-sx-header)))


  (define-simple-method gen-signal-sub-wrapper
      (((str-interface <string>)
        (str-signal <string>)
        (s-signal-sub-name <symbol>)
        (l-arg-types (:uniform-list <dbus-type-repr>)))
       <source-expr> pure)
    (let* ((i-nr-arg-types (length l-arg-types))
           (l-sx-theme-d-arg-types
            (map1 dbus-repr->theme-d l-arg-types))
           (l-sx-args
            (static-cast <source-expr-list>
                         (if (equal? i-nr-arg-types 0)
                             '()
                             `((:tuple ,@l-sx-theme-d-arg-types)))))
           (sx-callback-type
            `(:procedure (<g-dbus-connection>
                          (:alt-maybe <string>)
                          <string>
                          <string>
                          <string>
                          ,@l-sx-args
                          <object>)
                         <none> nonpure))
           (x-arg-type-list
            (cons (singleton-type-dispatch 'struct) l-arg-types))
           (sx-header
            `(((conn <g-dbus-connection>)
               (str-bus-name <string>)
               (str-object-path <string>)
               (str-arg0 (:alt-maybe <string>))
               (flags <g-dbus-signal-flags>)
               (proc-callback ,sx-callback-type)
               (x-user-data <object>)
               (proc-user-data-free (:alt-maybe <g-lib-destroy-notify>)))
              <integer>
              nonpure))
           (l-sx-parsed-args
            (static-cast <source-expr-list>
                         (if (null? l-arg-types)
                             null
                             (list (gen-result-wrapper x-arg-type-list 'vnt-params))))))
      `(define-simple-method ,s-signal-sub-name
           ,sx-header
         (let ((proc-callback0
                (lambda
                  (((conn0 <g-dbus-connection>)
                    (str-sender-name0 (:alt-maybe <string>))
                    (str-object-path0 <string>)
                    (str-interface0 <string>)
                    (str-signal0 <string>)
                    (vnt-params <g-variant>)
                    (x-user-data0 <object>))
                   <none> nonpure)
                  (proc-callback
                   conn0
                   str-sender-name0
                   str-object-path0
                   str-interface0
                   str-signal0
                   ,@l-sx-parsed-args
                   x-user-data0))))
           (g-dbus-connection-signal-subscribe
            conn
            str-bus-name
            ,str-interface
            ,str-signal
            str-object-path
            str-arg0
            flags
            proc-callback0
            x-user-data
            proc-user-data-free)))))
  

  (define-simple-method gen-signal-sub-declaration
      (((s-method-name <symbol>)
        (l-arg-types (:uniform-list <dbus-type-repr>)))
       <source-expr> pure)
    (let* ((i-nr-arg-types (length l-arg-types))
           (l-sx-theme-d-arg-types
            (map1 dbus-repr->theme-d l-arg-types))
           (l-sx-args
            (static-cast <source-expr-list>
                         (if (equal? i-nr-arg-types 0)
                             '()
                             `((:tuple ,@l-sx-theme-d-arg-types)))))
           (sx-callback-type
            `(:procedure (<g-dbus-connection>
                          (:alt-maybe <string>)
                          <string>
                          <string>
                          <string>
                          ,@l-sx-args
                          <object>)
                         <none>
                         nonpure))
           (l-sx-header
            `((<g-dbus-connection>
               <string>
               <string>
               (:alt-maybe <string>)
               <g-dbus-signal-flags>
               ,sx-callback-type
               <object>
               (:alt-maybe <g-lib-destroy-notify>))
              <integer>
              nonpure)))
      `(declare-simple-method ,s-method-name ,@l-sx-header)))


  (define-simple-method gen-property-get-wrapper
      (((str-intf-name <string>)
        (str-property-name <string>)
        (s-method-name <symbol>)
        (sx-type <dbus-type-repr>))
       <source-expr> pure)
    (let* ((sx-theme-d-type (dbus-repr->theme-d sx-type))
           (sx-header
            `(((conn <g-dbus-connection>)
               (str-bus-name <string>)
               (str-object-path <string>)
               (flags <g-dbus-call-flags>)
               (i-timeout <integer>)
               (cancellable (:alt-maybe <g-cancellable>)))
              ,sx-theme-d-type
               nonpure)))    
      `(define-simple-method ,s-method-name ,sx-header
         (let* ((vnt-args
                 (g-variant-new-tuple
                  (list
                   (g-variant-new-string ,str-intf-name)
                   (g-variant-new-string ,str-property-name))))
                (vnt-raw-result
                 (g-dbus-connection-call-sync
                  conn
                  str-bus-name
                  str-object-path
                  "org.freedesktop.DBus.Properties"
                  "Get"
                  vnt-args
                  (g-variant-type-new "(v)")
                  flags
                  i-timeout
                  cancellable))
                (vnt-result2
                 (g-variant-get-variant
                  (g-variant-get-child-value vnt-raw-result 0)))
                (vnt-final-result ,(gen-result-wrapper sx-type 'vnt-result2)))
           vnt-final-result))))
  
  
  (define-simple-method gen-property-get-declaration
      (((s-method-name <symbol>)
        (sx-type <dbus-type-repr>))
       <source-expr> pure)
    (let ((sx-theme-d-type (dbus-repr->theme-d sx-type)))
      `(declare-simple-method ,s-method-name
         (<g-dbus-connection>
         <string>
         <string>
         <g-dbus-call-flags>
         <integer>
         (:alt-maybe <g-cancellable>))
          ,sx-theme-d-type nonpure)))


  (define-simple-method gen-property-set-wrapper
      (((str-intf-name <string>)
        (str-property-name <string>)
        (s-method-name <symbol>)
        (sx-type <dbus-type-repr>))
       <source-expr> pure)
    (let* ((sx-theme-d-type (dbus-repr->theme-d sx-type))
           (sx-header
            `(((conn <g-dbus-connection>)
               (str-bus-name <string>)
               (str-object-path <string>)
               (x-value ,sx-theme-d-type)
               (flags <g-dbus-call-flags>)
               (i-timeout <integer>)
               (cancellable (:alt-maybe <g-cancellable>)))
              <none>
              nonpure)))    
      `(define-simple-method ,s-method-name ,sx-header
         (let* ((vnt-value ,(gen-arg-wrapper sx-type 'x-value))
                (vnt-args
                 (g-variant-new-tuple
                  (list
                   (g-variant-new-string ,str-intf-name)
                   (g-variant-new-string ,str-property-name)
                   (g-variant-new-variant vnt-value)))))
           (g-dbus-connection-call-sync
            conn
            str-bus-name
            str-object-path
            "org.freedesktop.DBus.Properties"
            "Set"
            vnt-args
            (g-variant-type-new "()")
            flags
            i-timeout
            cancellable)))))
  

  (define-simple-method gen-property-set-declaration
      (((s-method-name <symbol>)
        (sx-type <dbus-type-repr>))
       <source-expr> pure)
    (let ((sx-theme-d-type (dbus-repr->theme-d sx-type)))
      `(declare-simple-method ,s-method-name
         (<g-dbus-connection>
          <string>
          <string>
          ,sx-theme-d-type
          <g-dbus-call-flags>
          <integer>
          (:alt-maybe <g-cancellable>))
         <none> nonpure))))

