From 9675c880d9476236b14b4bd2d6bff6176fd04ebc Mon Sep 17 00:00:00 2001
From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com>
Date: Wed, 19 Apr 2023 10:38:21 -0500
Subject: [PATCH] Macro for attaching Introspectable to a DBUS path

---
 secrettabero.scm | 116 ++++++++++++++---------------------------------
 1 file changed, 33 insertions(+), 83 deletions(-)

diff --git a/secrettabero.scm b/secrettabero.scm
index fe912bb..0d70773 100644
--- a/secrettabero.scm
+++ b/secrettabero.scm
@@ -103,31 +103,40 @@
 
 
 
+;; —————————————————————————————————————
+;; DBUS generally
+;; —————————————————————————————————————
+
+;; Creates an Introspectable interface for the given path, given a list
+;; of interfaces and subnodes.
+(define-syntax handle-introspection-for-path
+  (syntax-rules ()
+	((handle-introspection-for-path node-path interfaces subnodes)
+	 (let* ([xml
+			 (introspect-node-xml
+			  (list
+			   (append '("org.freedesktop.DBus.Introspectable"
+						 . (("Introspect"
+							 . (((direction . "out")
+								 (type . "s")
+								 (name . "xml_data"))))))
+					   interfaces))
+			  subnodes)]
+			[context
+			 (dbus:make-context bus: dbus:session-bus
+								service: 'org.jadedctrl.secrettabero
+								interface: 'org.freedesktop.DBus.Introspectable
+								path: node-path)])
+	   (dbus:register-method context "Introspect"
+							 (lambda () xml))))))
+
+
+
 ;; —————————————————————————————————————
 ;; DBUS Path: /
 ;; —————————————————————————————————————
 
-;; Callback function for org.freedesktop.DBus.Introspectable's `Introspect`.
-(define (root-introspection-introspect)
-  (introspect-node-xml
-   '(("org.freedesktop.DBus.Introspectable"
-	. (("Introspect"
-		. (((direction . "out")
-			(type . "s")
-			(name . "xml_data")))))))
-   '(org)))
-
-
-;; The DBUS context used for introspection.
-(define root-introspection-context
-  (dbus:make-context
-   bus: dbus:session-bus
-   service: 'org.jadedctrl.secrettabero
-   interface: 'org.freedesktop.DBus.Introspectable
-   path: '/))
-
-(dbus:register-method root-introspection-context "Introspect"
-					  root-introspection-introspect)
+(handle-introspection-for-path '/ '() '(org))
 
 
 
@@ -135,27 +144,7 @@
 ;; DBUS Path: /org/
 ;; —————————————————————————————————————
 
-;; Callback function for org.freedesktop.DBus.Introspectable's `Introspect`.
-(define (root-org-introspection-introspect)
-  (introspect-node-xml
-   '(("org.freedesktop.DBus.Introspectable"
-	. (("Introspect"
-		. (((direction . "out")
-			(type . "s")
-			(name . "xml_data")))))))
-   '(freedesktop)))
-
-
-;; The DBUS context used for introspection.
-(define root-org-introspection-context
-  (dbus:make-context
-   bus: dbus:session-bus
-   service: 'org.jadedctrl.secrettabero
-   interface: 'org.freedesktop.DBus.Introspectable
-   path: '/org))
-
-(dbus:register-method root-org-introspection-context "Introspect"
-					  root-org-introspection-introspect)
+(handle-introspection-for-path '/org '() '(freedesktop))
 
 
 
@@ -163,27 +152,7 @@
 ;; DBUS Path: /org/freedesktop/
 ;; —————————————————————————————————————
 
-;; Callback function for org.freedesktop.DBus.Introspectable's `Introspect`.
-(define (root-org-freedesktop-introspection-introspect)
-  (introspect-node-xml
-   '(("org.freedesktop.DBus.Introspectable"
-	. (("Introspect"
-		. (((direction . "out")
-			(type . "s")
-			(name . "xml_data")))))))
-   '(secrets)))
-
-
-;; The DBUS context used for introspection.
-(define root-org-freedesktop-introspection-context
-  (dbus:make-context
-   bus: dbus:session-bus
-   service: 'org.jadedctrl.secrettabero
-   interface: 'org.freedesktop.DBus.Introspectable
-   path: '/org/freedesktop))
-
-(dbus:register-method root-org-freedesktop-introspection-context "Introspect"
-					  root-org-freedesktop-introspection-introspect)
+(handle-introspection-for-path '/org/freedesktop '() '(secrets))
 
 
 
@@ -191,26 +160,7 @@
 ;; DBUS Path: /org/freedesktop/secrets
 ;; —————————————————————————————————————
 
-;; Callback function for org.freedesktop.DBus.Introspectable's `Introspect`.
-(define (root-org-freedesktop-secrets-introspection-introspect)
-  (introspect-node-xml
-   '(("org.freedesktop.DBus.Introspectable"
-	. (("Introspect"
-		. (((direction . "out")
-			(type . "s")
-			(name . "xml_data")))))))))
-
-
-;; The DBUS context used for introspection.
-(define root-org-freedesktop-secrets-introspection-context
-  (dbus:make-context
-   bus: dbus:session-bus
-   service: 'org.jadedctrl.secrettabero
-   interface: 'org.freedesktop.DBus.Introspectable
-   path: '/org/freedesktop/secrets))
-
-(dbus:register-method root-org-freedesktop-secrets-introspection-context "Introspect"
-					  root-org-freedesktop-secrets-introspection-introspect)
+(handle-introspection-for-path '/org/freedesktop/secrets '() '())