subclass UCW's form classes in the editor layer.

darcs-hash:20060506225243-39164-1401ce0a2973516a1117c201772ef9b7443fbdf8.gz

diff --git a/src/attributes/numbers.lisp b/src/attributes/numbers.lisp
index 6fb0460..a2d4b8f 100644 (file)
--- a/src/attributes/numbers.lisp
+++ b/src/attributes/numbers.lisp
@@ -9,6 +9,11 @@
   ()
   (:type-name integer))
 
+(defattribute integer-attribute (number-attribute integer-field)
+  ()
+  (:in-layer editor)
+  (:type-name integer))
+
 
 (define-layered-method (setf attribute-value) ((value string) object (attribute integer-attribute))           
   (let ((*read-eval* nil))

diff --git a/src/standard-attributes.lisp b/src/standard-attributes.lisp
index a34a1f6..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)))
+
+(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"))
 
-    (<:span
-     :class "lol-label"
-     (<:as-html (or (label attribute) (attribute.name attribute))))
-    (<:span
-     :class "lol-attribute"
-     (call-next-method)))
+(defdisplay ((attribute display) object)
+  (apply #'display self (attribute-value object attribute)
+        (description.properties attribute)))
 
 ;;;; * Base Types
 
@@ -27,23 +47,56 @@
 (defdisplay ((base base-attribute) object)
  (<:as-html (attribute-value object base)))
 
-
-(defattribute base-attribute ()
+(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)))))
+                                   (setf (attribute-value object string) val))))
+           ((object string) object))
       (call-next-method)))
 
 ;;;; Strings
 
-(defattribute string-attribute ()
+(defattribute string-attribute (base-attribute)
   ()
   (:type-name string)
   (:default-properties
@@ -51,15 +104,6 @@
     :size nil
     :max-length nil))
 
-(defdisplay
-    :in-layer editor ((string base-attribute) object)
- (<:input
-  :type "text"
-  :id (id string)
-  :name (callback string)
-  :value (or (attribute-value object string) "")))
-
-
 (defdisplay :in-layer omit-nil-attributes
            :around ((attribute string-attribute) object)
  (when (< 0 (length  (attribute-value object attribute)))

diff --git a/src/standard-display.lisp b/src/standard-display.lisp
index a5b0f0e..ba2846b 100644 (file)
--- a/src/standard-display.lisp
+++ b/src/standard-display.lisp
@@ -4,24 +4,24 @@
 (deflayer viewer)
 (deflayer editor)
 
+(define-layered-method label (anything)
+  nil)
+
 (defdisplay
     :in-layer editor :around (description object)
- "It is useful to remove the viewer layer when in the editing layer.
+  "It is useful to remove the viewer layer when in the editing layer.
 This allows us to dispatch to a subclasses editor."
- (with-inactive-layers (viewer)
-   (call-next-method)))
+  (with-inactive-layers (viewer)
+    (call-next-method)))
 
-(deflayer creator)
+;;;; These layers affect the layout of the object
 (deflayer one-line)
 (deflayer as-table)
-
-
-
 (deflayer as-string)
 
 (defdisplay
   :in-layer as-string (d o)
-  (with-inactive-layers (editor viewer creator one-line as-table label-attributes)
+  (with-inactive-layers (editor viewer one-line as-table show-attribute-labels)
     (do-attributes (a d)
       (display-attribute a o)
       (<:as-is " "))))
@@ -46,12 +46,12 @@ This allows us to dispatch to a subclasses editor."
 
 (defcomponent standard-display-component ()
   ((context :accessor context :initarg :context)
-   (object :accessor object :initarg :object)
+   (object :accessor object-of :initarg :object)
    (args :accessor args :initarg :args)))
 
 (defmethod render ((self standard-display-component))
   
-  (apply #'display self (object self) (args self)))
+  (apply #'display self (object-of self) (args self)))
 
 
 ;;;; * Object displays.
@@ -109,11 +109,11 @@ This allows us to dispatch to a subclasses editor."
 
 ;;;; ** One line
 (defdisplay
-    :in-layer one-line (description object) 
-    "The one line presentation just displays the attributes with a #\Space between them"
-    (do-attributes (attribute description)
-      (display-attribute attribute object)
-      (<:as-html " ")))
+  :in-layer one-line (description object) 
+  "The one line presentation just displays the attributes with a #\Space between them"
+  (do-attributes (attribute description)
+    (display-attribute attribute object)
+    (<:as-html " ")))
  
 ;;;; ** as-table
 
@@ -125,11 +125,19 @@ This allows us to dispatch to a subclasses editor."
       (<:td (display-attribute a object))))))
 
 ;;;; List Displays
+
+(deflayer list-display-layer)
+
+(define-layered-class description
+  :in-layer list-display-layer ()
+  ((list-item :initarg :list-item :initform nil :special t :accessor list-item)))
+
 (defdisplay (desc (list list))
-  (<:ul
-   (dolist* (item list)
-     (<:li  (display* item)
-           (<:as-html item)))))
+ (with-active-layers (list-display-layer)
+           
+   (<:ul
+    (dolist* (item list)
+      (<:li  (apply #'display* item (list-item desc)))))))
 
 ;;;; Attributes 
 (defdisplay

diff --git a/src/standard-wrappers.lisp b/src/standard-wrappers.lisp
index e9c0b48..43151ca 100644 (file)
--- a/src/standard-wrappers.lisp
+++ b/src/standard-wrappers.lisp
@@ -40,23 +40,37 @@
            (<ucw:a :action (call-display self object link)
                    (call-next-method)))))))
 
-
-
 ;;; wrap-a-form
 (deflayer wrap-form)
 
-(defdisplay ((description t) (button (eql 'standard-form-buttons)))
-  (<ucw:submit :action (ok self)
-              :value "Ok."))
+(define-layered-class description
+  :in-layer wrap-form ()
+  ((form-buttons :initarg :form-buttons :initform nil :special t :accessor form-buttons)))
+
+
+(defdisplay ((description (eql 'standard-form-buttons)) description-object)        
+  (macrolet ((submit (&key action value )
+              `(<ucw::simple-submit
+                :action (funcall ,action)
+                
+                (<:as-html ,value))))
+    (loop for button in (form-buttons description-object)
+        do 
+        (let ((button button))
+          (with-properties (button)
+            (let ((action (.get :action)))
+              (submit :value (.get :value)
+                      :action action)))))))
+
+
 
-(defdisplay :in-layer wrap-form :around (object description)
+(defdisplay :in-layer wrap-form :around (description object)
   (<ucw:form
    :action (refresh-component self)
    (with-inactive-layers (wrap-form)
 
      (call-next-method)
-     ;(display* 'standard-form-buttons)
-     )))
+     (display-attribute 'standard-form-buttons description))))
 
 ;;;; wrap a DIV