Fix missing `without-special-symbol-access' in `funcall-with-attribute-context'

[clinton/lisp-on-lines.git] / src / ucw / html-description.lisp

diff --git a/src/ucw/html-description.lisp b/src/ucw/html-description.lisp
index 83847ed..90bc551 100644 (file)
--- a/src/ucw/html-description.lisp
+++ b/src/ucw/html-description.lisp
@@ -24,6 +24,7 @@
   ((css-class :accessor attribute-css-class 
              :initform "lol-attribute")
    (dom-id :accessor attribute-dom-id :initform nil)
+   (value-tag :accessor attribute-html-tag :initform nil :initarg :html-tag)
    (display-empty-label :accessor attribute-display-empty-label-p :initarg :display-empty-label-p :initform t)))
 
 (define-layered-class standard-attribute
@@ -47,26 +48,26 @@
       (object attribute)
     (let ((label (attribute-label attribute)))
       (when label
-                (<:as-html
-         (with-output-to-string (*display*)
-           (display-attribute-label attribute)))))))
+       (<:as-html (display-attribute-label attribute))))))
 
 (define-layered-function display-html-attribute-value (object attribute)
   (:method (object attribute)
+
     (<:td 
-       :class "lol-attribute-value"
-       (<:as-html   
-        (display-attribute-value attribute))))
+     :class "lol-attribute-value"
+     (<: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)
     (<:tr 
-     :class (attribute-css-class attribute)
+     :class (format nil "~A lol-attribute" (attribute-css-class attribute))
      (when (attribute-dom-id attribute) 
        :id (attribute-dom-id attribute))
      (display-html-attribute-label object attribute)
@@ -79,13 +80,15 @@
        :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))))
+       (<:span :class "lol-attribute-label"
+       (display-html-attribute-label object attribute))
+       (<:span :class "lol-attribute-value"
+       (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))
+ (declare (ignore args)) 
  (display-html-attribute object attribute))
 
 
@@ -96,15 +99,17 @@
        (apply function args)))))
 
 (defun make-attribute-value-writer (attribute)
- (let ((obj (described-object (attribute-description attribute)))
-       (value (attribute-value attribute)))
+  (let ((obj (described-object (attribute-description attribute)))
+       (value (attribute-value attribute))
+       (desc (attribute-description attribute)))
    (lambda (val)
-     (dletf (((described-object attribute) obj))
+     (dletf (((described-object (attribute-description attribute)) obj))
        (with-active-descriptions (editable)
         (unless (and (unbound-slot-value-p value)
                      (equal "" val))
-        (setf (attribute-value attribute) 
-            (parse-attribute-value attribute val))))))))
+          (with-described-object (obj desc)
+            (setf (attribute-value attribute) 
+                  (parse-attribute-value attribute val)))))))))
 
 
 (defmethod html-attribute-value (attribute)
@@ -126,9 +131,6 @@
              :reader (html-attribute-value attribute)
              :writer (make-attribute-value-writer attribute)))
 
-
-
-
 (define-layered-method display-attribute-editor 
    :in-layer #.(defining-description 'html-description) (attribute)
    (display-html-attribute-editor attribute (attribute-editor attribute)))
@@ -136,53 +138,17 @@
 
 (define-layered-method display-html-attribute-value 
   :in-layer #.(defining-description 'editable) (object attribute)
-
-    (<:td
-       :class "lol-attribute-value"
+  #+nil(<:as-html (princ-to-string (attribute-editp attribute)))
     (if (attribute-editp attribute)    
-       (display-attribute-editor attribute)
-       (call-next-method))))           
+           (<:td
+            :class "lol-attribute-value" (display-attribute-editor attribute))
+       (call-next-method)))
 
 (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 "
-
-
-
-div.lol-description .lol-attribute-label, 
-div.lol-description .lol-attribute-value {
-      display: block;
-      width: 69%;
-      float: left;
-      margin-bottom: 1em;
-border:1px solid black;
-
-}
-div.lol-description 
-.lol-attribute-label {
-     text-align: right;
-     width: 24%;
-     padding-right: 1em;
-}
-
-span.lol-attribute-value .lol-attribute-value (
- border: 1px solid red;}
-
-
-div.lol-description 
-br {
-clear: left;
-}
-
-.clear {clear:left}"
-
-))
-                      
-    (with-attributes (css-class dom-id) description
-   
-
-      (<:table
+      (let ((dom-id (find-attribute description 'dom-id))
+       (css-class (find-attribute description 'dom-id)))
+             (<:table
        :class (list (attribute-value css-class) "lol-description" "t")
        :id    (attribute-value dom-id)
        (funcall next-method)
@@ -191,11 +157,12 @@ clear: left;
 
 (define-layered-method display-html-description 
   :in-layer #.(defining-description 'inline) (description display object &optional next-method)
-  (with-attributes (css-class dom-id) description
+  (let ((dom-id (find-attribute description 'dom-id))
+       (css-class (find-attribute description 'dom-id)))
     (<:span
-     :class (list (attribute-value css-class) "lol-description")
-     :id    (attribute-value dom-id)
-     (funcall next-method))))
+                     :class (list (attribute-value css-class) "lol-description")
+                     :id    (attribute-value dom-id)
+                     (funcall next-method))))
 
 
 (define-display