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

;; Distributed under GNU Lesser General Public License.


(define-proper-program (intr-dbus-examples server-and-client-1 dbus-test-client1-2)
  
  
  (import (standard-library core)
          (standard-library list-utilities)
          (standard-library object-string-conversion)
          (standard-library console-io))
  

  (import (theme-d-intr base gobject)
          (theme-d-intr base variant)
          (theme-d-intr base utils)
          (theme-d-intr dbus connection)
          (theme-d-intr dbus utils)
          (intr-dbus-examples server-and-client-1 org_gnu_test_DBus))


  (define-simple-method dimfi (((l-items (rest <object>))) <none> nonpure)
    (console-display ";; ")
    (for-each1 (lambda (((x-item <object>)) <none> nonpure)
                 (console-display x-item) (console-display " "))
               l-items)
    (console-newline))
  

  (add-method format
    (prim-proc format
               ((:alt-maybe <output-port>) <string> (rest <object>))
               (:union <string> <boolean>) nonpure))


  (define-simple-method on-my-signal
      (((connection <g-dbus-connection>)
        (str-sender (:alt-maybe <string>))
        (str-object-path <string>)
        (str-interface-name <string>)
        (str-signal-name <string>)
        (l-params (:tuple <integer>))
        (x-user-data <object>))
       <none> nonpure)
    (dimfi 'on-my-signal)
    (dimfi (format #f "~20,,,' @A:" "connection") connection)
    (dimfi (format #f "~20,,,' @A:" "unique name")
           (g-dbus-connection-get-unique-name connection))
    (dimfi (format #f "~20,,,' @A:" "sender") str-sender)
    (dimfi (format #f "~20,,,' @A:" "object-path") str-object-path)
    (dimfi (format #f "~20,,,' @A:" "interface name") str-interface-name)
    (dimfi (format #f "~20,,,' @A:" "signal-name") str-signal-name)
    (dimfi (format #f "~20,,,' @A:" "params") l-params))
  

  (define-simple-method on-my-reply
      (((x-object (:alt-maybe <gobject>))
        (i-result <integer>)
        (x-data <object>))
       <none> nonpure)
    (dimfi 'on-my-reply)
    (dimfi (format #f "~20,,,' @A:" "result") i-result))


  (define-simple-method subscribe-signal
      (((connection <g-dbus-connection>)) <integer> nonpure)
    (org_gnu_test_DBus:subscribe:Signal1
      connection
      "org.gnu.test.DBus"     ; sender
      "/org/gnu/test/DBus"    ; object-path
      #f                      ; arg0 filter
      null                    ; flags
      on-my-signal            ; callback
      #f                      ; user data
      #f))                    ; user data free func
  
  
  (define-main-proc (() <none> nonpure)
    (let* ((loop (g-main-loop-new))
           (connection (g-bus-get-sync 'session #f))
           (s-id (subscribe-signal connection))
           (m1-result
            (org_gnu_test_DBus:Method1
             connection
             "org.gnu.test.DBus"
             "/org/gnu/test/DBus"
             '()
             -1
             #f
             (list "Lucky number")))
           (m2-result
            (org_gnu_test_DBus:Method2
             connection
             "org.gnu.test.DBus"
             "/org/gnu/test/DBus"
             '()
             -1
             #f
             (list 10)))
           (m3-result
            (org_gnu_test_DBus:Method3
             connection
             "org.gnu.test.DBus"
             "/org/gnu/test/DBus"
             '()
             -1
             #f
             (list (list "Age" "Lucky number" "Height"))))
           (m4-result
            (org_gnu_test_DBus:Method4
             connection
             "org.gnu.test.DBus"
             "/org/gnu/test/DBus"
             '()
             -1
             #f
             (list (list (cons "Age" 50) (cons "Lucky number" 13)))))
           (m5-result
            (org_gnu_test_DBus:Method5
             connection
             "org.gnu.test.DBus"
             "/org/gnu/test/DBus"
             '()
             -1
             #f
             (list (list (cons "Age" 50) (cons "Lucky number" 13))))))
      (dimfi (format #f "~20,,,' @A:" "Result of Method1")
             m1-result)
      (dimfi (format #f "~20,,,' @A:" "Result of Method2")
             m2-result)
      (dimfi (format #f "~20,,,' @A:" "Result of Method3")
             m3-result)
      (dimfi (format #f "~20,,,' @A:" "Result of Method4")
             m4-result)
      (dimfi (format #f "~20,,,' @A:" "Result of Method5")
             m5-result)
      (org_gnu_test_DBus:Method6
       connection
       "org.gnu.test.DBus"
       "/org/gnu/test/DBus"
       '()
       -1
       #f)
      (dimfi (format #f "~20,,,' @A:" "Value of property Volume")
             (org_gnu_test_DBus:get:Volume
              connection
              "org.gnu.test.DBus"
              "/org/gnu/test/DBus"
              null
              -1
              #f))
      (org_gnu_test_DBus:set:Volume
       connection
       "org.gnu.test.DBus"
       "/org/gnu/test/DBus"
       0.5
       null
       -1
       #f)
      (dimfi (format #f "~20,,,' @A:" "Value of property Volume after setting")
             (org_gnu_test_DBus:get:Volume
              connection
              "org.gnu.test.DBus"
              "/org/gnu/test/DBus"
              null
              -1
              #f))
      (dimfi (format #f "~20,,,' @A:" "Value of property ReadonlyProp")
             (org_gnu_test_DBus:get:ReadonlyProp
              connection
              "org.gnu.test.DBus"
              "/org/gnu/test/DBus"
              null
              -1
              #f))
      (org_gnu_test_DBus:set:WriteonlyProp
       connection
       "org.gnu.test.DBus"
       "/org/gnu/test/DBus"
       "Good bye"
       null
       -1
       #f)
      (org_gnu_test_DBus:async:Method1
       connection
       "org.gnu.test.DBus"
       "/org/gnu/test/DBus"
       '()
       -1
       #f
       on-my-reply
       (list "Age"))
      (g-main-loop-run loop))))
