[cl-store-cvs] CVS update: cl-store/lispworks/custom.lisp

[Sean Ross]

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