(in-package :contextl)
-;;; HACK: We are ending up with classes named NIL in the superclass list.
+
+(defmethod contextl:layer-name :around (layer)
+ (or (call-next-method) layer))
+
+;;; HACK:
+;;; Since i'm not using deflayer, ensure-layer etc,
+;;; There are a few places where contextl gets confused
+;;; trying to locate my description layers.
+
+;;; TODO: investigate switching to deflayer!
+
+(defun contextl::prepare-layer (layer)
+ (if (symbolp layer)
+ (if (eq (symbol-package layer)
+ (find-package :description-definers))
+ layer
+ (contextl::defining-layer layer))
+
+ layer))
+
+(defmethod find-layer-class :around ((layer symbol) &optional errorp environment)
+ (if (eq (symbol-package layer)
+ (find-package :description-definers))
+ (find-class layer)
+ (call-next-method)))
+
+
+;;; HACK: There are classes named NIL (partial classes) in the superclass list.
;;; These cannot be given the special object superclass when re-initializing
;;; is it will be in the subclasses superclasses AFTER this class, causing
;;; a confict.
(list
(find-class 'special-object)))
initargs)))
- (call-next-method))
\ No newline at end of file
+ (call-next-method))
+
+
+
+(defun funcall-with-special-initargs (bindings thunk)
+ (let ((arg-count 0))
+ (special-symbol-progv
+ (loop for (object . initargs) in bindings
+ for initarg-keys = (loop for key in initargs by #'cddr
+ collect key into keys
+ count t into count
+ finally (incf arg-count count)
+ (return keys))
+ nconc (loop for slot in (class-slots (class-of object))
+ when (and (slot-definition-specialp slot)
+ (intersection initarg-keys (slot-definition-initargs slot)))
+ collect (with-symbol-access
+ (slot-value object (slot-definition-name slot)))))
+ (make-list arg-count :initial-element nil)
+ (loop for (object . initargs) in bindings
+ do (apply #'shared-initialize object nil :allow-other-keys t initargs))
+ (funcall thunk))))
\ No newline at end of file