subclass UCW's form classes in the editor layer.

[clinton/lisp-on-lines.git] / src / standard-attributes.lisp

diff --git a/src/standard-attributes.lisp b/src/standard-attributes.lisp
index 87b8620..53022aa 100644 (file)
--- a/src/standard-attributes.lisp
+++ b/src/standard-attributes.lisp
@@ -1,5 +1,6 @@
 (in-package :lisp-on-lines)
 
+;;;; A few layers related to attributes
 (deflayer omit-nil-attributes)
 
 (defdisplay :in-layer omit-nil-attributes
@@ -7,17 +8,36 @@
  (when (attribute-value object attribute)
    (call-next-method)))
 
-(deflayer label-attributes)
+(deflayer show-attribute-labels)
 
-(defdisplay :in-layer label-attributes
-           :around ((attribute standard-attribute) object)
+(defdisplay
+    :in-layer show-attribute-labels
+    :around ((attribute standard-attribute) object)
+    
+  (<:span
+   :class "lol-label"
+   (<:as-html (or (label attribute) (attribute.name attribute)) " "))
+  (<:span
+   :class "lol-attribute"
+   (call-next-method)))
 
-    (<:span
-     :class "lol-label"
-     (<:as-html (or (label attribute) (attribute.name attribute))))
-    (<:span
-     :class "lol-attribute"
-     (call-next-method)))
+(deflayer use-pretty-labels)
+
+(define-layered-method label
+   :in-layer use-pretty-labels
+   :around (standard-attribute)
+ (let ((label (call-next-method)))
+   (when label   
+     (string-capitalize
+      (substitute #\Space #\- label)))))
+
+(defattribute display ()
+  ()
+  (:documentation "Apply the display function to this object"))
+
+(defdisplay ((attribute display) object)
+  (apply #'display self (attribute-value object attribute)
+        (description.properties attribute)))
 
 ;;;; * Base Types
 
@@ -27,11 +47,57 @@
 (defdisplay ((base base-attribute) object)
  (<:as-html (attribute-value object base)))
 
+(defattribute base-attribute (ucw::string-field)
+  ()
+  (:in-layer editor)
+  (:default-properties
+      :callback nil))
+
+(defmethod ucw:client-value ((self base-attribute))
+  (attribute-value (object self) self))
+
+(defmethod (setf ucw:client-value) (value (attribute base-attribute))
+  (setf (attribute-value (object attribute) attribute) value))
+
+
+(defmethod render ((field base-attribute))
+  "this can only be used within a display-using-description call in the editor context, 
+ it is a hack to integrate lol with ucw's new form stuff"
+  (call-next-method))
+
+  #+ (or)
+(LET ((value (attribute-value (object field) field)))
+  (<:as-html "asd" value)
+  (<:input
+   :NAME
+   (callback field)
+   :VALUE (escape-as-html value)
+   :TYPE
+   "text"
+   :ID
+   (DOM-ID FIELD)
+   :SIZE
+   (ucw::INPUT-SIZE FIELD)))
+
+
+
+(defdisplay
+    :in-layer editor  ((string base-attribute) object)
+ (render string))
+
+
+(defdisplay
+    :in-layer editor :around ((string base-attribute) object)
+    (dletf (((callback string) (ucw::make-new-callback
+                               #'(lambda (val)
+                                   (setf (attribute-value object string) val))))
+           ((object string) object))
+      (call-next-method)))
+
 ;;;; Strings
 
 (defattribute string-attribute (base-attribute)
   ()
-
   (:type-name string)
   (:default-properties
       :escape-html-p t
@@ -43,9 +109,9 @@
  (when (< 0 (length  (attribute-value object attribute)))
    (call-next-method)))
 
-
 ;;;; default
-(defdisplay ((string string-attribute) object)
+(defdisplay :in-layer viewer
+           ((string string-attribute) object)
   (if (escape-html-p string)
       (<:as-html (attribute-value object string))
       (<:as-is (attribute-value object string))))
@@ -58,20 +124,7 @@
   (:default-properties
       :callback nil))
 
-(defdisplay
-   :in-layer editor :around ((string string-attribute) object)
- (dletf (((callback string) (ucw::make-new-callback
-                            #'(lambda (val)
-                                (setf (attribute-value object string) val)))))
-   (call-next-method)))
-
-(defdisplay :in-layer editor ((string string-attribute) object)
- (<:input
-  :type "text"
-  :id (id string)
-  :name (callback string)
-  :value (or (attribute-value object string) "")))         
-
+           
 (defattribute string-search-attribute (string-attribute)
   ()
   (:default-properties
@@ -86,29 +139,29 @@
 
 (defdisplay
    :in-layer editor :after ((search string-search-attribute) object)
-     (IT.BESE.YACLML.TAGS:INPUT
-      :TYPE "submit"
-      :VALUE "search"
-      :ONCLICK
-      (JS:JS-INLINE*
-       `(PROGN
-        (IT.BESE.UCW::SET-ACTION-PARAMETER
-         ,(IT.BESE.UCW::MAKE-NEW-ACTION
-           (IT.BESE.UCW::CONTEXT.CURRENT-FRAME *CONTEXT*)
-           (search-action search)))
-        (RETURN T)))))
+   (<:input 
+    :TYPE "submit"
+    :VALUE "search"
+    :ONCLICK
+    (JS:JS-INLINE*
+     `(PROGN
+       (IT.BESE.UCW::SET-ACTION-PARAMETER
+       ,(IT.BESE.UCW::MAKE-NEW-ACTION
+         (IT.BESE.UCW::CONTEXT.CURRENT-FRAME *CONTEXT*)
+         (search-action search)))
+       (RETURN T)))))
 
 ;;;; textarea
 
 (defattribute text-attribute (string-attribute)
-  ()
-  (:type-name text))
+      ()
+      (:type-name text))
 
 (defdisplay :in-layer editor ((string text-attribute) object)
  (<:textarea
   :id (id string)
   :name (callback string)
- (or (attribute-value object string) "")))
+  (or (attribute-value object string) "")))
 
 
 
@@ -130,7 +183,10 @@
 
 
 (defattribute image ()
-  ())
+  ()
+  (:default-properties
+      :css-class "lol-image"
+    :prefix "images/"))
 
 (defdisplay ((buttons (eql 'image-editor-buttons)) object)
   (<ucw:a :action (ok component object)
@@ -138,9 +194,9 @@
 
 (defdisplay ((image image) object)
   (<:img
-   :class (or (.get :css-class) "lol-image") 
+   :class (or (css-class image) "lol-image") 
    :src (arnesi:strcat
-        (or (.get :prefix) "images/")
+        (or (prefix image) "images/")
         (escape-as-uri
          (attribute-value object image)))))
 
@@ -149,17 +205,7 @@
 
     (<:div
      :class "lol-image-thumbnails"
-   
-     (dolist* (i (or (.get :directory)
-                    (cl-fad:list-directory (strcat *default-pathname-defaults* "wwwroot/images/"))))
-       (<:div
-       :style "border: 1px solid black;width:100px;"
-       (<:img
-        :width "90px"
-        :src (strcat (or (.get :prefix) "images/")
-                     (file-namestring i)))
-       (display-using-description* 'image-editor-buttons (file-namestring i) (.properties)))
-       (<:p :style "clear:both;"))))
+     (<:as-html "imagie")))