X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/079b90842fc99823554991ff3e739da9a5d42d97..c29b2d2dda5ab82f7458666c154094693bfe9f1b:/src/utilities.lisp

diff --git a/src/utilities.lisp b/src/utilities.lisp
index 5dc0038..f8febce 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -1,5 +1,12 @@
 (in-package :lisp-on-lines)
 
+(defgeneric generic-format (stream string &rest args)
+  (:method (stream string &rest args)
+    (apply #'format stream string args)))
+
+
+
+
 (defun make-enclosing-package (name)
   (make-package name :use '()))
 
@@ -14,6 +21,16 @@
      (or (get symbol package)
          (setf (get symbol package) (gensym))))))
 
+(defmacro with-active-descriptions (descriptions &body body)
+       `(with-active-layers ,(mapcar #'defining-description descriptions)
+	  
+	 ,@body))
+
+(defmacro with-inactive-descriptions (descriptions &body body)
+       `(with-inactive-layers ,(mapcar #'defining-description descriptions)
+	  
+	 ,@body))
+
 #|
 Descriptoons are represented as ContextL classes and layers. To avoid nameclashes with other classes or layers, the name of a description is actually mappend to an internal unambiguous name which is used instead of the regular name.
 |#
@@ -23,26 +40,35 @@ Descriptoons are represented as ContextL classes and layers. To avoid nameclashe
   (make-enclosing-package "DESCRIPTION-DEFINERS"))
 
 (defun defining-description (name)
-  "Takes the name of a layer and returns its internal name."
+  "Takes the name of a description and returns its internal name."
   (case name
-    ((t) 't)
     ((nil) (error "NIL is not a valid description name."))
     (otherwise (enclose-symbol name *description-definers*))))
 
-
-(defmethod initargs.slot-names (class)
-  "Returns ALIST of (initargs) . slot-name."
-  (nreverse (mapcar #'(lambda (slot)
+(defmethod initargs.slots (class)
+  "Returns ALIST of (initargs) . slot."
+  (mapcar #'(lambda (slot)
 	      (cons (closer-mop:slot-definition-initargs slot)
-		    (closer-mop:slot-definition-name slot)))
-	  (closer-mop:class-slots class))))
+		    slot))
+		    (closer-mop:class-slots class)))
 
-(defun find-slot-name-from-initarg (class initarg)
+(defun find-slot-using-initarg (class initarg)
   (cdr (assoc-if #'(lambda (x) (member initarg x))
-				   (initargs.slot-names class))))
+				   (initargs.slots class))))
+
+(defun ensure-class-finalized (class)
+  (unless (class-finalized-p class)
+      (finalize-inheritance class)))
+
+(defun superclasses (class)
+  (ensure-class-finalized class)
+  (rest (class-precedence-list class)))
+  
   
 
 ;;;!-- TODO: this has been so mangled that, while working, it's ooogly! 
+;;;!-- do we still use this?
+
 (defun initargs-plist->special-slot-bindings (class initargs-plist)
   "returns a list of (slot-name value) Given a plist of initargs such as one would pass to :DEFAULT-INITARGS."
   (let ((initargs.slot-names-alist (initargs.slot-names class)))
@@ -52,5 +78,9 @@ Descriptoons are represented as ContextL classes and layers. To avoid nameclashe
 		  (when slot-name ;ignore invalid initargs. (good idea/bad idea?)
 		    (list slot-name value))))))
 
+(defun dprint (format-string &rest args)
+  (apply #'format t (concatenate 'string format-string "~%") args))
+
+