From b8c8985156e0ce7de77973d5899221116dcc3c96 Mon Sep 17 00:00:00 2001
From: Drew Crampsie <drewc@tech.coop>
Date: Mon, 5 Dec 2005 22:39:50 -0800
Subject: [PATCH] Massive patch to catch up to ucw_dev

This Patch breaks backwards compatability in a number of ways.

** None of the presentation stuff is exported anymore. UCW now exports the same symbols, and LoL is moving away from the presentation system anyway.
** The ajax stuff is broken and will soon be removed completely in favour of some dojo stuff i've got.

This makes it difficult to create your own components for use with Mewa. The ContextL based system is coming soon.

darcs-hash:20051206063950-5417e-35fe4437c7bd94ccbe149513709d48470c2c9c45.gz
---
 src/components/ajax.lisp    | 40 ++++++++++---------------------------
 src/lisp-on-lines.lisp      |  7 ++++---
 src/packages.lisp           | 37 ++++++++++++++++++++++++++--------
 src/presentations.lisp      | 10 +++++++---
 src/slot-presentations.lisp | 31 +++++++++++++++-------------
 5 files changed, 68 insertions(+), 57 deletions(-)

diff --git a/src/components/ajax.lisp b/src/components/ajax.lisp
index 9092f24..6b4f23f 100644
--- a/src/components/ajax.lisp
+++ b/src/components/ajax.lisp
@@ -30,7 +30,7 @@
     :documentation  "The lisp value of the object selecting in the drop down")
    (as-value :accessor as-value :initarg :as-value
              :documentation "Function which, when passed a value, returns the string to put in the text box.")
-   (render :accessor render :initarg :render
+   (render-it :accessor render-it :initarg :render
            :documentation "Function which, when passed the component and one of the values render it (the value).")
    (input-size :accessor input-size :initarg :input-size :initform 20)
    (submit-on-select-p 
@@ -71,30 +71,11 @@ but here's what i use."
   `(generate-ajax-request
     (make-action-url ,component (progn ,@action)))) 
 	
-(defaction call-auto-complete ((self t) auto-complete-id value index)
-    (let ((auto-complete (get-session-value (intern auto-complete-id))))
-    (if auto-complete
-        (if index
-	    (select-value auto-complete index)
-	    (call-auto-complete-from-output auto-complete auto-complete-id value self))
-        (call 'empty-page :message (error "Cannot find")))))
-
-(defaction call-auto-complete-from-output ((auto-complete auto-complete) auto-complete-id value output)
-  (setf (client-value auto-complete) value)
-  (let ((self output))
-    (call (output-component-name auto-complete) :auto-complete auto-complete)
-    (call 'empty-page :message (error "ASD"))))
-
-(defaction select-value ((self auto-complete) index)
-  (let ((index (when (< 0 (length index))
-		 (parse-integer index))))
-    (setf (index self) index)
-    (setf (value self) (nth index (list-of-values self)))))
 
 (defun make-auto-complete-url (input-id)
   "creates a url that calls the auto-complete entry-point for INPUT-ID."
   (format nil "auto-complete.ucw?&auto-complete-id=~A&~A=~A" 
-	  input-id  ucw::+session-parameter-name+ 
+	  input-id  "session"  
 	  (ucw::session.id (ucw::context.session ucw::*context*))))
 
 (defaction on-submit ((l auto-complete))
@@ -111,7 +92,7 @@ but here's what i use."
       (submit-form))))
    
 
-(defmethod render-on ((res response) (l auto-complete))
+(defmethod render ( (l auto-complete))
   ;; session-values are stored in an eql hash table.
   (let ((input-key (intern (input-id l))))
     ;; We are storing the input components in the session,
@@ -154,7 +135,7 @@ but here's what i use."
 (defcomponent auto-complete-output (window-component)
   ((auto-complete :initarg :auto-complete :accessor auto-complete)))
 
-(defmethod render-on ((res response) (output auto-complete-output))
+(defmethod render ((output auto-complete-output))
   (let ((auto-complete (auto-complete output)))
     (setf (list-of-values auto-complete)
 	  (funcall (values-generator auto-complete) (client-value auto-complete)))
@@ -163,7 +144,8 @@ but here's what i use."
      (arnesi:dolist* (value (list-of-values auto-complete))
        (<:li 
 	:class "auto-complete-list-item"
-	(funcall (render auto-complete) value))))))
+	(funcall (render-it auto-complete) value))))
+    (answer-component output t)))
 
 (defcomponent fkey-auto-complete (auto-complete)
   ())
@@ -197,7 +179,7 @@ but here's what i use."
 	    (word-search class-name  
 			 (search-slots slot)  input)))
 		    
-    (setf (lisp-on-lines::render l)
+    (setf (lisp-on-lines::render-it l)
 	  (lambda (val) 
 	    (<ucw:render-component 
 	     :component (make-presentation val :type :one-line))))))
@@ -216,7 +198,7 @@ but here's what i use."
 		   (when (presentation-slot-value slot instance) 
 		     (meta-model:explode-foreign-key instance (slot-name slot)))))))
     
-    (flet ((render () (when foreign-instance (call-next-method))))
+    (flet ((render-s () (when foreign-instance (call-next-method))))
       (if (slot-boundp slot 'ucw::place)
 	  (cond 
 	    ((editablep slot)
@@ -233,8 +215,8 @@ but here's what i use."
 			      (<ucw:submit :action  (mewa::search-records slot instance) :value "find" :style "display:inline"))
 	    ((mewa::linkedp slot)
 	     (<ucw:a :action (mewa::view-instance slot foreign-instance) 
-		     (render)))
+		     (render-s)))
 	    (t       
-	     (render)))
+	     (render-s)))
 	  ;; presentation is used only for rendering
-	  (render)))))
\ No newline at end of file
+	  (render-s)))))
\ No newline at end of file
diff --git a/src/lisp-on-lines.lisp b/src/lisp-on-lines.lisp
index 31892be..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)
     "
@@ -35,7 +36,7 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
       (when attributes
 	(setf args
 	      (cons `(:attributes ,attributes) args)))
