Update of /project/cl-store/cvsroot/cl-store/lispworks In directory common-lisp.net:/tmp/cvs-serv26326/lispworks
Modified Files: custom.lisp Log Message: Removed old documentation, added new docs.
Date: Mon Nov 1 15:32:02 2004 Author: sross
Index: cl-store/lispworks/custom.lisp diff -u cl-store/lispworks/custom.lisp:1.3 cl-store/lispworks/custom.lisp:1.4 --- cl-store/lispworks/custom.lisp:1.3 Wed Oct 13 14:36:03 2004 +++ cl-store/lispworks/custom.lisp Mon Nov 1 15:32:02 2004 @@ -84,4 +84,30 @@ (setting (slot-value slot-name) (restore-object stream))))) new-instance))
+ +;; Condition in lispworks have a reporter-function slot +;; which is sometimes a function (as opposed to a symbol) +;; Fortunately these slots are class allocated so +;; we ignore reporter functions and use make-condition +;; to reconstruct our object. +(defstore-cl-store (obj condition stream) + (output-type-code +condition-code+ stream) + (let ((*store-class-slots* nil)) + (store-type-object obj stream))) + + +(defrestore-cl-store (condition stream) + (let* ((class (find-class (restore-object stream))) + (length (restore-object stream)) + (new-instance (make-condition class))) + (loop repeat length do + (let ((slot-name (restore-object stream))) + ;; slot-names are always symbols so we don't + ;; have to worry about circularities + (resolving-object new-instance + (setting (slot-value slot-name) (restore-object stream))))) + new-instance)) + + + ;; EOF