X-Git-Url: http://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/6de8d30004efc9337b8c40d2ff2d0a76651d23eb..b7657b86f85f575d5776dc6b626b1dc258d1fa47:/src/ucw/html-description.lisp

diff --git a/src/ucw/html-description.lisp b/src/ucw/html-description.lisp
index 57c8125..f05d010 100644
--- a/src/ucw/html-description.lisp
+++ b/src/ucw/html-description.lisp
@@ -2,10 +2,16 @@
 
 (export '(html-description) (find-package :lisp-on-lines))
 
+(defvar *escape-html* t)
+
+(defmethod generic-format ((display lol-ucw:component) string &rest args)
+  (<:as-html (with-output-to-string (stream)
+	       (apply #'call-next-method stream string args))))
+      
+
 (define-description html-description ()
   ())
 
-
 (define-description t ()
   ((css-class  :value "lol-description" :activep nil)
    (dom-id :function (lambda (x)
@@ -33,35 +39,54 @@
 	    (when label 
 	      (<:as-html 
 	       (with-output-to-string (*display*)
-		 (display-attribute-label object attribute))))))))
+		 (display-attribute-label attribute)))))))
+  (:method 
+      :in-layer #.(defining-description 'inline)
+      (object attribute)
+    (let ((label (attribute-label attribute)))
+      (when label
+		 (<:as-html 
+	  (with-output-to-string (*display*)
+	    (display-attribute-label attribute)))))))
 
 (define-layered-function display-html-attribute-value (object attribute)
   (:method (object attribute)
     (<:span 
 	:class "lol-attribute-value"
-	(<:as-html   (with-output-to-string (*display*)
-		 (display-attribute-value object attribute))))
-))
+	(<:as-html   
+	 (display-attribute-value attribute))))
+
+  (:method 
+    :in-layer #.(defining-description 'inline) (object attribute)
+    (display-attribute-value attribute)))
 
 (define-layered-function display-html-attribute (object attribute)
+  
   (:method (object attribute)
- (<:div 
-       :class (attribute-css-class attribute)
-       (when (attribute-dom-id attribute) 
-	 :id (attribute-dom-id attribute))
-       (display-html-attribute-label object attribute)
-       (display-html-attribute-value object attribute)
-       (<:br)))
-  (:method :in-layer #.(defining-description 'inline) 
-	   (object attribute)
- (<:span 
+    (<:div 
+     :class (attribute-css-class attribute)
+     (when (attribute-dom-id attribute) 
+       :id (attribute-dom-id attribute))
+     (display-html-attribute-label object attribute)
+     (display-html-attribute-value object attribute)))
+  
+  (:method 
+      :in-layer #.(defining-description 'inline) 
+      (object attribute)
+      (<:span 
        :class (attribute-css-class attribute)
        (when (attribute-dom-id attribute) 
 	 :id (attribute-dom-id attribute))
        (display-html-attribute-label object attribute)
-       (<:as-html " ")
-       (display-html-attribute-value object attribute)
-       (<:as-html " "))))
+       (display-html-attribute-value object attribute))))
+
+(define-layered-method display-using-description 
+  :in-layer #.(defining-description 'html-description)
+  :around ((attribute standard-attribute) display object &rest args)
+ (declare (ignore args))
+ (display-html-attribute object attribute))
+
+
 
 (define-layered-method display-html-attribute-value 
   :in-layer #.(defining-description 'editable) (object attribute)
@@ -69,14 +94,16 @@
     (<:span 
 	:class "lol-attribute-value"
     (if (attribute-editp object attribute)	
-    (<lol:input :reader (attribute-value object attribute)
-		:writer (lambda (val)
-			  (setf (attribute-value object attribute) val)))
+    (<lol:input :reader (attribute-value attribute)
+		:writer (let ((obj (described-object (attribute-description attribute))))
+			  (lambda (val)
+			    (dletf (((described-object attribute) obj))
+			      (setf (attribute-value attribute) val)))))
     (call-next-method))
 ))		
 
-(define-layered-function display-html-description (description display object)
-  (:method (description display object)
+(define-layered-function display-html-description (description display object &optional next-method)
+  (:method (description display object &optional (next-method #'display-using-description))
     (<:style
      (<:as-html "
 
@@ -105,30 +132,31 @@ clear: left;
    
 
       (<:div 
-       :class (list (attribute-value* css-class) "lol-description" "t")
-       :id    (attribute-value* dom-id)
-       (unless *object* (error "Object is nil .. why?"))
-       (dolist (attribute (attributes description))
-	 (display-html-attribute *object* attribute))))))
+       :class (list (attribute-value css-class) "lol-description" "t")
+       :id    (attribute-value dom-id)
+       (funcall next-method)))))
 		       
 
 (define-layered-method display-html-description 
-  :in-layer #.(defining-description 'inline) (description display object)
-  
+  :in-layer #.(defining-description 'inline) (description display object &optional next-method)
   (with-attributes (css-class dom-id) description
-   
-
     (<:span
-     :class (list (attribute-value* css-class) "lol-description")
-     :id    (attribute-value* dom-id)
-     (unless *object* (error "Object is nil .. why?"))
-     (dolist (attribute (attributes description))
-       (display-html-attribute *object* attribute))))
-  )
+     :class (list (attribute-value css-class) "lol-description")
+     :id    (attribute-value dom-id)
+     (funcall next-method))))
+
 
 (define-display 
-  :in-description html-description ((description t) (display lol-ucw:component) object )
-  (display-html-description description display object))
+  :in-description html-description ((description t) 
+				    (display lol-ucw:component) 
+				    object)
+  (display-html-description description display object (lambda ()
+							 (call-next-method))))
+
+
+
+
+