X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/d5e996b3f1e6f25053a3b13f661ab34697085c5c..8c6914bd27843fc74d07da3965fafaac09c85c4e:/src/lisp-on-lines.lisp

diff --git a/src/lisp-on-lines.lisp b/src/lisp-on-lines.lisp
index 465ec5f..a5415ae 100644
--- a/src/lisp-on-lines.lisp
+++ b/src/lisp-on-lines.lisp
@@ -9,6 +9,7 @@
 
 ;;;; ** Initialisation
 ;;;; The following macros are used to initialise a set of database tables as LoL objects.
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun generate-define-view-for-table (table)
     "
@@ -30,33 +31,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)))
-      `(mewa:make-presentation
+  (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 +75,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 +87,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 
@@ -90,8 +102,7 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
 
 
 (defmethod word-search (class-name slots (s string) &rest args)
-  (apply #'word-search class-name slots 
-	 (split-sequence:split-sequence #\Space s) args))
+  (apply #'word-search class-name slots (list s) args))
 
 (defmethod word-search-where (class-name slots search-terms &key (format-string "%~a%"))
   (sql-or 
@@ -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