From 901feeb7aeccee2ed7384bce9a01d6a08abb48a0 Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Tue, 10 Oct 2023 23:14:40 -0500
Subject: [PATCH 01/12] introspection support

---
 all.lisp     |   6 +-
 publish.lisp | 156 ++++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 152 insertions(+), 10 deletions(-)

diff --git a/all.lisp b/all.lisp
index ecdd0a0..23f1b39 100644
--- a/all.lisp
+++ b/all.lisp
@@ -159,4 +159,8 @@
    #:define-dbus-object
    #:define-dbus-method
    #:define-dbus-signal-handler
-   #:publish-objects))
+   #:publish-objects
+   #:dbus-object
+   #:child-object-mixin
+   #:introspection-mixin
+   #:introspection-document))
diff --git a/publish.lisp b/publish.lisp
index 3c8e7a5..3b104cb 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -15,7 +15,11 @@
    #:define-dbus-object
    #:define-dbus-method
    #:define-dbus-signal-handler
-   #:publish-objects))
+   #:publish-objects
+   #:dbus-object
+   #:child-object-mixin
+   #:introspection-mixin
+   #:introspection-document))
 
 (in-package #:dbus/publish)
 
@@ -40,6 +44,19 @@
 (defmethod dbus-object-handler-lookup-table ((message method-call-message) (object dbus-object))
   (dbus-object-method-handlers object))
 
+(defclass child-object-mixin ()
+  ((child-object-names :initarg :child-object-names :initform '()
+		       :accessor dbus-object-child-object-names)
+   (parent-object-name :initarg :parent-object-name
+		       :accessor dbus-object-parent-object-name)))
+
+(defmethod register-child-object ((child-object child-object-mixin)
+				  (parent-object child-object-mixin))
+  (push (dbus-object-name child-object) (dbus-object-child-object-names parent-object))
+  (setf (dbus-object-parent-object-name child-object) (dbus-object-name parent-object)))
+
+(defclass introspection-mixin () ())
+
 (defun find-dbus-object (name)
   (check-type name symbol)
   (get name 'dbus-object))
@@ -54,17 +71,22 @@
          (pushnew name *all-dbus-objects*)
          (setf (get name 'dbus-object) new-value))))
 
-(defun register-dbus-object (name path)
+(defun register-dbus-object (name path &optional dbus-object-sub-class)
   (check-type name symbol)
   (check-type path string)
   (if (find-dbus-object name)
       ;; If we already have an object with that name, just update its
       ;; path.
       (setf (dbus-object-path (find-dbus-object name)) path)
-      (setf (find-dbus-object name)
-            (make-instance 'dbus-object
-                           :name name
-                           :path path)))
+      (if dbus-object-sub-class
+	  (setf (find-dbus-object name)
+		(make-instance dbus-object-sub-class
+			       :name name
+			       :path path))
+	  (setf (find-dbus-object name)
+		(make-instance 'dbus-object
+                               :name name
+                               :path path))))
   name)
 
 (defun require-dbus-object (name)
@@ -76,12 +98,34 @@
              (shiftf name object (find-dbus-object object)))
         finally (return (values object (dbus-object-name object)))))
 
+(defmacro initialize-mixined-instance (name options)
+  (let ((parent nil) (class nil))
+    (dolist (option options)
+      (when (and (consp option) (eq (car option) :parent))
+        (setf parent (cadr option)))
+      (when (and (consp option) (eq (car option) :class))
+        (setf class (cadr option))))
+    `(progn
+      (if ',parent
+		(register-child-object (find-dbus-object ',name)
+				       (find-dbus-object ',parent)))
+      (if (subtypep ',class 'introspection-mixin)
+	  (define-dbus-method (,name introspect) () (:string)
+	    (:interface "org.freedesktop.DBus.Introspectable")
+	    (introspection-document (find-dbus-object ',name)))))))
+
 (defmacro define-dbus-object (name &body options)
-  (let ((path nil))
+  (let ((path nil) (class nil))
     (dolist (option options)
       (when (and (consp option) (eq (car option) :path))
-        (setf path (cadr option))))
-    `(register-dbus-object ',name ,path)))
+        (setf path (cadr option)))
+      (when (and (consp option) (eq (car option) :class))
+        (setf class (cadr option))))
+    (if class
+	`(prog1
+	     (register-dbus-object ',name ,path ',class)
+	   (initialize-mixined-instance ,name ,options))
+	`(register-dbus-object ',name ,path))))
 
 ;;; Define handlers
 
@@ -192,6 +236,100 @@ sans dashes."
                                    (lambda (,@parameter-names)
                                      ,@body))))
 
+;;; introspection functions
+(defun type-to-code (type)
+  "Return the code for a type"
+  (case type
+    (:string "s")
+    (:int32 "i")
+    (:uint32 "u")))
+
+(defgeneric output-introspection-fragment (thing)
+  (:documentation "Return the introspection element for a thing."))
+
+(defmethod relative-path-string ((object child-object-mixin))
+  (enough-namestring
+   (dbus-object-path object)
+   (uiop:ensure-directory-pathname
+    (dbus-object-path
+     (find-dbus-object (dbus-object-parent-object-name object))))))
+
+(defmethod output-introspection-fragment ((thing child-object-mixin))
+  (cxml:with-element "node"
+    (cxml:attribute "name"
+		    (relative-path-string thing))))
+
+(defmethod output-introspection-fragment ((thing method-handler))
+  (cxml:with-element "method"
+    (cxml:attribute "name" (handler-name thing))
+    (flet
+	((one-arg (name dir type)
+           (cxml:with-element "arg"
+             (cxml:attribute "direction" dir)
+             (if name
+		 (cxml:attribute "name" (stringify-lisp-name name)))
+             (cxml:attribute "type" (type-to-code type)))))
+      (loop for type in (handler-input-signature thing)
+            do (one-arg nil "in" type))
+      (loop for type in (handler-output-signature thing)
+            do (one-arg nil "out" type)))))
+
+(defmethod output-introspection-fragment ((thing signal-handler))
+  (cxml:with-element "signal"
+    (cxml:attribute "name" (handler-name thing))
+    (flet
+	((one-arg (name type)
+           (cxml:with-element "arg"
+             (if name
+		 (cxml:attribute "name" (stringify-lisp-name name)))
+             (cxml:attribute "type"
+			     (type-to-code type)))))
+      (loop for type in (handler-input-signature thing)
+            do (one-arg nil type)))))
+
+(defmethod collect-handlers-by-interface ((object dbus-object))
+  (let ((result (make-hash-table :test #'equal)))
+    (loop for m-h being the hash-values of (dbus-object-method-handlers object)
+        do (push m-h (gethash (handler-interface m-h) result ())))
+    (loop for s-h being the hash-values of (dbus-object-signal-handlers object)
+        do (push s-h (gethash (handler-interface s-h) result ())))
+    result))
+
+(defgeneric introspection-document (object)
+  (:documentation "Return the introspection document string for
+a particular DBUS  object."))
+
+(defmethod introspection-document ((object dbus-object))
+  (cxml:with-xml-output (cxml:make-string-sink)
+      (cxml:doctype "node" 
+                    "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"
+                    "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
+      (cxml:with-element "node"
+	(let ((interfaces-handlers (collect-handlers-by-interface object)))
+	  (loop for interface-name being the hash-keys of interfaces-handlers
+		  using (hash-value handlers)
+		do (cxml:with-element "interface"
+                     (cxml:attribute "name" interface-name)
+                     (loop for h in handlers
+                           do (output-introspection-fragment h))))))))
+
+(defmethod introspection-document ((object child-object-mixin))
+  (cxml:with-xml-output (cxml:make-string-sink)
+      (cxml:doctype "node"
+                    "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"
+                    "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
+      (cxml:with-element "node"
+	(let ((interfaces-handlers (collect-handlers-by-interface object))
+	      (child-object-names (dbus-object-child-object-names object)))
+	  (loop for interface-name being the hash-keys of interfaces-handlers
+		  using (hash-value handlers)
+		do (cxml:with-element "interface"
+                     (cxml:attribute "name" interface-name)
+                     (loop for h in handlers
+                           do (output-introspection-fragment h))))
+	  (dolist (child-object-name child-object-names)
+	    (output-introspection-fragment (find-dbus-object child-object-name)))))))
+
 ;;; Publishing objects
 
 (defgeneric publish-objects (connection &optional object-names))

From 0ec3fac48330d4902d30a7873150b4f139645e13 Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Tue, 10 Oct 2023 23:15:16 -0500
Subject: [PATCH 02/12] introspection example

---
 examples/publish-introspection.lisp | 37 +++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)
 create mode 100644 examples/publish-introspection.lisp

diff --git a/examples/publish-introspection.lisp b/examples/publish-introspection.lisp
new file mode 100644
index 0000000..6475f8d
--- /dev/null
+++ b/examples/publish-introspection.lisp
@@ -0,0 +1,37 @@
+;;;; +----------------------------------------------------------------+
+;;;; | DBUS                                                           |
+;;;; +----------------------------------------------------------------+
+
+(defpackage #:publish-introspection-example
+  (:use #:cl #:dbus)
+  (:export #:publish-introspection-example))
+
+(in-package #:publish-introspection-example)
+
+(defclass dbus-introspection-object
+    (introspection-mixin child-object-mixin dbus-object) ())
+
+(define-dbus-object root
+  (:path "/")
+  (:class dbus-introspection-object))
+
+(define-dbus-object my-service
+  (:path "/org/adeht/MyService")
+  (:class dbus-introspection-object)
+  (:parent root))
+
+(define-dbus-method (my-service my-method) ((s1 :string) (s2 :string)) (:string)
+  (:interface "org.adeht.MyService")
+  (concatenate 'string s1 s2))
+
+(define-dbus-signal-handler (my-service on-signal) ((s :string))
+  (:interface "org.adeht.MyService")
+  (format t "Got signal with arg ~S~%" s))
+
+(defun publish-example ()
+  (handler-case
+      (with-open-bus (bus (session-server-addresses))
+        (format t "Bus connection name: ~A~%" (bus-name bus))
+        (publish-objects bus))
+    (end-of-file ()
+      :disconnected-by-bus)))

From 5946e9b6d1aa96eaeed50b0dfe978c5281e26495 Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Wed, 11 Oct 2023 23:16:25 -0500
Subject: [PATCH 03/12] don't add duplicated object name

---
 publish.lisp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/publish.lisp b/publish.lisp
index 3b104cb..50af1c4 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -52,7 +52,7 @@
 
 (defmethod register-child-object ((child-object child-object-mixin)
 				  (parent-object child-object-mixin))
-  (push (dbus-object-name child-object) (dbus-object-child-object-names parent-object))
+  (pushnew (dbus-object-name child-object) (dbus-object-child-object-names parent-object))
   (setf (dbus-object-parent-object-name child-object) (dbus-object-name parent-object)))
 
 (defclass introspection-mixin () ())

From 76aeebc0450eefa9aad6bc145d58449a285facc7 Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Sat, 14 Oct 2023 13:12:35 -0500
Subject: [PATCH 04/12] use a dbus-lisp function instead of type-to-code

---
 publish.lisp | 11 ++---------
 1 file changed, 2 insertions(+), 9 deletions(-)

diff --git a/publish.lisp b/publish.lisp
index 50af1c4..de36c9e 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -237,12 +237,6 @@ sans dashes."
                                      ,@body))))
 
 ;;; introspection functions
-(defun type-to-code (type)
-  "Return the code for a type"
-  (case type
-    (:string "s")
-    (:int32 "i")
-    (:uint32 "u")))
 
 (defgeneric output-introspection-fragment (thing)
   (:documentation "Return the introspection element for a thing."))
@@ -268,7 +262,7 @@ sans dashes."
              (cxml:attribute "direction" dir)
              (if name
 		 (cxml:attribute "name" (stringify-lisp-name name)))
-             (cxml:attribute "type" (type-to-code type)))))
+             (cxml:attribute "type" (signature (list type))))))
       (loop for type in (handler-input-signature thing)
             do (one-arg nil "in" type))
       (loop for type in (handler-output-signature thing)
@@ -282,8 +276,7 @@ sans dashes."
            (cxml:with-element "arg"
              (if name
 		 (cxml:attribute "name" (stringify-lisp-name name)))
-             (cxml:attribute "type"
-			     (type-to-code type)))))
+             (cxml:attribute "type" (signature (list type))))))
       (loop for type in (handler-input-signature thing)
             do (one-arg nil type)))))
 

