fixed the macros a little

[clinton/lisp-on-lines.git] / src / lisp-on-lines.lisp

diff --git a/src/lisp-on-lines.lisp b/src/lisp-on-lines.lisp
index 465ec5f..ca00bc5 100644 (file)
--- a/src/lisp-on-lines.lisp
+++ b/src/lisp-on-lines.lisp
@@ -30,33 +30,42 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
   `(define-view-for-table ,@(meta-model::list-tables)))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun %make-view (object type &rest attributes-and-args)
-    (let ((attributes (car attributes-and-args))
-         (args (cdr attributes-and-args)))
+  (defun %make-view (object type attributes args)
+   
+      (when attributes
+       (setf args
+             (cons `(:attributes ,attributes) args)))
       `(mewa:make-presentation
        ,object
        :type ,type
-       :initargs
-       '(,@ (when attributes
-              `(:attributes ,attributes))) 
-       ,@args)))) 
+       ,@(when args
+               `(:initargs
+                 '(,@ (mapcan #'identity args)))))))
 
-(defmethod make-view (object &rest args &key (type :viewer) (attributes nil)
+(defmethod make-view (object &rest args &key (type :viewer)
                      &allow-other-keys )
-  (apply #'make-presentation (cdr (%make-view object type (cons attributes args)))))
+  (remf args :type)
+  ;(warn "~A ~A" args `(:type ,type :initargs ,@args))
+  (apply #'make-presentation object `(:type ,type ,@ (when args
+                                                      `(:initargs ,args)))))
 
-(defmacro present-view ((object &optional (type :viewer))
+(defmacro present-view ((object &optional (type :viewer) (parent 'self))
                        &body attributes-and-args)
-  `(present ,(%make-view object type attributes-and-args)))
+  (arnesi:with-unique-names (view)
+    `(let ((,view (lol:make-view ,object
+                                :type ,type
+                                ,@(when (car attributes-and-args)
+                                        `(:attributes ',(car attributes-and-args))) 
+                                ,@ (cdr attributes-and-args))))
+      (setf (ucw::parent ,view) ,parent)
+      (lol:present ,view))))
 
 
 (defmacro call-view ((object &optional (type :viewer) (component 'self component-supplied-p))
-                    &body attributes-and-args)
-  
-  
+                    &body attributes-and-args)  
   `(ucw:call-component
     ,component
-    ,(%make-view object type attributes-and-args)))
+    ,(%make-view object type (car attributes-and-args) (cdr attributes-and-args))))
 
 (defmethod slot-view ((self mewa) slot-name)
   (mewa::find-attribute-slot self slot-name))
@@ -65,8 +74,6 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
   (present-slot (slot-view self slot-name) instance))
 
 
-
-
 (defmethod find-slots-of-type (model &key (type 'string)
                              (types '((string)) types-supplied-p))
   "returns a list of slots matching TYPE, or matching any of TYPES"
@@ -79,6 +86,10 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
             (lisp-on-lines::list-slot-types model)))))
 
 
+
+
+
+
 (defmethod word-search (class-name slots search-terms 
                        &key (limit 10) (where (sql-and t)))
   (select class-name 
@@ -104,3 +115,5 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
                              slots)))
           search-terms)))
 
+
+  
\ No newline at end of file