diff options
| -rw-r--r-- | src/data.lisp | 3 | ||||
| -rw-r--r-- | src/host.lisp | 8 | ||||
| -rw-r--r-- | src/package.lisp | 2 | ||||
| -rw-r--r-- | src/property/disk.lisp | 2 | ||||
| -rw-r--r-- | src/property/os.lisp | 6 | ||||
| -rw-r--r-- | src/propspec.lisp | 17 | ||||
| -rw-r--r-- | src/util.lisp | 25 |
7 files changed, 35 insertions, 28 deletions
diff --git a/src/data.lisp b/src/data.lisp index 640c057..e04802c 100644 --- a/src/data.lisp +++ b/src/data.lisp @@ -569,7 +569,8 @@ rework your deployment so that it does not end up in the propspec or hostattrs; see \"Pitfalls\" in the Consfigurator user manual. If ~:*~A is a simple object then you may be able to resolve this by defining -a PRINT-OBJECT method for your class." +a PRINT-OBJECT method for your class, possibly using +CONSFIGURATOR:DEFINE-PRINT-OBJECT-FOR-STRUCTLIKE." (print-not-readable-object c))))))) (defun request-lisp-systems () diff --git a/src/host.lisp b/src/host.lisp index f03c662..5c8b6e9 100644 --- a/src/host.lisp +++ b/src/host.lisp @@ -103,13 +103,7 @@ Called by properties which set up such subhosts, like CHROOT:OS-BOOTSTRAPPED." :propspec propspec :hostattrs (list* :parent-hostattrs (hostattrs *host*) hostattrs))) -(defmethod print-object ((host host) stream) - (format stream "#.~S" `(make-instance - ',(type-of host) - :hostattrs ',(slot-value host 'hostattrs) - :propspec ,(slot-value host 'propspec) - :deploy ',(slot-value host 'default-deployment))) - host) +(define-print-object-for-structlike host) (defmethod union-propspec-into-host ((host unpreprocessed-host) (propspec propspec)) diff --git a/src/package.lisp b/src/package.lisp index fe31025..019f5f4 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -65,6 +65,8 @@ #:plist-to-cmd-args #:with-local-temporary-directory #:pathname-file + #:quote-nonselfeval + #:define-print-object-for-structlike #:*consfigurator-debug-level* #:with-indented-inform diff --git a/src/property/disk.lisp b/src/property/disk.lisp index ecc26c8..7be1c61 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -58,6 +58,8 @@ plus any metadata (e.g. partition tables), this value will be ignored.")) (:documentation "Something which contains filesystems and/or other volumes.")) +(define-print-object-for-structlike volume) + (defgeneric volume-contents-minimum-size (volume) (:documentation "Return the minimum size required to accommodate the VOLUME-CONTENTS of VOLUME.")) diff --git a/src/property/os.lisp b/src/property/os.lisp index aceb24e..42d0c5c 100644 --- a/src/property/os.lisp +++ b/src/property/os.lisp @@ -35,11 +35,7 @@ :reader debian-suite :initform (error "Must provide suite")))) -(defmethod print-object ((os debian) stream) - (format stream "#.~S" `(make-instance ',(type-of os) - :arch ,(linux-architecture os) - :suite ,(debian-suite os))) - os) +(define-print-object-for-structlike debian) (defclass debian-stable (debian) ()) diff --git a/src/propspec.lisp b/src/propspec.lisp index 2e401f6..d1b95bd 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -208,22 +208,9 @@ systems." :systems systems :propspec propspec) (make-instance 'unpreprocessed-propspec :propspec propspec))) -(defmethod print-object ((propspec unpreprocessed-propspec) stream) - (format stream "#.~S" `(make-instance - 'unpreprocessed-propspec - :systems ',(slot-value propspec 'systems) - :propspec - ',(slot-value propspec 'propspec-expression))) - propspec) +(define-print-object-for-structlike preprocessed-propspec) -(defmethod print-object ((propspec preprocessed-propspec) stream) - (format stream "#.~S" `(make-instance - 'preprocessed-propspec - :systems ',(slot-value propspec 'systems) - :propspec - ',(slot-value propspec - 'preprocessed-propspec-expression))) - propspec) +(define-print-object-for-structlike unpreprocessed-propspec) ;; this could be defined for preprocessed propspecs easily enough but we ;; shouldn't need to append those diff --git a/src/util.lisp b/src/util.lisp index a1523d0..c611c65 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -149,6 +149,31 @@ one solution is to convert your property to a :LISP property." (namestring (enough-pathname pathname (pathname-directory-pathname pathname)))) +(defmacro quote-nonselfeval (x) + (once-only (x) + `(if (member (type-of ,x) '(cons symbol)) + `',,x ,x))) + +(defmacro define-print-object-for-structlike (class) + "Define an implementation of PRINT-OBJECT for objects which are simple +one-dimensional collections of values." + `(defmethod print-object ((object ,class) stream) + (if *print-readably* + (format + stream "#.~S" + `(make-instance + ',(type-of object) + ;; Call CLASS-OF so that subclasses of CLASS are handled too. + ,@(loop for slot in (closer-mop:class-slots (class-of object)) + for initargs = (closer-mop:slot-definition-initargs slot) + and slot-name = (closer-mop:slot-definition-name slot) + when (slot-boundp object slot-name) + collect (car initargs) + and collect (quote-nonselfeval + (slot-value object slot-name))))) + (call-next-method)) + object)) + ;;;; Progress & debug printing |