[cl-store-cvs] CVS update: cl-store/clisp/fix-clisp.lisp

[Sean Ross]

Update of /project/cl-store/cvsroot/cl-store/clisp
In directory common-lisp.net:/tmp/cvs-serv6976/clisp

Modified Files:
	fix-clisp.lisp 
Log Message:
Changelog 2004-05-21

Date: Fri May 21 10:14:41 2004
Author: sross

Index: cl-store/clisp/fix-clisp.lisp
diff -u cl-store/clisp/fix-clisp.lisp:1.1 cl-store/clisp/fix-clisp.lisp:1.2
--- cl-store/clisp/fix-clisp.lisp:1.1	Tue May 18 10:56:29 2004
+++ cl-store/clisp/fix-clisp.lisp	Fri May 21 10:14:41 2004
@@ -45,4 +45,20 @@
   (or (clos::class-direct-superclasses class)
       (list (find-class 'standard-object))))
 
+
+(defun add-methods-for-class (class vals)
+  (let ((readers (mappend #'(lambda (x)
+                             (second (member :readers x)))
+                         vals))
+        (writers (mappend #'(lambda (x)
+                              (second (member :writers x)))
+                          vals)))
+    (loop for x in readers do
+      (eval `(defmethod ,x ((clos::object ,class))
+               (slot-value clos::object ',x))))
+    (loop for x in writers do
+      (eval `(defmethod ,x (clos::new-value (clos::object ,class))
+               (setf (slot-value clos::object ',x) clos::new-value))))
+    (find-class class)))
+
 ;; EOF