From 4644082451f92f7a060e47be6b9967acf8412c7f Mon Sep 17 00:00:00 2001
From: drewc <drewc@tech.coop>
Date: Tue, 10 Feb 2009 17:41:32 -0800
Subject: [PATCH] minor updates to work with released ucw-core

darcs-hash:20090211014132-39164-045377afa026ab6214332a167905410cf541a897.gz
---
 lisp-on-lines-ucw.asd                   |   2 +-
 src/display.lisp                        |   2 +
 src/standard-descriptions/list.lisp     |  20 +++-
 src/standard-descriptions/t.lisp        |  26 ++++-
 src/standard-descriptions/validate.lisp |  22 +++--
 src/ucw/html-description.lisp           |  13 +--
 src/ucw/lol-components.lisp             |   5 +-
 src/ucw/packages.lisp                   | 125 +++++-------------------
 src/ucw/standard-components.lisp        |  77 +++++++--------
 9 files changed, 124 insertions(+), 168 deletions(-)
 rewrite src/ucw/packages.lisp (78%)

diff --git a/lisp-on-lines-ucw.asd b/lisp-on-lines-ucw.asd
index 92d4d78..0764921 100644
--- a/lisp-on-lines-ucw.asd
+++ b/lisp-on-lines-ucw.asd
@@ -11,7 +11,7 @@
 			:components
 			((:module :ucw
 				  :components ((:file "packages")
-					       (:file "lol-tags")
+					       
 					       (:file "standard-components")
 					       (:file "contextl-components")
 					       (:file "html-description")
diff --git a/src/display.lisp b/src/display.lisp
index a0be611..7de1c63 100644
--- a/src/display.lisp
+++ b/src/display.lisp
@@ -22,6 +22,7 @@
 
 
 (defun display (display object &rest args &key deactivate activate &allow-other-keys)
+
   (funcall-with-layer-context 
    (modify-layer-context (current-layer-context) 
 			 :activate activate 
@@ -32,6 +33,7 @@
 (define-layered-method display-using-description 
   :around (description display object &rest args)
   (declare (ignorable args))
+#+nil  (break "Entering DISPLAY for ~A on ~A using ~A" object display description)
   (let ((*display* display))
     (apply #'funcall-with-described-object 
      (lambda ()
diff --git a/src/standard-descriptions/list.lisp b/src/standard-descriptions/list.lisp
index 133ee69..1d5737d 100644
--- a/src/standard-descriptions/list.lisp
+++ b/src/standard-descriptions/list.lisp
@@ -6,8 +6,24 @@
 
 (define-layered-method display-attribute-value 
   ((attribute list-attribute))
-  (arnesi:dolist* (item (attribute-value attribute))
-    (apply #'display *display* item (slot-value attribute 'item-args))))
+  (generic-format *display* "(")
+  (let ((list (attribute-value attribute)))
+    
+    (loop 
+       :for cons :on list
+       :do (let ((item (first cons
+)))
+	     	 (break "Display T ~A" item) 
+	     (dletf (((attribute-object attribute) item))
+	       (apply #'display *display* item (slot-value attribute 'item-args))
+	       (unless (endp (cdr cons))
+		 (generic-format *display* " "))))))
+  (generic-format *display* ")"))
+	   
+       
+ 
+	   
+
 
 (define-description list ()
  ((list :attribute-class list-attribute
diff --git a/src/standard-descriptions/t.lisp b/src/standard-descriptions/t.lisp
index 2f77c47..5baf369 100644
--- a/src/standard-descriptions/t.lisp
+++ b/src/standard-descriptions/t.lisp
@@ -52,14 +52,25 @@
 		    :activate (attribute-active-descriptions attribute)
 		    :deactivate (attribute-inactive-descriptions attribute)
 		    args)))
-	     
+
+
     (let ((val (attribute-value attribute)))
+#+nil            (break "display Attribute value: ~A with object ~A ~% Description ~A att-d ~A ~% VALUE ~A display on ~A" 
+		   	 attribute 
+			 (attribute-object attribute)
+			 *description*
+			 (attribute-description attribute)
+			 val
+			 *display*
+			 )
       (if (and (not (slot-boundp attribute 'active-attributes))
-	       (eql val (attribute-object attribute)))
-	  (generic-format *display* (funcall (attribute-value-formatter attribute) val))
+	       (equal val (attribute-object attribute)))
+	  (progn (generic-format *display* "~A"(funcall (attribute-value-formatter attribute) val))		 
+		 #+nil(break "using generic format because val is object and there is no active attributes."))
+	  
 	  (with-active-descriptions (inline)
 	    (cond ((slot-value attribute 'value-formatter)
-		   (generic-format *display* (funcall (attribute-value-formatter attribute) val)))
+		   (generic-format *display* "~A"(funcall (attribute-value-formatter attribute) val)))
 		   ((slot-boundp attribute 'active-attributes)
 		    (disp val :attributes (slot-value attribute 'active-attributes)))
 		   (t
@@ -83,7 +94,12 @@
 
 (define-layered-method display-attribute :before
   ((attribute standard-attribute))
-)
+#+nil  (break "Attribute : ~A with object ~A ~% Description ~A att-d ~A" 
+	 attribute 
+	 (attribute-object attribute)
+	 *description*
+	 (attribute-description attribute)
+))
 
 (define-display ((description t))
  (let ((attributes (attributes description)))
diff --git a/src/standard-descriptions/validate.lisp b/src/standard-descriptions/validate.lisp
index d98a787..5a5fb62 100644
--- a/src/standard-descriptions/validate.lisp
+++ b/src/standard-descriptions/validate.lisp
@@ -50,7 +50,7 @@
   (setf (gethash name *validators*) fn))
 
 (defun find-validator (name)
-  (gethash name *validators*))
+   (gethash name *validators*))
 
 (register-validator 'boundp 
  (lambda (a v)
@@ -63,22 +63,24 @@
 				 :object (attribute-object a))))
        t)))
 
-(defun validp (object)
 
+
+(defun validp (object)
   (with-described-object (object nil)
     (every #'identity (mapcar (lambda (attribute)
-					     (validate-attribute-value attribute (attribute-value attribute)))
-					   (attributes (description-of object))))))
+				(validate-attribute-value attribute (attribute-value attribute)))
+			      (attributes (description-of object))))))
 
 (define-layered-method lol::display-attribute-editor 
   :in-layer #.(defining-description 'validate)
   :after (attribute)
-  (let ((conditions (remove-if-not (lambda (a)
- (eq a attribute)) 
-				     (gethash 
-				      (attribute-object attribute) 
-				      lol::*invalid-objects*)
-				     :key #'car)))
+  (let ((conditions (remove-if-not 
+		     (lambda (a)
+		       (eq a attribute)) 
+			(gethash 
+			 (attribute-object attribute) 
+			 lol::*invalid-objects*)
+			:key #'car)))
     (dolist (c conditions)
       (<:div :style "color:red"
 	      (<:as-html 
diff --git a/src/ucw/html-description.lisp b/src/ucw/html-description.lisp
index 1bc264b..83847ed 100644
--- a/src/ucw/html-description.lisp
+++ b/src/ucw/html-description.lisp
@@ -4,11 +4,10 @@
 
 (defvar *escape-html* t)
 
-(defmethod generic-format ((display lol-ucw:component) string &rest args)
+(defmethod generic-format ((display ucw-core:component) string &rest args)
   (<:as-html (with-output-to-string (stream)
 	       (apply #'call-next-method stream string args))))
       
-
 (define-description html-description ()
   ())
 
@@ -115,7 +114,7 @@
 	val)))
 
 (defmethod display-html-attribute-editor (attribute editor)
-  (<lol:input :type "text"
+  (<ucw:input :type "text"
 	      :reader (html-attribute-value attribute)
 	      :writer (make-attribute-value-writer attribute)))
 
@@ -123,7 +122,7 @@
   (call-next-method))
 
 (defmethod display-html-attribute-editor (attribute (editor password-attribute-editor))
-  (<lol:input :type "password"
+  (<ucw:input :type "password"
 	      :reader (html-attribute-value attribute)
 	      :writer (make-attribute-value-writer attribute)))
 
@@ -201,7 +200,7 @@ clear: left;
 
 (define-display 
   :in-description html-description ((description t) 
-				    (display lol-ucw:component) 
+				    (display ucw-core:component) 
 				    object)
   (display-html-description description display object (lambda ()
 							 (call-next-method))))
@@ -212,4 +211,6 @@ clear: left;
     (when (listp  val) 
       (<:ul
        (arnesi:dolist* (item (attribute-value attribute))
-	 (<:li (apply #'display *display* item (slot-value attribute 'item-args))))))))
\ No newline at end of file
+
+	 (dletf (((attribute-object attribute) item))
+	   (<:li (apply #'display *display* item (slot-value attribute 'item-args)))))))))
\ No newline at end of file
diff --git a/src/ucw/lol-components.lisp b/src/ucw/lol-components.lisp
index 3a502c4..395c8a1 100644
--- a/src/ucw/lol-components.lisp
+++ b/src/ucw/lol-components.lisp
@@ -1,7 +1,8 @@
 (in-package :lol-ucw)
 
-(defcomponent lol-component ()
-  ())
+(defclass lol-component ()
+  ()
+  (:metaclass standard-component-class))
 
 (defmethod output-component ((self lol-component))
   self)
diff --git a/src/ucw/packages.lisp b/src/ucw/packages.lisp
dissimilarity index 78%
index 0a35539..4d97207 100644
--- a/src/ucw/packages.lisp
+++ b/src/ucw/packages.lisp
@@ -1,103 +1,22 @@
-
-(defpackage lisp-on-lines-ucw
-  (:documentation "An LoL Layer over ucw.basic")
-  (:nicknames #:lol-ucw)
-  (:use #:lisp-on-lines #:ucw-core :common-lisp :arnesi :yaclml :js :contextl)
-
-  (:shadowing-import-from :js
-   #:new)  
-  (:shadowing-import-from :ucw-core
-   #:parent )
-  (:import-from :ucw-standard 
-	#:call #:answer	#:defaction #:*source-component*)
-  
-
-		
-  (:export 
-
-   ;;; First, LOL-UCW exports. The rest are from UCW.
-   #:lol-component
-   #:*source-component*
-   #:defcomponent
-
-   #:uri.query
-   
-   ;; Standard Server
-   #:standard-server
-   #:startup-server
-   #:shutdown-server
-
-
-   ;; Sessions
-   #:get-session-value
-   ;; Standard Application
-   #:standard-application
-   #:register-application
-   #:service
-
-   ;; Standard Request Context
-   #:*context*
-   #:context.current-frame
-   #:context.window-component
-   #:*current-component*
-
-   ;; Actions
-   #:call
-   #:answer
-   #:make-action
-   #:find-action
-   #:defaction
-   #:defmethod/cc
-
-   #:call-component
-   #:answer-component
-
-   ;; Entry Points   
-   #:defentry-point
-
-   ;; Standard Components
-   #:render
-   #:render-html-body
-   #:component
-
-   #:standard-component-class
-   #:described-component-class
-
-   #:container
-   #:find-component
-   
-   #:standard-window-component ;*
-   #:window-body
-   #:info-message
-
-   ))
-
-(defpackage :lisp-on-lines-tags
-  (:documentation "LoL convience yaclml tags.")
-  (:use)
-  (:nicknames #:<lol)
-  (:export
-   #:component-body
-   #:render-component
-   #:a
-   #:area
-   #:form
-   #:input
-   #:button
-   #:simple-select
-   #:select
-   #:option
-   #:textarea
-
-   #:integer-range-select
-   #:month-day-select
-   #:month-select
-
-   #:text
-   #:password
-   #:submit
-   #:simple-form
-   #:simple-submit
-
-   #:localized
-   #:script))
\ No newline at end of file
+
+(defpackage lisp-on-lines-ucw
+  (:documentation "An LoL Layer over ucw.basic")
+  (:nicknames #:lol-ucw)
+  (:use #:lisp-on-lines #:ucw :ucw-core :common-lisp :arnesi)
+
+  (:shadowing-import-from :js
+   #:new)  
+  (:shadowing-import-from :ucw-core
+   #:parent )
+  (:import-from :ucw-standard 
+	#:call #:answer	#:defaction #:*source-component*)
+  
+
+		
+  (:export 
+
+   ;;; First, LOL-UCW exports. The rest are from UCW.
+   #:lol-component
+   
+   #:described-component-class))
+
diff --git a/src/ucw/standard-components.lisp b/src/ucw/standard-components.lisp
index c017657..9aea34d 100644
--- a/src/ucw/standard-components.lisp
+++ b/src/ucw/standard-components.lisp
@@ -10,7 +10,6 @@
 (setf ucw-standard::*default-action-class* 'lisp-on-lines-action)
 
 
-
 (defmethod ucw-core:call-action :around ((action lisp-on-lines-action) application session frame)
   (let ((next-method (lambda ()
 		       (layered-call-action 
@@ -19,7 +18,7 @@
 			  (call-next-method))))))
     (let ((layer-context (action-layer-context action)))
       (if layer-context 
-	  (funcall-with-layer-context layer-context next-method)
+	  (contextl:funcall-with-layer-context layer-context next-method)
 	  (funcall next-method)))
     ))
 
@@ -37,7 +36,7 @@
        (call-next-method))))
 
 
-(define-layered-function layered-call-action (action application session frame next-method)
+(contextl:define-layered-function layered-call-action (action application session frame next-method)
   (:method (action application session frame next-method)
     (funcall next-method)))
 
@@ -56,41 +55,41 @@
 
 
 
-(defcomponent standard-window-component 
-  (ucw-standard::basic-window-component)
-  ((body
-    :initform nil
-    :accessor window-body
-    :component t
-    :initarg :body)))
-
-(defmethod render-html-head ((window standard-window-component))
-  (let* ((app (context.application *context*))
-	 (url-prefix (application.url-prefix app)))
-    (<:meta :http-equiv "Content-Type" :content (window-component.content-type window))
-    (awhen (window-component.title window)
-      (<:title (if (functionp it)
-		   (funcall it window)
-		   (<:as-html it))))
-    (awhen (window-component.icon window)
-      (<:link :rel "icon"
-	      :type "image/x-icon"
-	      :href (concatenate 'string url-prefix it)))
-    (dolist (stylesheet (effective-window-stylesheets window))
-      (<:link :rel "stylesheet"
-	      :href stylesheet
-	      :type "text/css"))))
-
-(defmethod render-html-body ((window standard-window-component))
-  (render (window-body window)))
-
-(defcomponent info-message ()
-  ((message :accessor message :initarg :message)))
-
-(defmethod render ((m info-message))
-  (<:div
-   :class "info-mssage" 
-   (<:as-html (message m)))
-   (<lol:a :action (answer-component m nil) "Ok"))
+;; (defcomponent standard-window-component 
+;;   (ucw-standard::basic-window-component)
+;;   ((body
+;;     :initform nil
+;;     :accessor window-body
+;;     :component t
+;;     :initarg :body)))
+
+;; (defmethod render-html-head ((window standard-window-component))
+;;   (let* ((app (context.application *context*))
+;; 	 (url-prefix (application.url-prefix app)))
+;;     (<:meta :http-equiv "Content-Type" :content (window-component.content-type window))
+;;     (awhen (window-component.title window)
+;;       (<:title (if (functionp it)
+;; 		   (funcall it window)
+;; 		   (<:as-html it))))
+;;     (awhen (window-component.icon window)
+;;       (<:link :rel "icon"
+;; 	      :type "image/x-icon"
+;; 	      :href (concatenate 'string url-prefix it)))
+;;     (dolist (stylesheet (effective-window-stylesheets window))
+;;       (<:link :rel "stylesheet"
+;; 	      :href stylesheet
+;; 	      :type "text/css"))))
+
+;; (defmethod render-html-body ((window standard-window-component))
+;;   (render (window-body window)))
+
+;; (defcomponent info-message ()
+;;   ((message :accessor message :initarg :message)))
+
+;; (defmethod render ((m info-message))
+;;   (<:div
+;;    :class "info-mssage" 
+;;    (<:as-html (message m)))
+;;    (<ucw:a :action (answer-component m nil) "Ok"))
 
 
-- 
2.20.1