From 719e069ce320a361fdd3ab9016e6796da67963ba Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Fri, 20 Oct 2023 08:07:35 -0500
Subject: [PATCH 05/12] use import-from fox cxml and uiop

---
 publish.lisp | 106 ++++++++++++++++++++++++++-------------------------
 1 file changed, 55 insertions(+), 51 deletions(-)

diff --git a/publish.lisp b/publish.lisp
index de36c9e..b32fa8f 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -10,6 +10,10 @@
         #:dbus/connections
         #:dbus/types)
   (:import-from #:iolib #:event-dispatch)
+  (:import-from #:cxml
+		#:with-element #:attribute #:with-xml-output
+		#:doctype #:make-string-sink)
+  (:import-from #:uiop #:ensure-directory-pathname)
   (:export
    #:*all-dbus-objects*
    #:define-dbus-object
@@ -106,13 +110,13 @@
       (when (and (consp option) (eq (car option) :class))
         (setf class (cadr option))))
     `(progn
-      (if ',parent
-		(register-child-object (find-dbus-object ',name)
-				       (find-dbus-object ',parent)))
-      (if (subtypep ',class 'introspection-mixin)
-	  (define-dbus-method (,name introspect) () (:string)
-	    (:interface "org.freedesktop.DBus.Introspectable")
-	    (introspection-document (find-dbus-object ',name)))))))
+       (if ',parent
+	   (register-child-object (find-dbus-object ',name)
+				  (find-dbus-object ',parent)))
+       (if (subtypep ',class 'introspection-mixin)
+	   (define-dbus-method (,name introspect) () (:string)
+			       (:interface "org.freedesktop.DBus.Introspectable")
+			       (introspection-document (find-dbus-object ',name)))))))
 
 (defmacro define-dbus-object (name &body options)
   (let ((path nil) (class nil))
@@ -244,48 +248,48 @@ sans dashes."
 (defmethod relative-path-string ((object child-object-mixin))
   (enough-namestring
    (dbus-object-path object)
-   (uiop:ensure-directory-pathname
+   (ensure-directory-pathname
     (dbus-object-path
      (find-dbus-object (dbus-object-parent-object-name object))))))
 
 (defmethod output-introspection-fragment ((thing child-object-mixin))
-  (cxml:with-element "node"
-    (cxml:attribute "name"
-		    (relative-path-string thing))))
+  (with-element "node"
+    (attribute "name"
+	       (relative-path-string thing))))
 
 (defmethod output-introspection-fragment ((thing method-handler))
-  (cxml:with-element "method"
-    (cxml:attribute "name" (handler-name thing))
+  (with-element "method"
+    (attribute "name" (handler-name thing))
     (flet
 	((one-arg (name dir type)
-           (cxml:with-element "arg"
-             (cxml:attribute "direction" dir)
+           (with-element "arg"
+             (attribute "direction" dir)
              (if name
-		 (cxml:attribute "name" (stringify-lisp-name name)))
-             (cxml:attribute "type" (signature (list type))))))
+		 (attribute "name" (stringify-lisp-name name)))
+             (attribute "type" (signature (list type))))))
       (loop for type in (handler-input-signature thing)
             do (one-arg nil "in" type))
       (loop for type in (handler-output-signature thing)
             do (one-arg nil "out" type)))))
 
 (defmethod output-introspection-fragment ((thing signal-handler))
-  (cxml:with-element "signal"
-    (cxml:attribute "name" (handler-name thing))
+  (with-element "signal"
+    (attribute "name" (handler-name thing))
     (flet
 	((one-arg (name type)
-           (cxml:with-element "arg"
+           (with-element "arg"
              (if name
-		 (cxml:attribute "name" (stringify-lisp-name name)))
-             (cxml:attribute "type" (signature (list type))))))
+		 (attribute "name" (stringify-lisp-name name)))
+             (attribute "type" (signature (list type))))))
       (loop for type in (handler-input-signature thing)
             do (one-arg nil type)))))
 
 (defmethod collect-handlers-by-interface ((object dbus-object))
   (let ((result (make-hash-table :test #'equal)))
     (loop for m-h being the hash-values of (dbus-object-method-handlers object)
-        do (push m-h (gethash (handler-interface m-h) result ())))
+          do (push m-h (gethash (handler-interface m-h) result ())))
     (loop for s-h being the hash-values of (dbus-object-signal-handlers object)
-        do (push s-h (gethash (handler-interface s-h) result ())))
+          do (push s-h (gethash (handler-interface s-h) result ())))
     result))
 
 (defgeneric introspection-document (object)
@@ -293,35 +297,35 @@ sans dashes."
 a particular DBUS  object."))
 
 (defmethod introspection-document ((object dbus-object))
-  (cxml:with-xml-output (cxml:make-string-sink)
-      (cxml:doctype "node" 
-                    "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"
-                    "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
-      (cxml:with-element "node"
-	(let ((interfaces-handlers (collect-handlers-by-interface object)))
-	  (loop for interface-name being the hash-keys of interfaces-handlers
-		  using (hash-value handlers)
-		do (cxml:with-element "interface"
-                     (cxml:attribute "name" interface-name)
-                     (loop for h in handlers
-                           do (output-introspection-fragment h))))))))
+  (with-xml-output (make-string-sink)
+    (doctype "node"
+             "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"
+             "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
+    (with-element "node"
+      (let ((interfaces-handlers (collect-handlers-by-interface object)))
+	(loop for interface-name being the hash-keys of interfaces-handlers
+	      using (hash-value handlers)
+	      do (with-element "interface"
+                   (attribute "name" interface-name)
+                   (loop for h in handlers
+                         do (output-introspection-fragment h))))))))
 
 (defmethod introspection-document ((object child-object-mixin))
-  (cxml:with-xml-output (cxml:make-string-sink)
-      (cxml:doctype "node"
-                    "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"
-                    "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
-      (cxml:with-element "node"
-	(let ((interfaces-handlers (collect-handlers-by-interface object))
-	      (child-object-names (dbus-object-child-object-names object)))
-	  (loop for interface-name being the hash-keys of interfaces-handlers
-		  using (hash-value handlers)
-		do (cxml:with-element "interface"
-                     (cxml:attribute "name" interface-name)
-                     (loop for h in handlers
-                           do (output-introspection-fragment h))))
-	  (dolist (child-object-name child-object-names)
-	    (output-introspection-fragment (find-dbus-object child-object-name)))))))
+  (with-xml-output (make-string-sink)
+    (doctype "node"
+             "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"
+             "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
+    (with-element "node"
+      (let ((interfaces-handlers (collect-handlers-by-interface object))
+	    (child-object-names (dbus-object-child-object-names object)))
+	(loop for interface-name being the hash-keys of interfaces-handlers
+	      using (hash-value handlers)
+	      do (with-element "interface"
+                   (attribute "name" interface-name)
+                   (loop for h in handlers
+                         do (output-introspection-fragment h))))
+	(dolist (child-object-name child-object-names)
+	  (output-introspection-fragment (find-dbus-object child-object-name)))))))
 
 ;;; Publishing objects
 

From 477b57d542b8a19d4c380bfe1fd36871dd8304e4 Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Fri, 20 Oct 2023 08:10:34 -0500
Subject: [PATCH 06/12] replace tab with spaces

---
 publish.lisp | 68 ++++++++++++++++++++++++++--------------------------
 1 file changed, 34 insertions(+), 34 deletions(-)

diff --git a/publish.lisp b/publish.lisp
index b32fa8f..3d3468e 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -11,8 +11,8 @@
         #:dbus/types)
   (:import-from #:iolib #:event-dispatch)
   (:import-from #:cxml
-		#:with-element #:attribute #:with-xml-output
-		#:doctype #:make-string-sink)
+                #:with-element #:attribute #:with-xml-output
+                #:doctype #:make-string-sink)
   (:import-from #:uiop #:ensure-directory-pathname)
   (:export
    #:*all-dbus-objects*
@@ -50,12 +50,12 @@
 
 (defclass child-object-mixin ()
   ((child-object-names :initarg :child-object-names :initform '()
-		       :accessor dbus-object-child-object-names)
+                       :accessor dbus-object-child-object-names)
    (parent-object-name :initarg :parent-object-name
-		       :accessor dbus-object-parent-object-name)))
+                       :accessor dbus-object-parent-object-name)))
 
 (defmethod register-child-object ((child-object child-object-mixin)
-				  (parent-object child-object-mixin))
+                                  (parent-object child-object-mixin))
   (pushnew (dbus-object-name child-object) (dbus-object-child-object-names parent-object))
   (setf (dbus-object-parent-object-name child-object) (dbus-object-name parent-object)))
 
@@ -83,12 +83,12 @@
       ;; path.
       (setf (dbus-object-path (find-dbus-object name)) path)
       (if dbus-object-sub-class
-	  (setf (find-dbus-object name)
-		(make-instance dbus-object-sub-class
-			       :name name
-			       :path path))
-	  (setf (find-dbus-object name)
-		(make-instance 'dbus-object
+          (setf (find-dbus-object name)
+                (make-instance dbus-object-sub-class
+                               :name name
+                               :path path))
+          (setf (find-dbus-object name)
+                (make-instance 'dbus-object
                                :name name
                                :path path))))
   name)
@@ -111,12 +111,12 @@
         (setf class (cadr option))))
     `(progn
        (if ',parent
-	   (register-child-object (find-dbus-object ',name)
-				  (find-dbus-object ',parent)))
+           (register-child-object (find-dbus-object ',name)
+                                  (find-dbus-object ',parent)))
        (if (subtypep ',class 'introspection-mixin)
-	   (define-dbus-method (,name introspect) () (:string)
-			       (:interface "org.freedesktop.DBus.Introspectable")
-			       (introspection-document (find-dbus-object ',name)))))))
+           (define-dbus-method (,name introspect) () (:string)
+                               (:interface "org.freedesktop.DBus.Introspectable")
+                               (introspection-document (find-dbus-object ',name)))))))
 
 (defmacro define-dbus-object (name &body options)
   (let ((path nil) (class nil))
@@ -126,10 +126,10 @@
       (when (and (consp option) (eq (car option) :class))
         (setf class (cadr option))))
     (if class
-	`(prog1
-	     (register-dbus-object ',name ,path ',class)
-	   (initialize-mixined-instance ,name ,options))
-	`(register-dbus-object ',name ,path))))
+        `(prog1
+             (register-dbus-object ',name ,path ',class)
+           (initialize-mixined-instance ,name ,options))
+        `(register-dbus-object ',name ,path))))
 
 ;;; Define handlers
 
@@ -255,17 +255,17 @@ sans dashes."
 (defmethod output-introspection-fragment ((thing child-object-mixin))
   (with-element "node"
     (attribute "name"
-	       (relative-path-string thing))))
+               (relative-path-string thing))))
 
 (defmethod output-introspection-fragment ((thing method-handler))
   (with-element "method"
     (attribute "name" (handler-name thing))
     (flet
-	((one-arg (name dir type)
+        ((one-arg (name dir type)
            (with-element "arg"
              (attribute "direction" dir)
              (if name
-		 (attribute "name" (stringify-lisp-name name)))
+                 (attribute "name" (stringify-lisp-name name)))
              (attribute "type" (signature (list type))))))
       (loop for type in (handler-input-signature thing)
             do (one-arg nil "in" type))
@@ -276,10 +276,10 @@ sans dashes."
   (with-element "signal"
     (attribute "name" (handler-name thing))
     (flet
-	((one-arg (name type)
+        ((one-arg (name type)
            (with-element "arg"
              (if name
-		 (attribute "name" (stringify-lisp-name name)))
+                 (attribute "name" (stringify-lisp-name name)))
              (attribute "type" (signature (list type))))))
       (loop for type in (handler-input-signature thing)
             do (one-arg nil type)))))
@@ -303,9 +303,9 @@ a particular DBUS  object."))
              "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
     (with-element "node"
       (let ((interfaces-handlers (collect-handlers-by-interface object)))
-	(loop for interface-name being the hash-keys of interfaces-handlers
-	      using (hash-value handlers)
-	      do (with-element "interface"
+        (loop for interface-name being the hash-keys of interfaces-handlers
+              using (hash-value handlers)
+              do (with-element "interface"
                    (attribute "name" interface-name)
                    (loop for h in handlers
                          do (output-introspection-fragment h))))))))
@@ -317,15 +317,15 @@ a particular DBUS  object."))
              "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
     (with-element "node"
       (let ((interfaces-handlers (collect-handlers-by-interface object))
-	    (child-object-names (dbus-object-child-object-names object)))
-	(loop for interface-name being the hash-keys of interfaces-handlers
-	      using (hash-value handlers)
-	      do (with-element "interface"
+            (child-object-names (dbus-object-child-object-names object)))
+        (loop for interface-name being the hash-keys of interfaces-handlers
+              using (hash-value handlers)
+              do (with-element "interface"
                    (attribute "name" interface-name)
                    (loop for h in handlers
                          do (output-introspection-fragment h))))
-	(dolist (child-object-name child-object-names)
-	  (output-introspection-fragment (find-dbus-object child-object-name)))))))
+        (dolist (child-object-name child-object-names)
+          (output-introspection-fragment (find-dbus-object child-object-name)))))))
 
 ;;; Publishing objects
 

From c2aaa9dfe6a36e922aec88195c6f84cc2dc31c1b Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Sun, 29 Oct 2023 11:35:02 -0500
Subject: [PATCH 07/12] dbus-object uses the introspection mixins by default

---
 examples/publish-introspection.lisp | 37 -----------------
 examples/publish.lisp               |  6 ++-
 publish.lisp                        | 62 ++++++++---------------------
 3 files changed, 21 insertions(+), 84 deletions(-)
 delete mode 100644 examples/publish-introspection.lisp

diff --git a/examples/publish-introspection.lisp b/examples/publish-introspection.lisp
deleted file mode 100644
index 6475f8d..0000000
--- a/examples/publish-introspection.lisp
+++ /dev/null
@@ -1,37 +0,0 @@
-;;;; +----------------------------------------------------------------+
-;;;; | DBUS                                                           |
-;;;; +----------------------------------------------------------------+
-
-(defpackage #:publish-introspection-example
-  (:use #:cl #:dbus)
-  (:export #:publish-introspection-example))
-
-(in-package #:publish-introspection-example)
-
-(defclass dbus-introspection-object
-    (introspection-mixin child-object-mixin dbus-object) ())
-
-(define-dbus-object root
-  (:path "/")
-  (:class dbus-introspection-object))
-
-(define-dbus-object my-service
-  (:path "/org/adeht/MyService")
-  (:class dbus-introspection-object)
-  (:parent root))
-
-(define-dbus-method (my-service my-method) ((s1 :string) (s2 :string)) (:string)
-  (:interface "org.adeht.MyService")
-  (concatenate 'string s1 s2))
-
-(define-dbus-signal-handler (my-service on-signal) ((s :string))
-  (:interface "org.adeht.MyService")
-  (format t "Got signal with arg ~S~%" s))
-
-(defun publish-example ()
-  (handler-case
-      (with-open-bus (bus (session-server-addresses))
-        (format t "Bus connection name: ~A~%" (bus-name bus))
-        (publish-objects bus))
-    (end-of-file ()
-      :disconnected-by-bus)))
diff --git a/examples/publish.lisp b/examples/publish.lisp
index d2efff6..291b9b0 100644
--- a/examples/publish.lisp
+++ b/examples/publish.lisp
@@ -8,8 +8,12 @@
 
 (in-package #:publish-example)
 
+(define-dbus-object root
+  (:path "/"))
+
 (define-dbus-object my-service
-  (:path "/org/adeht/MyService"))
+  (:path "/org/adeht/MyService")
+  (:parent root))
 
 (define-dbus-method (my-service my-method) ((s1 :string) (s2 :string)) (:string)
   (:interface "org.adeht.MyService")
diff --git a/publish.lisp b/publish.lisp
index 3d3468e..81d11d2 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -19,11 +19,7 @@
    #:define-dbus-object
    #:define-dbus-method
    #:define-dbus-signal-handler
-   #:publish-objects
-   #:dbus-object
-   #:child-object-mixin
-   #:introspection-mixin
-   #:introspection-document))
+   #:publish-objects))
 
 (in-package #:dbus/publish)
 
@@ -34,7 +30,7 @@
 
 (defvar *all-dbus-objects* '())
 
-(defclass dbus-object ()
+(defclass dbus-object (introspection-mixin child-object-mixin)
   ((name :initarg :name :reader dbus-object-name)
    (path :initarg :path :accessor dbus-object-path)
    (method-handlers :initform (make-hash-table :test 'equal) :reader dbus-object-method-handlers)
@@ -75,22 +71,17 @@
          (pushnew name *all-dbus-objects*)
          (setf (get name 'dbus-object) new-value))))
 
-(defun register-dbus-object (name path &optional dbus-object-sub-class)
+(defun register-dbus-object (name path)
   (check-type name symbol)
   (check-type path string)
   (if (find-dbus-object name)
       ;; If we already have an object with that name, just update its
       ;; path.
       (setf (dbus-object-path (find-dbus-object name)) path)
-      (if dbus-object-sub-class
-          (setf (find-dbus-object name)
-                (make-instance dbus-object-sub-class
-                               :name name
-                               :path path))
-          (setf (find-dbus-object name)
-                (make-instance 'dbus-object
-                               :name name
-                               :path path))))
+      (setf (find-dbus-object name)
+            (make-instance 'dbus-object
+                           :name name
+                           :path path)))
   name)
 
 (defun require-dbus-object (name)
@@ -102,34 +93,27 @@
              (shiftf name object (find-dbus-object object)))
         finally (return (values object (dbus-object-name object)))))
 
-(defmacro initialize-mixined-instance (name options)
+(defmacro initialize-dbus-object-instance (name options)
   (let ((parent nil) (class nil))
     (dolist (option options)
       (when (and (consp option) (eq (car option) :parent))
-        (setf parent (cadr option)))
-      (when (and (consp option) (eq (car option) :class))
-        (setf class (cadr option))))
+        (setf parent (cadr option))))
     `(progn
        (if ',parent
            (register-child-object (find-dbus-object ',name)
                                   (find-dbus-object ',parent)))
-       (if (subtypep ',class 'introspection-mixin)
-           (define-dbus-method (,name introspect) () (:string)
-                               (:interface "org.freedesktop.DBus.Introspectable")
-                               (introspection-document (find-dbus-object ',name)))))))
+       (define-dbus-method (,name introspect) () (:string)
+         (:interface "org.freedesktop.DBus.Introspectable")
+         (introspection-document (find-dbus-object ',name))))))
 
 (defmacro define-dbus-object (name &body options)
   (let ((path nil) (class nil))
     (dolist (option options)
       (when (and (consp option) (eq (car option) :path))
-        (setf path (cadr option)))
-      (when (and (consp option) (eq (car option) :class))
-        (setf class (cadr option))))
-    (if class
-        `(prog1
-             (register-dbus-object ',name ,path ',class)
-           (initialize-mixined-instance ,name ,options))
-        `(register-dbus-object ',name ,path))))
+        (setf path (cadr option))))
+    `(prog1
+         (register-dbus-object ',name ,path)
+       (initialize-dbus-object-instance ,name ,options))))
 
 ;;; Define handlers
 
@@ -296,20 +280,6 @@ sans dashes."
   (:documentation "Return the introspection document string for
 a particular DBUS  object."))
 
-(defmethod introspection-document ((object dbus-object))
-  (with-xml-output (make-string-sink)
-    (doctype "node"
-             "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"
-             "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
-    (with-element "node"
-      (let ((interfaces-handlers (collect-handlers-by-interface object)))
-        (loop for interface-name being the hash-keys of interfaces-handlers
-              using (hash-value handlers)
-              do (with-element "interface"
-                   (attribute "name" interface-name)
-                   (loop for h in handlers
-                         do (output-introspection-fragment h))))))))
-
 (defmethod introspection-document ((object child-object-mixin))
   (with-xml-output (make-string-sink)
     (doctype "node"

From 1f2cd57b9d3fbab653f65f7e1c2d115a13deb19c Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Sun, 29 Oct 2023 13:54:20 -0500
Subject: [PATCH 08/12] use string processing in relative-path-string

and issue an error when the child path isn't a child path of the
parent object
---
 publish.lisp | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/publish.lisp b/publish.lisp
index 81d11d2..7f8f79b 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -13,7 +13,6 @@
   (:import-from #:cxml
                 #:with-element #:attribute #:with-xml-output
                 #:doctype #:make-string-sink)
-  (:import-from #:uiop #:ensure-directory-pathname)
   (:export
    #:*all-dbus-objects*
    #:define-dbus-object
@@ -230,11 +229,17 @@ sans dashes."
   (:documentation "Return the introspection element for a thing."))
 
 (defmethod relative-path-string ((object child-object-mixin))
-  (enough-namestring
-   (dbus-object-path object)
-   (ensure-directory-pathname
-    (dbus-object-path
-     (find-dbus-object (dbus-object-parent-object-name object))))))
+  (let* ((object-path (dbus-object-path object))
+	 (parent-object-path
+	   (dbus-object-path
+	    (find-dbus-object (dbus-object-parent-object-name object))))
+	 (len (length parent-object-path)))
+    (if (string= parent-object-path (subseq object-path 0 len))
+	(if (string= "/" parent-object-path)
+	    (subseq object-path 1)
+	    (subseq object-path (+ len 1)))
+	(error (format nil "\"~a\" isn't a child object path of \"~a\""
+		       object-path parent-object-path)))))
 
 (defmethod output-introspection-fragment ((thing child-object-mixin))
   (with-element "node"

From 543f2696b149ae544a326aedd7610a03c7009fd9 Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Sun, 29 Oct 2023 14:02:19 -0500
Subject: [PATCH 09/12] change tab to spaces

---
 publish.lisp | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/publish.lisp b/publish.lisp
index 7f8f79b..a5dd578 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -230,16 +230,16 @@ sans dashes."
 
 (defmethod relative-path-string ((object child-object-mixin))
   (let* ((object-path (dbus-object-path object))
-	 (parent-object-path
-	   (dbus-object-path
-	    (find-dbus-object (dbus-object-parent-object-name object))))
-	 (len (length parent-object-path)))
+         (parent-object-path
+           (dbus-object-path
+            (find-dbus-object (dbus-object-parent-object-name object))))
+         (len (length parent-object-path)))
     (if (string= parent-object-path (subseq object-path 0 len))
-	(if (string= "/" parent-object-path)
-	    (subseq object-path 1)
-	    (subseq object-path (+ len 1)))
-	(error (format nil "\"~a\" isn't a child object path of \"~a\""
-		       object-path parent-object-path)))))
+        (if (string= "/" parent-object-path)
+            (subseq object-path 1)
+            (subseq object-path (+ len 1)))
+        (error (format nil "\"~a\" isn't a child object path of \"~a\""
+                       object-path parent-object-path)))))
 
 (defmethod output-introspection-fragment ((thing child-object-mixin))
   (with-element "node"

From 4225ce8a2164239b4ebb7eca09a78889be555bfb Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Sun, 29 Oct 2023 14:06:55 -0500
Subject: [PATCH 10/12] remove unnecessary export objects and unused local
 variable

---
 all.lisp     | 6 +-----
 publish.lisp | 4 ++--
 2 files changed, 3 insertions(+), 7 deletions(-)

diff --git a/all.lisp b/all.lisp
index 23f1b39..ecdd0a0 100644
--- a/all.lisp
+++ b/all.lisp
@@ -159,8 +159,4 @@
    #:define-dbus-object
    #:define-dbus-method
    #:define-dbus-signal-handler
-   #:publish-objects
-   #:dbus-object
-   #:child-object-mixin
-   #:introspection-mixin
-   #:introspection-document))
+   #:publish-objects))
diff --git a/publish.lisp b/publish.lisp
index a5dd578..745dd7b 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -93,7 +93,7 @@
         finally (return (values object (dbus-object-name object)))))
 
 (defmacro initialize-dbus-object-instance (name options)
-  (let ((parent nil) (class nil))
+  (let ((parent nil))
     (dolist (option options)
       (when (and (consp option) (eq (car option) :parent))
         (setf parent (cadr option))))
@@ -106,7 +106,7 @@
          (introspection-document (find-dbus-object ',name))))))
 
 (defmacro define-dbus-object (name &body options)
-  (let ((path nil) (class nil))
+  (let ((path nil))
     (dolist (option options)
       (when (and (consp option) (eq (car option) :path))
         (setf path (cadr option))))

From f4bb69f247f15a9532763021fa25d2f757813c05 Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Sun, 29 Oct 2023 19:56:57 -0500
Subject: [PATCH 11/12] compare the parent directory and child object path

Before this change, the child object check didn't catch a similar
parent directory.
---
 publish.lisp | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/publish.lisp b/publish.lisp
index 745dd7b..6414980 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -233,11 +233,13 @@ sans dashes."
          (parent-object-path
            (dbus-object-path
             (find-dbus-object (dbus-object-parent-object-name object))))
-         (len (length parent-object-path)))
-    (if (string= parent-object-path (subseq object-path 0 len))
-        (if (string= "/" parent-object-path)
-            (subseq object-path 1)
-            (subseq object-path (+ len 1)))
+         (parent-object-directory
+           (if (string= "/" parent-object-path)
+               parent-object-path
+               (concatenate 'string parent-object-path "/")))
+         (len (length parent-object-directory)))
+    (if (string= parent-object-directory (subseq object-path 0 len))
+        (subseq object-path len)
         (error (format nil "\"~a\" isn't a child object path of \"~a\""
                        object-path parent-object-path)))))
 

From cf1f49a84de030964efd89ee9a1e6dd033e88ac2 Mon Sep 17 00:00:00 2001
From: Kiso Katsuyuki <katsuyuki2388@gmail.com>
Date: Wed, 1 Nov 2023 23:26:40 -0500
Subject: [PATCH 12/12] dbus object works as it used to do if mixins are not
 inherited

---
 publish.lisp | 40 +++++++++++++++++++++++++---------------
 1 file changed, 25 insertions(+), 15 deletions(-)

diff --git a/publish.lisp b/publish.lisp
index 6414980..c375474 100644
--- a/publish.lisp
+++ b/publish.lisp
@@ -70,17 +70,22 @@
          (pushnew name *all-dbus-objects*)
          (setf (get name 'dbus-object) new-value))))
 
-(defun register-dbus-object (name path)
+(defun register-dbus-object (name path &optional dbus-object-sub-class)
   (check-type name symbol)
   (check-type path string)
   (if (find-dbus-object name)
       ;; If we already have an object with that name, just update its
       ;; path.
       (setf (dbus-object-path (find-dbus-object name)) path)
-      (setf (find-dbus-object name)
-            (make-instance 'dbus-object
-                           :name name
-                           :path path)))
+      (if dbus-object-sub-class
+          (setf (find-dbus-object name)
+                (make-instance dbus-object-sub-class
+                               :name name
+                               :path path))
+          (setf (find-dbus-object name)
+                (make-instance 'dbus-object
+                               :name name
+                               :path path))))
   name)
 
 (defun require-dbus-object (name)
@@ -92,27 +97,32 @@
              (shiftf name object (find-dbus-object object)))
         finally (return (values object (dbus-object-name object)))))
 
-(defmacro initialize-dbus-object-instance (name options)
-  (let ((parent nil))
+(defmacro initialize-mixined-instance (name &body options)
+  (let ((parent nil) (class 'dbus-object))
     (dolist (option options)
       (when (and (consp option) (eq (car option) :parent))
-        (setf parent (cadr option))))
+        (setf parent (cadr option)))
+      (when (and (consp option) (eq (car option) :class))
+        (setf class (cadr option))))
     `(progn
        (if ',parent
            (register-child-object (find-dbus-object ',name)
                                   (find-dbus-object ',parent)))
-       (define-dbus-method (,name introspect) () (:string)
-         (:interface "org.freedesktop.DBus.Introspectable")
-         (introspection-document (find-dbus-object ',name))))))
+       (if (subtypep ',class 'introspection-mixin)
+           (define-dbus-method (,name introspect) () (:string)
+                               (:interface "org.freedesktop.DBus.Introspectable")
+                               (introspection-document (find-dbus-object ',name)))))))
 
 (defmacro define-dbus-object (name &body options)
-  (let ((path nil))
+  (let ((path nil) (class 'dbus-object))
     (dolist (option options)
       (when (and (consp option) (eq (car option) :path))
-        (setf path (cadr option))))
+        (setf path (cadr option)))
+      (when (and (consp option) (eq (car option) :class))
+        (setf class (cadr option))))
     `(prog1
-         (register-dbus-object ',name ,path)
-       (initialize-dbus-object-instance ,name ,options))))
+         (register-dbus-object ',name ,path ',class)
+       (initialize-mixined-instance ,name ,@options))))
 
 ;;; Define handlers