X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/fee2e08f5f30a1b3a0665c63d1c85c8576da449f..2b525992937f759211ea42e6e6f2bf0e695de96c:/mdw-mop.lisp diff --git a/mdw-mop.lisp b/mdw-mop.lisp index 7af8ad9..e744fcd 100644 --- a/mdw-mop.lisp +++ b/mdw-mop.lisp @@ -368,27 +368,27 @@ (defun print-object-with-slots (obj stream) "Prints objects in a pleasant way. Not too clever about circularity." (let ((class (class-of obj)) - (magic (cons 'magic nil))) + (magic (cons 'magic nil))) (print-unreadable-object (obj stream) (pprint-logical-block - (stream - (mapcan (lambda (slot) - (list (or (car (slot-definition-initargs slot)) - (slot-definition-name slot)) - (if (slot-boundp-using-class class obj slot) - (slot-value-using-class class obj slot) - magic))) - (class-slots class))) - (format stream "~S" (class-name class)) - (let ((sep nil)) - (loop - (pprint-exit-if-list-exhausted) - (if sep - (format stream " ~_") - (progn (format stream " ~@_~:I") (setf sep t))) - (let ((name (pprint-pop)) - (value (pprint-pop))) - (format stream "~S ~@_~:[~W~;#~*~]" - name (eq value magic) value)))))))) + (stream + (mapcan (lambda (slot) + (list (or (car (slot-definition-initargs slot)) + (slot-definition-name slot)) + (if (slot-boundp-using-class class obj slot) + (slot-value-using-class class obj slot) + magic))) + (class-slots class))) + (format stream "~S" (class-name class)) + (let ((sep nil)) + (loop + (pprint-exit-if-list-exhausted) + (if sep + (format stream " ~_") + (progn (format stream " ~@_~:I") (setf sep t))) + (let ((name (pprint-pop)) + (value (pprint-pop))) + (format stream "~S ~@_~:[~W~;#~*~]" + name (eq value magic) value)))))))) ;;;----- That's all, folks --------------------------------------------------