Permalink
Browse files

REACTIVE-CLASS' superclass now properly defaults to REACTIVE-OBJECT.

  • Loading branch information...
1 parent 4080983 commit 77813183f7f512d8e115c2b0a34ac1a1045c60e8 @Lovesan committed Aug 21, 2011
Showing with 24 additions and 7 deletions.
  1. +24 −7 src/reactive-object.lisp
@@ -33,13 +33,30 @@
(finalize-inheritance (find-class 'reactive-object))
-(defmethod compute-class-precedence-list ((class reactive-class))
- (let ((cpl (call-next-method)))
- (if (find-if (lambda (c)
- (subtypep (class-name c) 'reactive-object))
- cpl)
- cpl
- (append cpl (list (find-class 'reactive-object))))))
+(defmethod shared-initialize :around
+ ((class reactive-class) slot-names
+ &rest initargs &key direct-superclasses &allow-other-keys)
+ (declare (ignore slot-names))
+ (remf initargs :direct-superclasses)
+ (let* ((found nil)
+ (direct-superclasses (mapcar (lambda (c)
+ (let* ((c (if (symbolp c)
+ (find-class c)
+ c))
+ (n (class-name c)))
+ (when (or (eq n 'reactive-object)
+ (subtypep n 'reactive-object))
+ (setf found t))
+ c))
+ direct-superclasses)))
+ (apply #'call-next-method
+ class
+ slot-names
+ :direct-superclasses (if found
+ direct-superclasses
+ (nconc direct-superclasses
+ (list (find-class 'reactive-object))))
+ initargs)))
(defvar *slot-direct-access* nil)

0 comments on commit 7781318

Please sign in to comment.