-      `(mewa:make-presentation
+      `(mewa::make-presentation
 	,object
 	:type ,type
 	,@(when args
@@ -52,13 +53,13 @@ This involves creating a meta-model, a clsql view-class, and the setting up the
 (defmacro present-view ((object &optional (type :viewer) (parent 'self))
 			&body attributes-and-args)
   (arnesi:with-unique-names (view)
-    `(let ((,view (lol:make-view ,object
+    `(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))))
+      (lol::present ,view))))
 
 
 (defmacro call-view ((object &optional (type :viewer) (component 'self component-supplied-p))
diff --git a/src/packages.lisp b/src/packages.lisp
index 4b5e552..c97a07c 100644
--- a/src/packages.lisp
+++ b/src/packages.lisp
@@ -6,10 +6,36 @@
 	:it.bese.ucw
 	:clsql
 	:contextl)
+  (:nicknames :lol :mewa)
+  
   (:shadowing-import-from
    :iterate
    :with)
-  (:nicknames :lol :mewa)
+
+  (:shadowing-import-from
+   :clsql
+   :time-difference
+   :make-time
+   :time-ymd
+   :date
+   :get-time
+   :time-element
+   :time+
+   :date-element)
+
+  (:shadow
+   :present
+   :present-slot
+   :presentation
+   :instance
+   :slot-presentation
+   :integer-slot-presentation
+   :string-slot-presentation
+   :object-presentation
+   :one-line-presentation
+   :presentation-slot-value
+   :get-foreign-instances)
+  
   (:export 
    ;;;; LoL 
    :define-view-for-table
@@ -43,8 +69,6 @@
    :define-attributes
 
    ;; presentation objects
-   :present
-   :instance
    :mewa-object-presentation
    :mewa-one-line-presentation
    :mewa-list-presentation
@@ -54,13 +78,10 @@
    :editablep
    :global-properties
    ;; SLOT presentations
-   :defslot-presentation
-   :slot-name
+  
    :mewa-relation-slot-presentation
    :mewa-string-slot-presentation
-   :has-many-slot-presentation
-   :present-slot
-
+   :has-many-slot-presentation 
    :has-a
    :has-many
    :has-very-many
diff --git a/src/presentations.lisp b/src/presentations.lisp
index 64f3c24..901548a 100644
--- a/src/presentations.lisp
+++ b/src/presentations.lisp
@@ -1,11 +1,15 @@
 (declaim (optimize (speed 0) (space 3) (safety 0)))
 (in-package :lisp-on-lines)
 
+
+(defmethod render ((self mewa))
+  (lol::present self))
+
 (defaction edit-instance ((self mewa))
   (call-presentation (instance self) :type :editor))
 
 ;;;one-line objects
-(defcomponent mewa-one-line-presentation (mewa one-line-presentation)
+(defcomponent mewa-one-line-presentation (mewa lol::one-line-presentation)
   ()
   (:default-initargs
    :attributes-getter #'one-line-attributes-getter
@@ -16,7 +20,7 @@
       (meta-model::list-keys (instance self))))
 
 ;;;objects
-(defcomponent mewa-object-presentation (mewa object-presentation) 
+(defcomponent mewa-object-presentation (mewa lol::object-presentation) 
   ((instance :accessor instance :initarg :instance :initform nil)))
 
 (defcomponent mewa-viewer (mewa-object-presentation)
@@ -37,7 +41,7 @@
     (dolist (slot (slots pres))
       (<:tr :class "presentation-slot-row"
 	    (present-slot-as-row pres slot))))
-    (render-options pres (instance pres)))
+  (render-options pres (instance pres)))
         
 (defmethod present-slot-as-row ((pres mewa-object-presentation) (slot slot-presentation))
   (<:td :class "presentation-slot-label" (<:as-html (label slot)))
diff --git a/src/slot-presentations.lisp b/src/slot-presentations.lisp
index c92fa4b..02fb818 100644
--- a/src/slot-presentations.lisp
+++ b/src/slot-presentations.lisp
@@ -1,4 +1,7 @@
+;; i know this is horrible, but it works wonders.
 (declaim (optimize (speed 0) (space 3) (safety 0)))
+
+
 (in-package :lisp-on-lines)
 
 
@@ -95,12 +98,12 @@ When T, only the default value for primary keys and the joins are updated.")
 	(default-to-now-p :accessor default-to-now-p :initarg :default-to-now-p :initform nil))
        (:type-name clsql-sys:wall-time))
 
-(defmethod presentation-slot-value ((slot clsql-wall-time-slot-presentation) instance)
+(defmethod lol::presentation-slot-value ((slot clsql-wall-time-slot-presentation) instance)
   (let ((date (call-next-method)))
     (when date (multiple-value-bind (y m d) (clsql:time-ymd date)
       (format nil "~a/~a/~a" m d y)))))
 
-(defmethod (setf presentation-slot-value) ((value string) (slot clsql-wall-time-slot-presentation) instance)
+(defmethod (setf lol::presentation-slot-value) ((value string) (slot clsql-wall-time-slot-presentation) instance)
   (let ((new-time (clsql:parse-date-time (remove #\Space value)))
 	(old-time (when (slot-boundp instance (slot-name slot))
 		    (slot-value instance (slot-name slot)))))
@@ -112,17 +115,17 @@ When T, only the default value for primary keys and the joins are updated.")
 (defmethod label :around ((slot clsql-wall-time-slot-presentation))
   (concatenate 'string (call-next-method) "  (m/d/y)"))
 
-(defmethod present-slot ((slot clsql-wall-time-slot-presentation) instance)
-  (let ((date (presentation-slot-value slot instance)))
+(defmethod lol::present-slot ((slot clsql-wall-time-slot-presentation) instance)
+  (let ((date (lol::presentation-slot-value slot instance)))
     ;; Default values
     (when (and (not date) (default-to-now-p slot))
-      (setf (presentation-slot-value slot instance) (clsql:get-time)))
+      (setf (lol::presentation-slot-value slot instance) (clsql:get-time)))
     ;;simple viewer
     (if (and date (not (editablep slot)))
 	(<:as-html date))
     ;; editor
     (when (editablep slot)
-      (<ucw:input :accessor (presentation-slot-value slot instance) :id (input-id slot) :style "display:inline")
+      (<ucw:input :accessor (lol::presentation-slot-value slot instance) :id (input-id slot) :style "display:inline")
       (<:button :id (trigger-id slot) (<:as-html "[...]"))
       (<:script :type "text/javascript" 
 		(<:as-is (format nil " 
@@ -217,7 +220,7 @@ Calendar.setup({
 
 (defmethod  present-slot :around ((slot foreign-key-slot-presentation) instance)  
   (setf (foreign-instance slot) 
-	(when (presentation-slot-value slot instance) 
+	(when (lol::presentation-slot-value slot instance) 
 	  (meta-model:explode-foreign-key instance (slot-name slot))))
   (flet ((render () (when (foreign-instance slot)(call-next-method))))
     (if (slot-boundp slot 'ucw::place)
@@ -299,7 +302,7 @@ Calendar.setup({
 (defmethod get-foreign-instances ((slot has-many-slot-presentation) instance)
   (slot-value instance (slot-name slot)))
 
-(defmethod presentation-slot-value ((slot has-many-slot-presentation) instance)
+(defmethod lol::presentation-slot-value ((slot has-many-slot-presentation) instance)
   (get-foreign-instances slot instance))
 
 (defslot-presentation has-very-many-slot-presentation (has-many-slot-presentation)
@@ -360,24 +363,24 @@ Calendar.setup({
 		:flatp t))
 
 (defmethod present-slot ((slot has-a-slot-presentation) instance)
-;      (<:as-html (presentation-slot-value slot instance))
+;      (<:as-html (lol::presentation-slot-value slot instance))
   (if (editablep slot)
-      (progn (<ucw:select :accessor (presentation-slot-value slot instance) :test #'equalp
+      (progn (<ucw:select :accessor (lol::presentation-slot-value slot instance) :test #'equalp
         (when (allow-nil-p slot)
 	  (<ucw:option :value nil (<:as-html "none")))
 	(dolist (option (get-foreign-instances slot instance))
 	  (<ucw:option :value (find-foreign-slot-value slot option)
-		       (lol:present
-			(lol:make-presentation option
+		       (lol::present
+			(lol::make-presentation option
 			   :type :as-string
 			   :initargs
 			   `(:attributes ,(attributes slot)))
 			))))
 	     (when (creatablep slot)
 	       (<ucw:submit :action  (create-record-on-foreign-key slot instance) :value "Add New" :style "display:inline"))) 
-      (if (presentation-slot-value slot instance)
+      (if (lol::presentation-slot-value slot instance)
 	  (progn
-	   (lol:present
+	   (lol::present
 	    (lol:make-presentation (meta-model:explode-foreign-key instance (slot-name slot))
 			   :type :one-line
 			   :initargs
-- 
2.20.1